@@ -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 = try $ 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 -> fail $ "Unknown keyword: " ++ T.unpack key
6767 Just hd -> hd
6868
6969metaKey :: Monad m => OrgParser m Text
@@ -71,28 +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− , ("title" , lineOfInlines `parseThen` collectLines "title")
83− -- LaTeX
84− , ("latex_class", fmap pure anyLine `parseThen` setField "documentclass")
85− , ("latex_class_options", (pure . T.filter (`notElem` ("[]" :: String)) <$> anyLine)
86− `parseThen` setField "classoption")
87− , ("latex_header", metaExportSnippet "latex" `parseThen`
88− collectAsList "header-includes")
89− -- HTML
90− , ("html_head" , metaExportSnippet "html" `parseThen`
91− collectAsList "header-includes")
92− -- pandoc-specific
93− , ("nocite" , lineOfInlines `parseThen` collectLines "nocite")
94− , ("header-includes", lineOfInlines `parseThen` collectLines "header-includes")
95− , ("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
96123 ]
97124
98125parseThen :: PandocMonad m
@@ -104,9 +131,6 @@ parseThen p modMeta = do
104131 meta <- orgStateMeta <$> getState
105132 updateState (\st -> st { orgStateMeta = modMeta <$> value <*> meta })
106133
107−discard :: a -> Meta -> Meta
108−discard = const id
109−
110134collectLines :: Text -> Inlines -> Meta -> Meta
111135collectLines key value meta =
112136 let value' = appendValue meta (B.toList value)
@@ -141,51 +165,25 @@ collectAsList key value meta =
141165 Just x -> [x]
142166 _ -> []
143167
144−setField :: ToMetaValue a => Text -> a -> Meta -> Meta
145−setField field value meta = B.setMeta field (B.toMetaValue value) meta
146−
147168-- | Read an format specific meta definition
148169metaExportSnippet :: Monad m => Text -> OrgParser m (F Inlines)
149170metaExportSnippet format = pure . B.rawInline format <$> anyLine
150171
151−--
152−-- export options
153−--
154−optionLine :: PandocMonad m => OrgParser m ()
155−optionLine = try $ do
156− key <- metaKey
157− case key of
158− "link" -> parseLinkFormat >>= uncurry addLinkFormat
159− "options" -> exportSettings
160− "todo" -> todoSequence >>= updateState . registerTodoSequence
161− "seq_todo" -> todoSequence >>= updateState . registerTodoSequence
162− "typ_todo" -> todoSequence >>= updateState . registerTodoSequence
163− "macro" -> macroDefinition >>= updateState . registerMacro
164− "exclude_tags" -> tagList >>= updateState . setExcludedTags
165− "select_tags" -> tagList >>= updateState . setSelectedTags
166− "pandoc-emphasis-pre" -> emphChars >>= updateState . setEmphasisPreChar
167− "pandoc-emphasis-post" -> emphChars >>= updateState . setEmphasisPostChar
168− _ -> mzero
169−
170−addLinkFormat :: Monad m => Text
171− -> (Text -> Text)
172− -> OrgParser m ()
173−addLinkFormat key formatter = updateState $ \s ->
174− let fs = orgStateLinkFormatters s
175− in s{ orgStateLinkFormatters = Map.insert key formatter fs }
176−
177−parseLinkFormat :: Monad m => OrgParser m (Text, Text -> Text)
178−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
179175 linkType <- T.cons <$> letter <*> manyChar (alphaNum <|> oneOf "-_") <* skipSpaces
180− linkSubst <- parseFormat
181− return (linkType, linkSubst)
176+ formatter <- parseFormat
177+ updateState $ \s ->
178+ let fs = orgStateLinkFormatters s
179+ in s{ orgStateLinkFormatters = Map.insert linkType formatter fs }
182180
183181-- | An ad-hoc, single-argument-only implementation of a printf-style format
184182-- parser.
185183parseFormat :: Monad m => OrgParser m (Text -> Text)
186184parseFormat = try $ replacePlain <|> replaceUrl <|> justAppend
187185 where
188− -- inefficient, but who cares
186+ -- inefficient
189187 replacePlain = try $ (\x -> T.concat . flip intersperse x)
190188 <$> sequence [tillSpecifier 's', rest]
191189 replaceUrl = try $ (\x -> T.concat . flip intersperse x . T.pack . urlEncode . T.unpack)
@@ -224,6 +222,7 @@ setEmphasisPostChar csMb st =
224222 let postChars = fromMaybe (orgStateEmphasisPostChars defaultOrgParserState) csMb
225223 in st { orgStateEmphasisPostChars = postChars }
226224
225+-- | Parses emphasis border character like @".,?!"@
227226emphChars :: Monad m => OrgParser m (Maybe [Char])
228227emphChars = do
229228 skipSpaces
@@ -234,16 +233,14 @@ lineOfInlines = do
234233 updateLastPreCharPos
235234 trimInlinesF . mconcat <$> manyTill inline newline
236235
237−--
238−-- ToDo Sequences and Keywords
239−--
236+-- | Parses ToDo sequences / keywords like @TODO DOING | DONE@.
240237todoSequence :: Monad m => OrgParser m TodoSequence
241238todoSequence = try $ do
242239 todoKws <- todoKeywords
243240 doneKws <- optionMaybe $ todoDoneSep *> todoKeywords
244241 newline
245− -- There must be at least one DONE keyword. The last TODO keyword is taken if
246− -- necessary.
242+ -- There must be at least one DONE keyword. The last TODO keyword is
243+ -- taken if necessary.
247244 case doneKws of
248245 Just done -> return $ keywordsToSequence todoKws done
249246 Nothing -> case reverse todoKws of