@@ -1,6 +1,5 @@
11{-# LANGUAGE FlexibleContexts #-}
22{-# LANGUAGE LambdaCase #-}
3−{-# LANGUAGE TupleSections #-}
43{-# LANGUAGE OverloadedStrings #-}
54{- |
65 Module : Text.Pandoc.Readers.Org.Meta
@@ -23,20 +22,21 @@ import Text.Pandoc.Readers.Org.Inlines
2322import Text.Pandoc.Readers.Org.ParserState
2423import Text.Pandoc.Readers.Org.Parsing
2524
26−import Text.Pandoc.Builder (Blocks, Inlines)
25+import Text.Pandoc.Builder (Blocks, Inlines, ToMetaValue)
2726import qualified Text.Pandoc.Builder as B
2827import Text.Pandoc.Class.PandocMonad (PandocMonad)
2928import Text.Pandoc.Definition
3029import Text.Pandoc.Shared (blocksToInlines, safeRead)
3130
32−import Control.Monad (mzero, void, when)
31+import Control.Monad (mzero, void)
3332import Data.List (intercalate, intersperse)
33+import Data.Map (Map)
3434import Data.Maybe (fromMaybe)
35−import qualified Data.Map as M
36−import qualified Data.Set as Set
3735import Data.Text (Text)
38−import qualified Data.Text as T
3936import Network.HTTP (urlEncode)
37+import qualified Data.Map as Map
38+import qualified Data.Set as Set
39+import qualified Data.Text as T
4040
4141-- | Returns the current meta, respecting export options.
4242metaExport :: Monad m => OrgParser m (F Meta)
@@ -51,7 +51,7 @@ metaExport = do
5151removeMeta :: Text -> Meta -> Meta
5252removeMeta key meta' =
5353 let metaMap = unMeta meta'
54− in Meta $ M.delete key metaMap
54+ in Meta $ Map.delete key metaMap
5555
5656-- | Parse and handle a single line containing meta information
5757-- The order, in which blocks are tried, makes sure that we're not looking at
@@ -62,69 +62,49 @@ metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
6262declarationLine :: PandocMonad m => OrgParser m ()
6363declarationLine = try $ do
6464 key <- T.toLower <$> metaKey
65− (key', value) <- metaValue key
66− let addMetaValue st =
67− st { orgStateMeta = B.setMeta key' <$> value <*> orgStateMeta st }
68− when (key' /= "results") $ updateState addMetaValue
65+ case Map.lookup key exportSettingHandlers of
66+ Nothing -> () <$ anyLine
67+ Just hd -> hd
6968
7069metaKey :: Monad m => OrgParser m Text
7170metaKey = T.toLower <$> many1Char (noneOf ": \n\r")
7271 <* char ':'
7372 <* skipSpaces
7473
75−metaValue :: PandocMonad m => Text -> OrgParser m (Text, F MetaValue)
76−metaValue key =
77− let inclKey = "header-includes"
78− in case key of
79− "author" -> (key,) <$> metaInlinesCommaSeparated
80− "keywords" -> (key,) <$> metaInlinesCommaSeparated
81− "title" -> (key,) <$> metaInlines
82− "subtitle" -> (key,) <$> metaInlines
83− "date" -> (key,) <$> metaInlines
84− "description" -> (key,) <$> accumulatingInlines key
85− "nocite" -> (key,) <$> accumulatingList key metaInlines
86− "header-includes" -> (key,) <$> accumulatingList key metaInlines
87− "latex_header" -> (inclKey,) <$>
88− accumulatingList inclKey (metaExportSnippet "latex")
89− "latex_class" -> ("documentclass",) <$> metaString
90− -- Org-mode expects class options to contain the surrounding brackets,
91− -- pandoc does not.
92− "latex_class_options" -> ("classoption",) <$>
93− metaModifiedString (T.filter (`notElem` ("[]" :: String)))
94− "html_head" -> (inclKey,) <$>
95− accumulatingList inclKey (metaExportSnippet "html")
96− _ -> (key,) <$> metaString
97−
98−-- TODO Cleanup this mess
99−
100−metaInlines :: PandocMonad m => OrgParser m (F MetaValue)
101−metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
102−
103−metaInlinesCommaSeparated :: PandocMonad m => OrgParser m (F MetaValue)
104−metaInlinesCommaSeparated = do
105− itemStrs <- many1Char (noneOf ",\n") `sepBy1` char ','
106− newline
107− items <- mapM (parseFromString inlinesTillNewline . (<> "\n")) itemStrs
108− let toMetaInlines = MetaInlines . B.toList
109− return $ MetaList . map toMetaInlines <$> sequence items
110−
111−metaString :: Monad m => OrgParser m (F MetaValue)
112−metaString = metaModifiedString id
113−
114−metaModifiedString :: Monad m => (Text -> Text) -> OrgParser m (F MetaValue)
115−metaModifiedString f = return . MetaString . f <$> anyLine
116−
117−-- | Read an format specific meta definition
118−metaExportSnippet :: Monad m => Text -> OrgParser m (F MetaValue)
119−metaExportSnippet format =
120− return . MetaInlines . B.toList . B.rawInline format <$> anyLine
121−
122−accumulatingInlines :: PandocMonad m
123− => Text
124− -> OrgParser m (F MetaValue)
125−accumulatingInlines key = do
126− value <- inlinesTillNewline
127− accumulating appendValue (B.toList <$> value)
74+exportSettingHandlers :: PandocMonad m => Map Text (OrgParser m ())
75+exportSettingHandlers = Map.fromList
76+ [ ("result" , fmap pure anyLine `parseThen` discard) -- RESULT is never an export setting
77+ , ("author" , commaSepInlines `parseThen` setField "author")
78+ , ("keywords" , commaSepInlines `parseThen` setField "keywords")
79+ , ("date" , lineOfInlines `parseThen` setField "date")
80+ , ("description", lineOfInlines `parseThen` collectSepBy B.SoftBreak "description")
81+ , ("title" , lineOfInlines `parseThen` collectSepBy B.Space "title")
82+ , ("nocite" , lineOfInlines `parseThen` collectAsList "nocite")
83+ , ("latex_class", fmap pure anyLine `parseThen` setField "documentclass")
84+ , ("latex_class_options", (pure . T.filter (`notElem` ("[]" :: String)) <$> anyLine)
85+ `parseThen` setField "classoption")
86+ , ("latex_header", metaExportSnippet "latex" `parseThen`
87+ collectAsList "header-includes")
88+ , ("html_head" , metaExportSnippet "html" `parseThen`
89+ collectAsList "header-includes")
90+ ]
91+
92+parseThen :: PandocMonad m
93+ => OrgParser m (F a)
94+ -> (a -> Meta -> Meta)
95+ -> OrgParser m ()
96+parseThen p modMeta = do
97+ value <- p
98+ meta <- orgStateMeta <$> getState
99+ updateState (\st -> st { orgStateMeta = modMeta <$> value <*> meta })
100+
101+discard :: a -> Meta -> Meta
102+discard = const id
103+
104+collectSepBy :: Inline -> Text -> Inlines -> Meta -> Meta
105+collectSepBy sep key value meta =
106+ let value' = appendValue meta (B.toList value)
107+ in B.setMeta key value' meta
128108 where
129109 appendValue :: Meta -> [Inline] -> MetaValue
130110 appendValue m v = MetaInlines $ curInlines m <> v
@@ -137,32 +117,40 @@ accumulatingInlines key = do
137117 collectInlines :: MetaValue -> [Inline]
138118 collectInlines = \case
139119 MetaInlines inlns -> inlns
140− MetaList ml -> intercalate [B.SoftBreak] $ map collectInlines ml
120+ MetaList ml -> intercalate [sep] $ map collectInlines ml
141121 MetaString s -> [B.Str s]
142122 MetaBlocks blks -> blocksToInlines blks
143123 MetaMap _map -> []
144124 MetaBool _bool -> []
145125
146−-- | Accumulate the result of the @parser@ in a list under @key@.
147−accumulatingList :: Monad m => Text
148− -> OrgParser m (F MetaValue)
149− -> OrgParser m (F MetaValue)
150−accumulatingList key p = p >>= accumulating metaListAppend
126+-- | Accumulate the result as a MetaList under the given key.
127+collectAsList :: Text -> Inlines -> Meta -> Meta
128+collectAsList key value meta =
129+ let value' = metaListAppend meta (B.toMetaValue value)
130+ in B.setMeta key value' meta
151131 where
152132 metaListAppend m v = MetaList (curList m ++ [v])
153−
154133 curList m = case lookupMeta key m of
155134 Just (MetaList ms) -> ms
156135 Just x -> [x]
157136 _ -> []
158137
159−accumulating :: Monad m
160− => (Meta -> a -> MetaValue)
161− -> F a
162− -> OrgParser m (F MetaValue)
163−accumulating acc value = do
164− meta <- orgStateMeta <$> getState
165− return $ acc <$> meta <*> value
138+setField :: ToMetaValue a => Text -> a -> Meta -> Meta
139+setField field value meta = B.setMeta field (B.toMetaValue value) meta
140+
141+lineOfInlines :: PandocMonad m => OrgParser m (F Inlines)
142+lineOfInlines = inlinesTillNewline
143+
144+commaSepInlines :: PandocMonad m => OrgParser m (F [Inlines])
145+commaSepInlines = do
146+ itemStrs <- many1Char (noneOf ",\n") `sepBy1` char ','
147+ newline
148+ items <- mapM (parseFromString inlinesTillNewline . (<> "\n")) itemStrs
149+ return $ sequence items
150+
151+-- | Read an format specific meta definition
152+metaExportSnippet :: Monad m => Text -> OrgParser m (F Inlines)
153+metaExportSnippet format = pure . B.rawInline format <$> anyLine
166154
167155--
168156-- export options
@@ -188,7 +176,7 @@ addLinkFormat :: Monad m => Text
188176 -> OrgParser m ()
189177addLinkFormat key formatter = updateState $ \s ->
190178 let fs = orgStateLinkFormatters s
191− in s{ orgStateLinkFormatters = M.insert key formatter fs }
179+ in s{ orgStateLinkFormatters = Map.insert key formatter fs }
192180
193181parseLinkFormat :: Monad m => OrgParser m (Text, Text -> Text)
194182parseLinkFormat = try $ do