@@ -15,6 +15,7 @@ Conversion of markdown-formatted plain text to 'Pandoc' document.
1515-}
1616module Text.Pandoc.Readers.Markdown (
1717 readMarkdown,
18+ yamlMetaBlock,
1819 yamlToMeta,
1920 yamlToRefs ) where
2021
@@ -274,24 +275,29 @@ pandocTitleBlock = do
274275 $ nullMeta
275276 updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }
276277
277−yamlMetaBlock :: PandocMonad m => MarkdownParser m (F Blocks)
278−yamlMetaBlock = do
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
282+ string "---"
283+ blankline
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 ++ ["..."]))
288+ optional blanklines
289+ yamlBsToMeta (fmap B.toMetaValue <$> parser)
290+ $ UTF8.fromTextLazy $ TL.fromStrict rawYaml
291+
292+yamlMetaBlock' :: PandocMonad m => MarkdownParser m (F Blocks)
293+yamlMetaBlock' = do
279294 guardEnabled Ext_yaml_metadata_block
280− try $ do
281− string "---"
282− blankline
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 ++ ["..."]))
287− optional blanklines
288− newMetaF <- yamlBsToMeta (fmap B.toMetaValue <$> parseBlocks)
289− $ UTF8.fromTextLazy $ TL.fromStrict rawYaml
290− -- Since `<>` is left-biased, existing values are not touched:
291− updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF }
292− return mempty
295+ newMetaF <- yamlMetaBlock parseBlocks
296+ -- Since `<>` is left-biased, existing values are not touched:
297+ updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF }
298+ return mempty
293299
294−stopLine :: PandocMonad m => MarkdownParser m ()
300+stopLine :: PandocMonad m => ParserT Text st m ()
295301stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()
296302
297303mmdTitleBlock :: PandocMonad m => MarkdownParser m ()
@@ -456,7 +462,7 @@ block :: PandocMonad m => MarkdownParser m (F Blocks)
456462block = do
457463 res <- choice [ mempty <$ blanklines
458464 , codeBlockFenced
459− , yamlMetaBlock
465+ , yamlMetaBlock'
460466 -- note: bulletList needs to be before header because of
461467 -- the possibility of empty list items: -
462468 , bulletList