aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2021-03-20 11:23:41 -0700
committerJohn MacFarlane <jgm@berkeley.edu>2021-03-20 15:58:33 -0700
commitbea86f394e6bc77d7441bb98f10a8b8ccfee04c9 (patch)
tree1104f0e7a33cebed776b5954af47f096cd62045e /src/Text
parentce418667ae8a3e6e5bbf2523eef43edf4f803bcf (diff)
downloadpandoc-bea86f394e6bc77d7441bb98f10a8b8ccfee04c9.tar.gz
Markdown reader: export `yamlMetaBlock`.
[API change] This will allow us to parse YAML metadata blocks in other readers, potentially.
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs40
1 files changed, 23 insertions, 17 deletions
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 7c557b5a7..8d68510c5 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -15,6 +15,7 @@ Conversion of markdown-formatted plain text to 'Pandoc' document.
-}
module Text.Pandoc.Readers.Markdown (
readMarkdown,
+ yamlMetaBlock,
yamlToMeta,
yamlToRefs ) where
@@ -274,24 +275,29 @@ pandocTitleBlock = do
$ nullMeta
updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }
-yamlMetaBlock :: PandocMonad m => MarkdownParser m (F Blocks)
-yamlMetaBlock = do
+yamlMetaBlock :: (HasLastStrPosition st, PandocMonad m)
+ => ParserT Text st m (Future st Blocks)
+ -> ParserT Text st m (Future st Meta)
+yamlMetaBlock parser = try $ do
+ string "---"
+ blankline
+ notFollowedBy blankline -- if --- is followed by a blank it's an HRULE
+ rawYamlLines <- manyTill anyLine stopLine
+ -- by including --- and ..., we allow yaml blocks with just comments:
+ let rawYaml = T.unlines ("---" : (rawYamlLines ++ ["..."]))
+ optional blanklines
+ yamlBsToMeta (fmap B.toMetaValue <$> parser)
+ $ UTF8.fromTextLazy $ TL.fromStrict rawYaml
+
+yamlMetaBlock' :: PandocMonad m => MarkdownParser m (F Blocks)
+yamlMetaBlock' = do
guardEnabled Ext_yaml_metadata_block
- try $ do
- string "---"
- blankline
- notFollowedBy blankline -- if --- is followed by a blank it's an HRULE
- rawYamlLines <- manyTill anyLine stopLine
- -- by including --- and ..., we allow yaml blocks with just comments:
- let rawYaml = T.unlines ("---" : (rawYamlLines ++ ["..."]))
- optional blanklines
- newMetaF <- yamlBsToMeta (fmap B.toMetaValue <$> parseBlocks)
- $ UTF8.fromTextLazy $ TL.fromStrict rawYaml
- -- Since `<>` is left-biased, existing values are not touched:
- updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF }
- return mempty
+ newMetaF <- yamlMetaBlock parseBlocks
+ -- Since `<>` is left-biased, existing values are not touched:
+ updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF }
+ return mempty
-stopLine :: PandocMonad m => MarkdownParser m ()
+stopLine :: PandocMonad m => ParserT Text st m ()
stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()
mmdTitleBlock :: PandocMonad m => MarkdownParser m ()
@@ -456,7 +462,7 @@ block :: PandocMonad m => MarkdownParser m (F Blocks)
block = do
res <- choice [ mempty <$ blanklines
, codeBlockFenced
- , yamlMetaBlock
+ , yamlMetaBlock'
-- note: bulletList needs to be before header because of
-- the possibility of empty list items: -
, bulletList