Markdown Reader: factor out yamlBsToMeta

This commit is contained in:
mb21 2018-09-15 13:22:45 +02:00
parent 700f7a141f
commit 51c1222457

View file

@ -36,6 +36,7 @@ module Text.Pandoc.Readers.Markdown ( readMarkdown ) where
import Prelude import Prelude
import Control.Monad import Control.Monad
import Control.Monad.Except (throwError) import Control.Monad.Except (throwError)
import qualified Data.ByteString.Lazy as BS
import Data.Char (isAlphaNum, isPunctuation, isSpace, toLower) import Data.Char (isAlphaNum, isPunctuation, isSpace, toLower)
import Data.List (intercalate, sortBy, transpose, elemIndex) import Data.List (intercalate, sortBy, transpose, elemIndex)
import qualified Data.Map as M import qualified Data.Map as M
@ -233,7 +234,6 @@ pandocTitleBlock = try $ do
yamlMetaBlock :: PandocMonad m => MarkdownParser m (F Blocks) yamlMetaBlock :: PandocMonad m => MarkdownParser m (F Blocks)
yamlMetaBlock = try $ do yamlMetaBlock = try $ do
guardEnabled Ext_yaml_metadata_block guardEnabled Ext_yaml_metadata_block
pos <- getPosition
string "---" string "---"
blankline blankline
notFollowedBy blankline -- if --- is followed by a blank it's an HRULE notFollowedBy blankline -- if --- is followed by a blank it's an HRULE
@ -241,8 +241,13 @@ yamlMetaBlock = try $ do
-- by including --- and ..., we allow yaml blocks with just comments: -- by including --- and ..., we allow yaml blocks with just comments:
let rawYaml = unlines ("---" : (rawYamlLines ++ ["..."])) let rawYaml = unlines ("---" : (rawYamlLines ++ ["..."]))
optional blanklines optional blanklines
case YAML.decodeNode' YAML.failsafeSchemaResolver False False yamlBsToMeta $ UTF8.fromStringLazy rawYaml
(UTF8.fromStringLazy rawYaml) of return mempty
yamlBsToMeta :: PandocMonad m => BS.ByteString -> MarkdownParser m ()
yamlBsToMeta bstr = do
pos <- getPosition
case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of
Right [YAML.Doc (YAML.Mapping _ hashmap)] -> Right [YAML.Doc (YAML.Mapping _ hashmap)] ->
mapM_ (\(key, v) -> do mapM_ (\(key, v) -> do
k <- nodeToKey key k <- nodeToKey key
@ -271,7 +276,6 @@ yamlMetaBlock = try $ do
logMessage $ CouldNotParseYamlMetadata logMessage $ CouldNotParseYamlMetadata
err' pos err' pos
return () return ()
return mempty
nodeToKey :: Monad m => YAML.Node -> m Text nodeToKey :: Monad m => YAML.Node -> m Text
nodeToKey (YAML.Scalar (YAML.SStr t)) = return t nodeToKey (YAML.Scalar (YAML.SStr t)) = return t