git.iko.soy/typeable/pandoc
on master help sign in
Move yamlMetaBlock from Markdown reader to T.P.Readers.Metadata.
commit2274eb88a4dddf622d86bee94bb6f20db6e148b2 authorJohn MacFarlane <jgm@berkeley.edu> dateSat 20 Mar 2021, 11:37 (6 years ago) parentbea86f3
2 files changed+22−22
compare with master
unifiedsplit
src/Text/Pandoc/Readers/Markdown.hs+2−22 src/Text/Pandoc/Readers/Metadata.hs+20
src/Text/Pandoc/Readers/Markdown.hs+2−22
@@ -15,7 +15,6 @@ Conversion of markdown-formatted plain text to 'Pandoc' document.
1515-}
1616module Text.Pandoc.Readers.Markdown (
1717 readMarkdown,
18− yamlMetaBlock,
1918 yamlToMeta,
2019 yamlToRefs ) where
2120
@@ -29,7 +28,6 @@ import Data.Maybe
2928import qualified Data.Set as Set
3029import Data.Text (Text)
3130import qualified Data.Text as T
32−import qualified Data.Text.Lazy as TL
3331import qualified Data.ByteString.Lazy as BL
3432import System.FilePath (addExtension, takeExtension)
3533import Text.HTML.TagSoup hiding (Row)
@@ -47,9 +45,8 @@ import Text.Pandoc.Readers.HTML (htmlInBalanced, htmlTag, isBlockTag,
4745 isCommentTag, isInlineTag, isTextTag)
4846import Text.Pandoc.Readers.LaTeX (applyMacros, rawLaTeXBlock, rawLaTeXInline)
4947import Text.Pandoc.Shared
50−import qualified Text.Pandoc.UTF8 as UTF8
5148import Text.Pandoc.XML (fromEntities)
52−import Text.Pandoc.Readers.Metadata (yamlBsToMeta, yamlBsToRefs)
49+import Text.Pandoc.Readers.Metadata (yamlBsToMeta, yamlBsToRefs, yamlMetaBlock)
5350
5451type MarkdownParser m = ParserT Text ParserState m
5552
@@ -275,31 +272,14 @@ pandocTitleBlock = do
275272 $ nullMeta
276273 updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }
277274
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−
292275yamlMetaBlock' :: PandocMonad m => MarkdownParser m (F Blocks)
293276yamlMetaBlock' = do
294277 guardEnabled Ext_yaml_metadata_block
295− newMetaF <- yamlMetaBlock parseBlocks
278+ newMetaF <- yamlMetaBlock (fmap B.toMetaValue <$> parseBlocks)
296279 -- Since `<>` is left-biased, existing values are not touched:
297280 updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF }
298281 return mempty
299282
300−stopLine :: PandocMonad m => ParserT Text st m ()
301−stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()
302−
303283mmdTitleBlock :: PandocMonad m => MarkdownParser m ()
304284mmdTitleBlock = do
305285 guardEnabled Ext_mmd_title_block
src/Text/Pandoc/Readers/Metadata.hs+20
@@ -14,6 +14,7 @@ Parse YAML/JSON metadata to 'Pandoc' 'Meta'.
1414module Text.Pandoc.Readers.Metadata (
1515 yamlBsToMeta,
1616 yamlBsToRefs,
17+ yamlMetaBlock,
1718 yamlMap ) where
1819
1920import Control.Monad
@@ -30,6 +31,8 @@ import Text.Pandoc.Definition
3031import Text.Pandoc.Error
3132import Text.Pandoc.Parsing hiding (tableWith)
3233import Text.Pandoc.Shared
34+import qualified Data.Text.Lazy as TL
35+import qualified Text.Pandoc.UTF8 as UTF8
3336
3437yamlBsToMeta :: (PandocMonad m, HasLastStrPosition st)
3538 => ParserT Text st m (Future st MetaValue)
@@ -171,3 +174,20 @@ yamlMap pMetaValue o = do
171174 return $ do
172175 v' <- fv
173176 return (k, v')
177+
178+-- | Parse a YAML metadata block using the supplied 'MetaValue' parser.
179+yamlMetaBlock :: (HasLastStrPosition st, PandocMonad m)
180+ => ParserT Text st m (Future st MetaValue)
181+ -> ParserT Text st m (Future st Meta)
182+yamlMetaBlock parser = try $ do
183+ string "---"
184+ blankline
185+ notFollowedBy blankline -- if --- is followed by a blank it's an HRULE
186+ rawYamlLines <- manyTill anyLine stopLine
187+ -- by including --- and ..., we allow yaml blocks with just comments:
188+ let rawYaml = T.unlines ("---" : (rawYamlLines ++ ["..."]))
189+ optional blanklines
190+ yamlBsToMeta parser $ UTF8.fromTextLazy $ TL.fromStrict rawYaml
191+
192+stopLine :: Monad m => ParserT Text st m ()
193+stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()