@@ -15,6 +15,7 @@ Conversion of markdown-formatted plain text to 'Pandoc' document.
16module Text.Pandoc.Readers.Markdown (
16module Text.Pandoc.Readers.Markdown (
17 readMarkdown,
17 readMarkdown,
18 yamlToMeta,
19 yamlToMeta,
19 yamlToRefs ) where
20 yamlToRefs ) where
@@ -274,24 +275,29 @@ pandocTitleBlock = do
274 $ nullMeta
275 $ nullMeta
275 updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }
276 updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }
278+yamlMetaBlock :: (HasLastStrPosition st, PandocMonad m)
279+ => ParserT Text st m (Future st Blocks)
280+ -> ParserT Text st m (Future st Meta)
281+yamlMetaBlock parser = try $ do
284+ notFollowedBy blankline -- if --- is followed by a blank it's an HRULE
285+ rawYamlLines <- manyTill anyLine stopLine
286+ -- by including --- and ..., we allow yaml blocks with just comments:
287+ let rawYaml = T.unlines ("---" : (rawYamlLines ++ ["..."]))
289+ yamlBsToMeta (fmap B.toMetaValue <$> parser)
290+ $ UTF8.fromTextLazy $ TL.fromStrict rawYaml
277−yamlMetaBlock :: PandocMonad m => MarkdownParser m (F Blocks)
292+yamlMetaBlock' :: PandocMonad m => MarkdownParser m (F Blocks)
278−yamlMetaBlock = do
293+yamlMetaBlock' = do
279 guardEnabled Ext_yaml_metadata_block
294 guardEnabled Ext_yaml_metadata_block
283− notFollowedBy blankline -- if --- is followed by a blank it's an HRULE
284− rawYamlLines <- manyTill anyLine stopLine
285− -- by including --- and ..., we allow yaml blocks with just comments:
286− let rawYaml = T.unlines ("---" : (rawYamlLines ++ ["..."]))
288− newMetaF <- yamlBsToMeta (fmap B.toMetaValue <$> parseBlocks)
295+ newMetaF <- yamlMetaBlock parseBlocks
289− $ UTF8.fromTextLazy $ TL.fromStrict rawYaml
290− -- Since `<>` is left-biased, existing values are not touched:
296+ -- Since `<>` is left-biased, existing values are not touched:
291− updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF }
297+ updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF }
292− return mempty
298+ return mempty
294−stopLine :: PandocMonad m => MarkdownParser m ()
300+stopLine :: PandocMonad m => ParserT Text st m ()
295stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()
301stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()
297mmdTitleBlock :: PandocMonad m => MarkdownParser m ()
303mmdTitleBlock :: PandocMonad m => MarkdownParser m ()
@@ -456,7 +462,7 @@ block :: PandocMonad m => MarkdownParser m (F Blocks)
456block = do
462block = do
457 res <- choice [ mempty <$ blanklines
463 res <- choice [ mempty <$ blanklines
458 , codeBlockFenced
464 , codeBlockFenced
459− , yamlMetaBlock
465+ , yamlMetaBlock'
460 -- note: bulletList needs to be before header because of
466 -- note: bulletList needs to be before header because of
461 -- the possibility of empty list items: -
467 -- the possibility of empty list items: -
462 , bulletList
468 , bulletList