@@ -22,7 +22,7 @@ import Text.Pandoc.Readers.Org.Inlines
2222import Text.Pandoc.Readers.Org.ParserState
2323import Text.Pandoc.Readers.Org.Parsing
2424
25−import Text.Pandoc.Builder (Blocks, Inlines, ToMetaValue)
25+import Text.Pandoc.Builder (Blocks, Inlines)
2626import qualified Text.Pandoc.Builder as B
2727import Text.Pandoc.Class.PandocMonad (PandocMonad)
2828import Text.Pandoc.Definition
@@ -57,13 +57,13 @@ removeMeta key meta' =
5757-- The order, in which blocks are tried, makes sure that we're not looking at
5858-- the beginning of a block, so we don't need to check for it
5959metaLine :: PandocMonad m => OrgParser m Blocks
60−metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
60+metaLine = mempty <$ metaLineStart <* keywordLine
6161
62−declarationLine :: PandocMonad m => OrgParser m ()
63−declarationLine = try $ do
62+keywordLine :: PandocMonad m => OrgParser m ()
63+keywordLine = try $ do
6464 key <- T.toLower <$> metaKey
65− case Map.lookup key exportSettingHandlers of
66− Nothing -> () <$ anyLine
65+ case Map.lookup key keywordHandlers of
66+ Nothing -> () <$ anyLine -- discard unknown lines
6767 Just hd -> hd
6868
6969metaKey :: Monad m => OrgParser m Text
@@ -71,33 +71,55 @@ metaKey = T.toLower <$> many1Char (noneOf ": \n\r")
7171 <* char ':'
7272 <* skipSpaces
7373
74−exportSettingHandlers :: PandocMonad m => Map Text (OrgParser m ())
75−exportSettingHandlers = Map.fromList
76− [ ("result" , fmap pure anyLine `parseThen` discard)
77− -- Common settings
78− , ("author" , lineOfInlines `parseThen` collectLines "author")
79− , ("date" , lineOfInlines `parseThen` setField "date")
80− , ("description", lineOfInlines `parseThen` collectLines "description")
81− , ("keywords" , lineOfInlines `parseThen` collectLines "keywords")
82− , ("subtitle" , lineOfInlines `parseThen` collectLines "subtitle")
83− , ("title" , lineOfInlines `parseThen` collectLines "title")
84− -- LaTeX
85− , ("latex_class" , fmap pure anyLine `parseThen` setField "documentclass")
86− , ("latex_class_options", (pure . T.filter (`notElem` ("[]" :: String)) <$> anyLine)
87− `parseThen` setField "classoption")
88− , ("latex_header" , metaExportSnippet "latex" `parseThen`
89− collectAsList "header-includes")
90− , ("latex_header_extra", metaExportSnippet "latex" `parseThen`
91− collectAsList "header-includes")
92− -- HTML
93− , ("html_head" , metaExportSnippet "html" `parseThen`
94− collectAsList "header-includes")
95− , ("html_head_extra", metaExportSnippet "html" `parseThen`
96− collectAsList "header-includes")
97− -- pandoc-specific
98− , ("nocite" , lineOfInlines `parseThen` collectLines "nocite")
99− , ("header-includes", lineOfInlines `parseThen` collectLines "header-includes")
100− , ("institute" , lineOfInlines `parseThen` collectLines "institute")
74+infix 0 ~~>
75+(~~>) :: a -> b -> (a, b)
76+a ~~> b = (a, b)
77+
78+keywordHandlers :: PandocMonad m => Map Text (OrgParser m ())
79+keywordHandlers = Map.fromList
80+ [ "author" ~~> lineOfInlines `parseThen` collectLines "author"
81+ , "creator" ~~> fmap pure anyLine `parseThen` B.setMeta "creator"
82+ , "date" ~~> lineOfInlines `parseThen` B.setMeta "date"
83+ , "description" ~~> lineOfInlines `parseThen` collectLines "description"
84+ , "email" ~~> fmap pure anyLine `parseThen` B.setMeta "email"
85+ , "exclude_tags" ~~> tagList >>= updateState . setExcludedTags
86+ , "header-includes" ~~>
87+ lineOfInlines `parseThen` collectLines "header-includes"
88+ -- HTML-specifix export settings
89+ , "html_head" ~~>
90+ metaExportSnippet "html" `parseThen` collectAsList "header-includes"
91+ , "html_head_extra" ~~>
92+ metaExportSnippet "html" `parseThen` collectAsList "header-includes"
93+ , "institute" ~~> lineOfInlines `parseThen` collectLines "institute"
94+ -- topic keywords
95+ , "keywords" ~~> lineOfInlines `parseThen` collectLines "keywords"
96+ -- LaTeX-specific export settings
97+ , "latex_class" ~~> fmap pure anyLine `parseThen` B.setMeta "documentclass"
98+ , "latex_class_options" ~~>
99+ (pure . T.filter (`notElem` ("[]" :: String)) <$> anyLine)
100+ `parseThen` B.setMeta "classoption"
101+ , "latex_header" ~~>
102+ metaExportSnippet "latex" `parseThen` collectAsList "header-includes"
103+ , "latex_header_extra" ~~>
104+ metaExportSnippet "latex" `parseThen` collectAsList "header-includes"
105+ -- link and macro
106+ , "link" ~~> addLinkFormatter
107+ , "macro" ~~> macroDefinition >>= updateState . registerMacro
108+ -- pandoc-specific way to include references in the bibliography
109+ , "nocite" ~~> lineOfInlines `parseThen` collectLines "nocite"
110+ -- compact way to set export settings
111+ , "options" ~~> exportSettings
112+ -- pandoc-specific way to configure emphasis recognition
113+ , "pandoc-emphasis-post" ~~> emphChars >>= updateState . setEmphasisPostChar
114+ , "pandoc-emphasis-pre" ~~> emphChars >>= updateState . setEmphasisPreChar
115+ -- result markers (ignored)
116+ , "result" ~~> void anyLine
117+ , "select_tags" ~~> tagList >>= updateState . setSelectedTags
118+ , "seq_todo" ~~> todoSequence >>= updateState . registerTodoSequence
119+ , "subtitle" ~~> lineOfInlines `parseThen` collectLines "subtitle"
120+ , "title" ~~> lineOfInlines `parseThen` collectLines "title"
121+ , "todo" ~~> todoSequence >>= updateState . registerTodoSequence
122+ , "typ_todo" ~~> todoSequence >>= updateState . registerTodoSequence
101123 ]
102124
103125parseThen :: PandocMonad m
@@ -109,9 +131,6 @@ parseThen p modMeta = do
109131 meta <- orgStateMeta <$> getState
110132 updateState (\st -> st { orgStateMeta = modMeta <$> value <*> meta })
111133
112−discard :: a -> Meta -> Meta
113−discard = const id
114−
115134collectLines :: Text -> Inlines -> Meta -> Meta
116135collectLines key value meta =
117136 let value' = appendValue meta (B.toList value)
@@ -146,51 +165,25 @@ collectAsList key value meta =
146165 Just x -> [x]
147166 _ -> []
148167
149−setField :: ToMetaValue a => Text -> a -> Meta -> Meta
150−setField field value meta = B.setMeta field (B.toMetaValue value) meta
151−
152168-- | Read an format specific meta definition
153169metaExportSnippet :: Monad m => Text -> OrgParser m (F Inlines)
154170metaExportSnippet format = pure . B.rawInline format <$> anyLine
155171
156−--
157−-- export options
158−--
159−optionLine :: PandocMonad m => OrgParser m ()
160−optionLine = try $ do
161− key <- metaKey
162− case key of
163− "link" -> parseLinkFormat >>= uncurry addLinkFormat
164− "options" -> exportSettings
165− "todo" -> todoSequence >>= updateState . registerTodoSequence
166− "seq_todo" -> todoSequence >>= updateState . registerTodoSequence
167− "typ_todo" -> todoSequence >>= updateState . registerTodoSequence
168− "macro" -> macroDefinition >>= updateState . registerMacro
169− "exclude_tags" -> tagList >>= updateState . setExcludedTags
170− "select_tags" -> tagList >>= updateState . setSelectedTags
171− "pandoc-emphasis-pre" -> emphChars >>= updateState . setEmphasisPreChar
172− "pandoc-emphasis-post" -> emphChars >>= updateState . setEmphasisPostChar
173− _ -> mzero
174−
175−addLinkFormat :: Monad m => Text
176− -> (Text -> Text)
177− -> OrgParser m ()
178−addLinkFormat key formatter = updateState $ \s ->
179− let fs = orgStateLinkFormatters s
180− in s{ orgStateLinkFormatters = Map.insert key formatter fs }
181−
182−parseLinkFormat :: Monad m => OrgParser m (Text, Text -> Text)
183−parseLinkFormat = try $ do
172+-- | Parse a link type definition (like @wp https://en.wikipedia.org/wiki/@).
173+addLinkFormatter :: Monad m => OrgParser m ()
174+addLinkFormatter = try $ do
184175 linkType <- T.cons <$> letter <*> manyChar (alphaNum <|> oneOf "-_") <* skipSpaces
185− linkSubst <- parseFormat
186− return (linkType, linkSubst)
176+ formatter <- parseFormat
177+ updateState $ \s ->
178+ let fs = orgStateLinkFormatters s
179+ in s{ orgStateLinkFormatters = Map.insert linkType formatter fs }
187180
188181-- | An ad-hoc, single-argument-only implementation of a printf-style format
189182-- parser.
190183parseFormat :: Monad m => OrgParser m (Text -> Text)
191184parseFormat = try $ replacePlain <|> replaceUrl <|> justAppend
192185 where
193− -- inefficient, but who cares
186+ -- inefficient
194187 replacePlain = try $ (\x -> T.concat . flip intersperse x)
195188 <$> sequence [tillSpecifier 's', rest]
196189 replaceUrl = try $ (\x -> T.concat . flip intersperse x . T.pack . urlEncode . T.unpack)
@@ -229,6 +222,7 @@ setEmphasisPostChar csMb st =
229222 let postChars = fromMaybe (orgStateEmphasisPostChars defaultOrgParserState) csMb
230223 in st { orgStateEmphasisPostChars = postChars }
231224
225+-- | Parses emphasis border character like @".,?!"@
232226emphChars :: Monad m => OrgParser m (Maybe [Char])
233227emphChars = do
234228 skipSpaces
@@ -239,16 +233,14 @@ lineOfInlines = do
239233 updateLastPreCharPos
240234 trimInlinesF . mconcat <$> manyTill inline newline
241235
242−--
243−-- ToDo Sequences and Keywords
244−--
236+-- | Parses ToDo sequences / keywords like @TODO DOING | DONE@.
245237todoSequence :: Monad m => OrgParser m TodoSequence
246238todoSequence = try $ do
247239 todoKws <- todoKeywords
248240 doneKws <- optionMaybe $ todoDoneSep *> todoKeywords
249241 newline
250− -- There must be at least one DONE keyword. The last TODO keyword is taken if
251− -- necessary.
242+ -- There must be at least one DONE keyword. The last TODO keyword is
243+ -- taken if necessary.
252244 case doneKws of
253245 Just done -> return $ keywordsToSequence todoKws done
254246 Nothing -> case reverse todoKws of