diff options
| author | Nikolay Yakimov <root@livid.pp.ru> | 2020-05-01 03:11:44 +0300 |
|---|---|---|
| committer | Nikolay Yakimov <root@livid.pp.ru> | 2020-06-29 17:06:29 +0300 |
| commit | f26923b9e493ecd2c4515d821da58e88fd2d946b (patch) | |
| tree | ebb07c00074e1ca9706db97a42e1e6f5115d22c1 /src/Text/Pandoc/Readers | |
| parent | 11dc9f84f54650037c60917435fd91a90f94f9cf (diff) | |
| download | pandoc-f26923b9e493ecd2c4515d821da58e88fd2d946b.tar.gz | |
Unify defaults and markdown metadata parsers
Diffstat (limited to 'src/Text/Pandoc/Readers')
| -rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 7 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Metadata.hs | 28 |
2 files changed, 20 insertions, 15 deletions
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 41ca8bfe1..77a371537 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -67,14 +67,17 @@ yamlToMeta :: PandocMonad m -> m Meta yamlToMeta opts bstr = do let parser = do - meta <- yamlBsToMeta parseBlocks bstr + meta <- yamlBsToMeta (fmap asBlocks parseBlocks) bstr return $ runF meta defaultParserState parsed <- readWithM parser def{ stateOptions = opts } "" case parsed of Right result -> return result Left e -> throwError e + where +asBlocks :: Functor f => f (B.Many Block) -> f MetaValue +asBlocks p = MetaBlocks . B.toList <$> p -- -- Constants and data structure definitions @@ -240,7 +243,7 @@ yamlMetaBlock = try $ do -- by including --- and ..., we allow yaml blocks with just comments: let rawYaml = T.unlines ("---" : (rawYamlLines ++ ["..."])) optional blanklines - newMetaF <- yamlBsToMeta parseBlocks + newMetaF <- yamlBsToMeta (asBlocks <$> parseBlocks) $ UTF8.fromTextLazy $ TL.fromStrict rawYaml -- Since `<>` is left-biased, existing values are not touched: updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF } diff --git a/src/Text/Pandoc/Readers/Metadata.hs b/src/Text/Pandoc/Readers/Metadata.hs index b2028252d..94d4f0f0d 100644 --- a/src/Text/Pandoc/Readers/Metadata.hs +++ b/src/Text/Pandoc/Readers/Metadata.hs @@ -11,7 +11,7 @@ Parse YAML/JSON metadata to 'Pandoc' 'Meta'. -} -module Text.Pandoc.Readers.Metadata ( yamlBsToMeta ) where +module Text.Pandoc.Readers.Metadata ( yamlBsToMeta, yamlMap ) where import Control.Monad import Control.Monad.Except (throwError) @@ -22,7 +22,6 @@ import qualified Data.Text as T import qualified Data.YAML as YAML import qualified Data.YAML.Event as YE import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Builder (Blocks) import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) import Text.Pandoc.Definition import Text.Pandoc.Error @@ -31,7 +30,7 @@ import Text.Pandoc.Parsing hiding (tableWith) import Text.Pandoc.Shared yamlBsToMeta :: PandocMonad m - => ParserT Text ParserState m (F Blocks) + => ParserT Text ParserState m (F MetaValue) -> BL.ByteString -> ParserT Text ParserState m (F Meta) yamlBsToMeta pBlocks bstr = do @@ -59,7 +58,7 @@ nodeToKey _ = throwError $ PandocParseError "Non-string key in YAML mapping" toMetaValue :: PandocMonad m - => ParserT Text ParserState m (F Blocks) + => ParserT Text ParserState m (F MetaValue) -> Text -> ParserT Text ParserState m (F MetaValue) toMetaValue pBlocks x = @@ -67,18 +66,21 @@ toMetaValue pBlocks x = -- not end in a newline, but a "block" set off with -- `|` or `>` will. if "\n" `T.isSuffixOf` x - then parseFromString' (asBlocks <$> pBlocks) (x <> "\n") + then parseFromString' pBlocks (x <> "\n") else parseFromString' pInlines x where pInlines = do bs <- pBlocks return $ do bs' <- bs return $ - case B.toList bs' of - [Plain ils] -> MetaInlines ils - [Para ils] -> MetaInlines ils - xs -> MetaBlocks xs - asBlocks p = MetaBlocks . B.toList <$> p + case bs' of + MetaBlocks bs'' -> + case bs'' of + [Plain ils] -> MetaInlines ils + [Para ils] -> MetaInlines ils + xs -> MetaBlocks xs + _ -> bs' + checkBoolean :: Text -> Maybe Bool checkBoolean t @@ -87,7 +89,7 @@ checkBoolean t | otherwise = Nothing yamlToMetaValue :: PandocMonad m - => ParserT Text ParserState m (F Blocks) + => ParserT Text ParserState m (F MetaValue) -> YAML.Node YE.Pos -> ParserT Text ParserState m (F MetaValue) yamlToMetaValue pBlocks (YAML.Scalar _ x) = @@ -112,7 +114,7 @@ yamlToMetaValue pBlocks (YAML.Mapping _ _ o) = yamlToMetaValue _ _ = return $ return $ MetaString "" yamlMap :: PandocMonad m - => ParserT Text ParserState m (F Blocks) + => ParserT Text ParserState m (F MetaValue) -> M.Map (YAML.Node YE.Pos) (YAML.Node YE.Pos) -> ParserT Text ParserState m (F (M.Map Text MetaValue)) yamlMap pBlocks o = do @@ -120,7 +122,7 @@ yamlMap pBlocks o = do k <- nodeToKey key return (k, v) let kvs' = filter (not . ignorable . fst) kvs - (fmap M.fromList . sequence) <$> mapM toMeta kvs' + fmap M.fromList . sequence <$> mapM toMeta kvs' where ignorable t = "_" `T.isSuffixOf` t toMeta (k, v) = do |