From bea86f394e6bc77d7441bb98f10a8b8ccfee04c9 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Sat, 20 Mar 2021 11:23:41 -0700
Subject: [PATCH] Markdown reader: export `yamlMetaBlock`.

[API change]

This will allow us to parse YAML metadata blocks in other
readers, potentially.
---
 src/Text/Pandoc/Readers/Markdown.hs | 42 ++++++++++++++++-------------
 1 file changed, 24 insertions(+), 18 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
-  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
+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
 
-stopLine :: PandocMonad m => MarkdownParser m ()
+yamlMetaBlock' :: PandocMonad m => MarkdownParser m (F Blocks)
+yamlMetaBlock' = do
+  guardEnabled Ext_yaml_metadata_block
+  newMetaF <- yamlMetaBlock parseBlocks
+  -- Since `<>` is left-biased, existing values are not touched:
+  updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF }
+  return mempty
+
+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