aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Readers/Org/Blocks.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Readers/Org/Blocks.hs')
-rw-r--r--src/Text/Pandoc/Readers/Org/Blocks.hs81
1 files changed, 13 insertions, 68 deletions
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 6a8bb8b28..f5873d55f 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -34,8 +34,8 @@ module Text.Pandoc.Readers.Org.Blocks
) where
import Text.Pandoc.Readers.Org.BlockStarts
-import Text.Pandoc.Readers.Org.ExportSettings ( exportSettings )
import Text.Pandoc.Readers.Org.Inlines
+import Text.Pandoc.Readers.Org.Meta ( metaExport, metaLine )
import Text.Pandoc.Readers.Org.ParserState
import Text.Pandoc.Readers.Org.Parsing
import Text.Pandoc.Readers.Org.Shared
@@ -52,9 +52,7 @@ import Text.Pandoc.Shared ( compactify', compactify'DL )
import Control.Monad ( foldM, guard, mzero, void )
import Data.Char ( isSpace, toLower, toUpper)
import Data.List ( foldl', intersperse, isPrefixOf )
-import qualified Data.Map as M
import Data.Maybe ( fromMaybe, isNothing )
-import Network.HTTP ( urlEncode )
--
-- Org headers
@@ -82,6 +80,10 @@ newtype PropertyValue = PropertyValue { fromValue :: String }
toPropertyValue :: String -> PropertyValue
toPropertyValue = PropertyValue
+-- | Check whether the property value is non-nil (i.e. truish).
+isNonNil :: PropertyValue -> Bool
+isNonNil p = map toLower (fromValue p) `notElem` ["()", "{}", "nil"]
+
-- | Key/value pairs from a PROPERTIES drawer
type Properties = [(PropertyKey, PropertyValue)]
@@ -202,12 +204,16 @@ propertiesToAttr properties =
toStringPair prop = (fromKey (fst prop), fromValue (snd prop))
customIdKey = toPropertyKey "custom_id"
classKey = toPropertyKey "class"
+ unnumberedKey = toPropertyKey "unnumbered"
+ specialProperties = [customIdKey, classKey, unnumberedKey]
id' = fromMaybe mempty . fmap fromValue . lookup customIdKey $ properties
cls = fromMaybe mempty . fmap fromValue . lookup classKey $ properties
- kvs' = map toStringPair . filter ((`notElem` [customIdKey, classKey]) . fst)
+ kvs' = map toStringPair . filter ((`notElem` specialProperties) . fst)
$ properties
+ isUnnumbered =
+ fromMaybe False . fmap isNonNil . lookup unnumberedKey $ properties
in
- (id', words cls, kvs')
+ (id', words cls ++ (if isUnnumbered then ["unnumbered"] else []), kvs')
tagTitle :: Inlines -> [Tag] -> Inlines
tagTitle title tags = title <> (mconcat $ map tagToInline tags)
@@ -232,8 +238,8 @@ blockList = do
-- | Get the meta information safed in the state.
meta :: OrgParser Meta
meta = do
- st <- getState
- return $ runF (orgStateMeta st) st
+ meta' <- metaExport
+ runF meta' <$> getState
blocks :: OrgParser (F Blocks)
blocks = mconcat <$> manyTill block (void (lookAhead headerStart) <|> eof)
@@ -631,67 +637,9 @@ exampleCode = B.codeBlockWith ("", ["example"], [])
specialLine :: OrgParser (F Blocks)
specialLine = fmap return . try $ metaLine <|> commentLine
--- The order, in which blocks are tried, makes sure that we're not looking at
--- the beginning of a block, so we don't need to check for it
-metaLine :: OrgParser Blocks
-metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
-
commentLine :: OrgParser Blocks
commentLine = commentLineStart *> anyLine *> pure mempty
-declarationLine :: OrgParser ()
-declarationLine = try $ do
- key <- metaKey
- value <- metaInlines
- updateState $ \st ->
- let meta' = B.setMeta key <$> value <*> pure nullMeta
- in st { orgStateMeta = orgStateMeta st <> meta' }
-
-metaInlines :: OrgParser (F MetaValue)
-metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
-
-metaKey :: OrgParser String
-metaKey = map toLower <$> many1 (noneOf ": \n\r")
- <* char ':'
- <* skipSpaces
-
-optionLine :: OrgParser ()
-optionLine = try $ do
- key <- metaKey
- case key of
- "link" -> parseLinkFormat >>= uncurry addLinkFormat
- "options" -> exportSettings
- _ -> mzero
-
-addLinkFormat :: String
- -> (String -> String)
- -> OrgParser ()
-addLinkFormat key formatter = updateState $ \s ->
- let fs = orgStateLinkFormatters s
- in s{ orgStateLinkFormatters = M.insert key formatter fs }
-
-parseLinkFormat :: OrgParser ((String, String -> String))
-parseLinkFormat = try $ do
- linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces
- linkSubst <- parseFormat
- return (linkType, linkSubst)
-
--- | An ad-hoc, single-argument-only implementation of a printf-style format
--- parser.
-parseFormat :: OrgParser (String -> String)
-parseFormat = try $ do
- replacePlain <|> replaceUrl <|> justAppend
- where
- -- inefficient, but who cares
- replacePlain = try $ (\x -> concat . flip intersperse x)
- <$> sequence [tillSpecifier 's', rest]
- replaceUrl = try $ (\x -> concat . flip intersperse x . urlEncode)
- <$> sequence [tillSpecifier 'h', rest]
- justAppend = try $ (++) <$> rest
-
- rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")
- tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))
-
--
-- Tables
@@ -868,9 +816,6 @@ paraOrPlain = try $ do
*> return (B.para <$> ils))
<|> (return (B.plain <$> ils))
-inlinesTillNewline :: OrgParser (F Inlines)
-inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline
-
--
-- list blocks