diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 24 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Metadata.hs | 20 |
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 () |