@@ -22,7 +22,7 @@ import Text.Pandoc.Readers.Org.Inlines
22import Text.Pandoc.Readers.Org.ParserState
22import Text.Pandoc.Readers.Org.ParserState
23import Text.Pandoc.Readers.Org.Parsing
23import Text.Pandoc.Readers.Org.Parsing
25−import Text.Pandoc.Builder (Blocks, Inlines, ToMetaValue)
25+import Text.Pandoc.Builder (Blocks, Inlines)
26import qualified Text.Pandoc.Builder as B
26import qualified Text.Pandoc.Builder as B
27import Text.Pandoc.Class.PandocMonad (PandocMonad)
27import Text.Pandoc.Class.PandocMonad (PandocMonad)
28import Text.Pandoc.Definition
28import Text.Pandoc.Definition
@@ -57,13 +57,13 @@ removeMeta key meta' =
57-- The order, in which blocks are tried, makes sure that we're not looking at
57-- The order, in which blocks are tried, makes sure that we're not looking at
58-- the beginning of a block, so we don't need to check for it
58-- the beginning of a block, so we don't need to check for it
59metaLine :: PandocMonad m => OrgParser m Blocks
59metaLine :: PandocMonad m => OrgParser m Blocks
60−metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
60+metaLine = try $ mempty <$ metaLineStart <* keywordLine
62−declarationLine :: PandocMonad m => OrgParser m ()
62+keywordLine :: PandocMonad m => OrgParser m ()
63−declarationLine = try $ do
63+keywordLine = try $ do
64 key <- T.toLower <$> metaKey
64 key <- T.toLower <$> metaKey
65− case Map.lookup key exportSettingHandlers of
65+ case Map.lookup key keywordHandlers of
66− Nothing -> () <$ anyLine
66+ Nothing -> fail $ "Unknown keyword: " ++ T.unpack key
67 Just hd -> hd
67 Just hd -> hd
69metaKey :: Monad m => OrgParser m Text
69metaKey :: Monad m => OrgParser m Text
@@ -71,28 +71,55 @@ metaKey = T.toLower <$> many1Char (noneOf ": \n\r")
71 <* char ':'
71 <* char ':'
72 <* skipSpaces
72 <* skipSpaces
75+(~~>) :: a -> b -> (a, b)
74−exportSettingHandlers :: PandocMonad m => Map Text (OrgParser m ())
78+keywordHandlers :: PandocMonad m => Map Text (OrgParser m ())
75−exportSettingHandlers = Map.fromList
79+keywordHandlers = Map.fromList
80+ [ "author" ~~> lineOfInlines `parseThen` collectLines "author"
76− [ ("result" , fmap pure anyLine `parseThen` discard)
81+ , "creator" ~~> fmap pure anyLine `parseThen` B.setMeta "creator"
77− -- Common settings
82+ , "date" ~~> lineOfInlines `parseThen` B.setMeta "date"
78− , ("author" , lineOfInlines `parseThen` collectLines "author")
83+ , "description" ~~> lineOfInlines `parseThen` collectLines "description"
79− , ("date" , lineOfInlines `parseThen` setField "date")
84+ , "email" ~~> fmap pure anyLine `parseThen` B.setMeta "email"
85+ , "exclude_tags" ~~> tagList >>= updateState . setExcludedTags
86+ , "header-includes" ~~>
80− , ("description", lineOfInlines `parseThen` collectLines "description")
87+ lineOfInlines `parseThen` collectLines "header-includes"
88+ -- HTML-specifix export settings
90+ metaExportSnippet "html" `parseThen` collectAsList "header-includes"
91+ , "html_head_extra" ~~>
92+ metaExportSnippet "html" `parseThen` collectAsList "header-includes"
81− , ("keywords" , lineOfInlines `parseThen` collectLines "keywords")
93+ , "institute" ~~> lineOfInlines `parseThen` collectLines "institute"
82− , ("title" , lineOfInlines `parseThen` collectLines "title")
95+ , "keywords" ~~> lineOfInlines `parseThen` collectLines "keywords"
83− -- LaTeX
96+ -- LaTeX-specific export settings
84− , ("latex_class", fmap pure anyLine `parseThen` setField "documentclass")
97+ , "latex_class" ~~> fmap pure anyLine `parseThen` B.setMeta "documentclass"
98+ , "latex_class_options" ~~>
85− , ("latex_class_options", (pure . T.filter (`notElem` ("[]" :: String)) <$> anyLine)
99+ (pure . T.filter (`notElem` ("[]" :: String)) <$> anyLine)
86− `parseThen` setField "classoption")
100+ `parseThen` B.setMeta "classoption"
87− , ("latex_header", metaExportSnippet "latex" `parseThen`
101+ , "latex_header" ~~>
88− collectAsList "header-includes")
102+ metaExportSnippet "latex" `parseThen` collectAsList "header-includes"
89− -- HTML
103+ , "latex_header_extra" ~~>
90− , ("html_head" , metaExportSnippet "html" `parseThen`
91− collectAsList "header-includes")
104+ metaExportSnippet "latex" `parseThen` collectAsList "header-includes"
106+ , "link" ~~> addLinkFormatter
107+ , "macro" ~~> macroDefinition >>= updateState . registerMacro
92− -- pandoc-specific
108+ -- pandoc-specific way to include references in the bibliography
93− , ("nocite" , lineOfInlines `parseThen` collectLines "nocite")
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
94− , ("header-includes", lineOfInlines `parseThen` collectLines "header-includes")
119+ , "subtitle" ~~> lineOfInlines `parseThen` collectLines "subtitle"
95− , ("institute" , lineOfInlines `parseThen` collectLines "institute")
120+ , "title" ~~> lineOfInlines `parseThen` collectLines "title"
121+ , "todo" ~~> todoSequence >>= updateState . registerTodoSequence
122+ , "typ_todo" ~~> todoSequence >>= updateState . registerTodoSequence
98parseThen :: PandocMonad m
125parseThen :: PandocMonad m
@@ -104,9 +131,6 @@ parseThen p modMeta = do
104 meta <- orgStateMeta <$> getState
131 meta <- orgStateMeta <$> getState
105 updateState (\st -> st { orgStateMeta = modMeta <$> value <*> meta })
132 updateState (\st -> st { orgStateMeta = modMeta <$> value <*> meta })
107−discard :: a -> Meta -> Meta
110collectLines :: Text -> Inlines -> Meta -> Meta
134collectLines :: Text -> Inlines -> Meta -> Meta
111collectLines key value meta =
135collectLines key value meta =
112 let value' = appendValue meta (B.toList value)
136 let value' = appendValue meta (B.toList value)
@@ -141,51 +165,25 @@ collectAsList key value meta =
141 Just x -> [x]
165 Just x -> [x]
144−setField :: ToMetaValue a => Text -> a -> Meta -> Meta
145−setField field value meta = B.setMeta field (B.toMetaValue value) meta
147-- | Read an format specific meta definition
168-- | Read an format specific meta definition
148metaExportSnippet :: Monad m => Text -> OrgParser m (F Inlines)
169metaExportSnippet :: Monad m => Text -> OrgParser m (F Inlines)
149metaExportSnippet format = pure . B.rawInline format <$> anyLine
170metaExportSnippet format = pure . B.rawInline format <$> anyLine
151−--
172+-- | Parse a link type definition (like @wp https://en.wikipedia.org/wiki/@).
154−optionLine :: PandocMonad m => OrgParser m ()
155−optionLine = try $ do
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
170−addLinkFormat :: Monad m => Text
173−addLinkFormat key formatter = updateState $ \s ->
174− let fs = orgStateLinkFormatters s
175− in s{ orgStateLinkFormatters = Map.insert key formatter fs }
177−parseLinkFormat :: Monad m => OrgParser m (Text, Text -> Text)
173+addLinkFormatter :: Monad m => OrgParser m ()
178−parseLinkFormat = try $ do
174+addLinkFormatter = try $ do
179 linkType <- T.cons <$> letter <*> manyChar (alphaNum <|> oneOf "-_") <* skipSpaces
175 linkType <- T.cons <$> letter <*> manyChar (alphaNum <|> oneOf "-_") <* skipSpaces
180− linkSubst <- parseFormat
176+ formatter <- parseFormat
181− return (linkType, linkSubst)
177+ updateState $ \s ->
178+ let fs = orgStateLinkFormatters s
179+ in s{ orgStateLinkFormatters = Map.insert linkType formatter fs }
183-- | An ad-hoc, single-argument-only implementation of a printf-style format
181-- | An ad-hoc, single-argument-only implementation of a printf-style format
184-- parser.
182-- parser.
185parseFormat :: Monad m => OrgParser m (Text -> Text)
183parseFormat :: Monad m => OrgParser m (Text -> Text)
186parseFormat = try $ replacePlain <|> replaceUrl <|> justAppend
184parseFormat = try $ replacePlain <|> replaceUrl <|> justAppend
188− -- inefficient, but who cares
186+ -- inefficient
189 replacePlain = try $ (\x -> T.concat . flip intersperse x)
187 replacePlain = try $ (\x -> T.concat . flip intersperse x)
190 <$> sequence [tillSpecifier 's', rest]
188 <$> sequence [tillSpecifier 's', rest]
191 replaceUrl = try $ (\x -> T.concat . flip intersperse x . T.pack . urlEncode . T.unpack)
189 replaceUrl = try $ (\x -> T.concat . flip intersperse x . T.pack . urlEncode . T.unpack)
@@ -224,6 +222,7 @@ setEmphasisPostChar csMb st =
224 let postChars = fromMaybe (orgStateEmphasisPostChars defaultOrgParserState) csMb
222 let postChars = fromMaybe (orgStateEmphasisPostChars defaultOrgParserState) csMb
225 in st { orgStateEmphasisPostChars = postChars }
223 in st { orgStateEmphasisPostChars = postChars }
225+-- | Parses emphasis border character like @".,?!"@
227emphChars :: Monad m => OrgParser m (Maybe [Char])
226emphChars :: Monad m => OrgParser m (Maybe [Char])
228emphChars = do
227emphChars = do
229 skipSpaces
228 skipSpaces
@@ -234,16 +233,14 @@ lineOfInlines = do
234 updateLastPreCharPos
233 updateLastPreCharPos
235 trimInlinesF . mconcat <$> manyTill inline newline
234 trimInlinesF . mconcat <$> manyTill inline newline
237−--
236+-- | Parses ToDo sequences / keywords like @TODO DOING | DONE@.
238−-- ToDo Sequences and Keywords
240todoSequence :: Monad m => OrgParser m TodoSequence
237todoSequence :: Monad m => OrgParser m TodoSequence
241todoSequence = try $ do
238todoSequence = try $ do
242 todoKws <- todoKeywords
239 todoKws <- todoKeywords
243 doneKws <- optionMaybe $ todoDoneSep *> todoKeywords
240 doneKws <- optionMaybe $ todoDoneSep *> todoKeywords
245− -- There must be at least one DONE keyword. The last TODO keyword is taken if
242+ -- There must be at least one DONE keyword. The last TODO keyword is
246− -- necessary.
243+ -- taken if necessary.
247 case doneKws of
244 case doneKws of
248 Just done -> return $ keywordsToSequence todoKws done
245 Just done -> return $ keywordsToSequence todoKws done
249 Nothing -> case reverse todoKws of
246 Nothing -> case reverse todoKws of