aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs24
-rw-r--r--src/Text/Pandoc/Readers/Metadata.hs20
2 files changed, 22 insertions, 22 deletions
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 8d68510c5..6c3947a81 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -15,7 +15,6 @@ Conversion of markdown-formatted plain text to 'Pandoc' document.
-}
module Text.Pandoc.Readers.Markdown (
readMarkdown,
- yamlMetaBlock,
yamlToMeta,
yamlToRefs ) where
@@ -29,7 +28,6 @@ import Data.Maybe
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
import qualified Data.ByteString.Lazy as BL
import System.FilePath (addExtension, takeExtension)
import Text.HTML.TagSoup hiding (Row)
@@ -47,9 +45,8 @@ import Text.Pandoc.Readers.HTML (htmlInBalanced, htmlTag, isBlockTag,
isCommentTag, isInlineTag, isTextTag)
import Text.Pandoc.Readers.LaTeX (applyMacros, rawLaTeXBlock, rawLaTeXInline)
import Text.Pandoc.Shared
-import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.XML (fromEntities)
-import Text.Pandoc.Readers.Metadata (yamlBsToMeta, yamlBsToRefs)
+import Text.Pandoc.Readers.Metadata (yamlBsToMeta, yamlBsToRefs, yamlMetaBlock)
type MarkdownParser m = ParserT Text ParserState m
@@ -275,31 +272,14 @@ pandocTitleBlock = do
$ nullMeta
updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }
-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
- newMetaF <- yamlMetaBlock parseBlocks
+ newMetaF <- yamlMetaBlock (fmap B.toMetaValue <$> 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 ()
mmdTitleBlock = do
guardEnabled Ext_mmd_title_block
diff --git a/src/Text/Pandoc/Readers/Metadata.hs b/src/Text/Pandoc/Readers/Metadata.hs
index f4a27496f..cb141cba5 100644
--- a/src/Text/Pandoc/Readers/Metadata.hs
+++ b/src/Text/Pandoc/Readers/Metadata.hs
@@ -14,6 +14,7 @@ Parse YAML/JSON metadata to 'Pandoc' 'Meta'.
module Text.Pandoc.Readers.Metadata (
yamlBsToMeta,
yamlBsToRefs,
+ yamlMetaBlock,
yamlMap ) where
import Control.Monad
@@ -30,6 +31,8 @@ import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.Parsing hiding (tableWith)
import Text.Pandoc.Shared
+import qualified Data.Text.Lazy as TL
+import qualified Text.Pandoc.UTF8 as UTF8
yamlBsToMeta :: (PandocMonad m, HasLastStrPosition st)
=> ParserT Text st m (Future st MetaValue)
@@ -171,3 +174,20 @@ yamlMap pMetaValue o = do
return $ do
v' <- fv
return (k, v')
+
+-- | Parse a YAML metadata block using the supplied 'MetaValue' parser.
+yamlMetaBlock :: (HasLastStrPosition st, PandocMonad m)
+ => ParserT Text st m (Future st MetaValue)
+ -> 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 parser $ UTF8.fromTextLazy $ TL.fromStrict rawYaml
+
+stopLine :: Monad m => ParserT Text st m ()
+stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()