@@ -1,4 +1,3 @@
1−{-# LANGUAGE ScopedTypeVariables #-}
21{-# LANGUAGE OverloadedStrings #-}
32{- |
43 Module : Text.Pandoc.Readers.Metadata
@@ -11,7 +10,7 @@
1110
1211Parse YAML/JSON metadata to 'Pandoc' 'Meta'.
1312-}
14−module Text.Pandoc.Readers.Metadata ( yamlBsToMeta ) where
13+module Text.Pandoc.Readers.Metadata ( yamlBsToMeta, yamlMap ) where
1514
1615import Control.Monad
1716import Control.Monad.Except (throwError)
@@ -21,8 +20,6 @@ import Data.Text (Text)
2120import qualified Data.Text as T
2221import qualified Data.YAML as YAML
2322import qualified Data.YAML.Event as YE
24−import qualified Text.Pandoc.Builder as B
25−import Text.Pandoc.Builder (Blocks)
2623import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
2724import Text.Pandoc.Definition
2825import Text.Pandoc.Error
@@ -31,14 +28,14 @@ import Text.Pandoc.Parsing hiding (tableWith)
3128import Text.Pandoc.Shared
3229
3330yamlBsToMeta :: PandocMonad m
34− => ParserT Text ParserState m (F Blocks)
31+ => ParserT Text ParserState m (F MetaValue)
3532 -> BL.ByteString
3633 -> ParserT Text ParserState m (F Meta)
37−yamlBsToMeta pBlocks bstr = do
34+yamlBsToMeta pMetaValue bstr = do
3835 pos <- getPosition
3936 case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of
4037 Right (YAML.Doc (YAML.Mapping _ _ o):_)
41− -> fmap Meta <$> yamlMap pBlocks o
38+ -> fmap Meta <$> yamlMap pMetaValue o
4239 Right [] -> return . return $ mempty
4340 Right [YAML.Doc (YAML.Scalar _ YAML.SNull)]
4441 -> return . return $ mempty
@@ -58,27 +55,21 @@ nodeToKey (YAML.Scalar _ (YAML.SUnknown _ t)) = return t
5855nodeToKey _ = throwError $ PandocParseError
5956 "Non-string key in YAML mapping"
6057
61−toMetaValue :: PandocMonad m
62− => ParserT Text ParserState m (F Blocks)
63− -> Text
64− -> ParserT Text ParserState m (F MetaValue)
65−toMetaValue pBlocks x =
58+normalizeMetaValue :: PandocMonad m
59+ => ParserT Text ParserState m (F MetaValue)
60+ -> Text
61+ -> ParserT Text ParserState m (F MetaValue)
62+normalizeMetaValue pMetaValue x =
6663 -- Note: a standard quoted or unquoted YAML value will
6764 -- not end in a newline, but a "block" set off with
6865 -- `|` or `>` will.
6966 if "\n" `T.isSuffixOf` x
70− then parseFromString' (asBlocks <$> pBlocks) (x <> "\n")
71− else parseFromString' pInlines x
72− where pInlines = do
73− bs <- pBlocks
74− return $ do
75− bs' <- bs
76− return $
77− case B.toList bs' of
78− [Plain ils] -> MetaInlines ils
79− [Para ils] -> MetaInlines ils
80− xs -> MetaBlocks xs
81− asBlocks p = MetaBlocks . B.toList <$> p
67+ then parseFromString' pMetaValue (x <> "\n")
68+ else parseFromString' asInlines x
69+ where asInlines = fmap b2i <$> pMetaValue
70+ b2i (MetaBlocks [Plain ils]) = MetaInlines ils
71+ b2i (MetaBlocks [Para ils]) = MetaInlines ils
72+ b2i bs = bs
8273
8374checkBoolean :: Text -> Maybe Bool
8475checkBoolean t
@@ -87,44 +78,42 @@ checkBoolean t
8778 | otherwise = Nothing
8879
8980yamlToMetaValue :: PandocMonad m
90− => ParserT Text ParserState m (F Blocks)
81+ => ParserT Text ParserState m (F MetaValue)
9182 -> YAML.Node YE.Pos
9283 -> ParserT Text ParserState m (F MetaValue)
93−yamlToMetaValue pBlocks (YAML.Scalar _ x) =
84+yamlToMetaValue pMetaValue (YAML.Scalar _ x) =
9485 case x of
95− YAML.SStr t -> toMetaValue pBlocks t
86+ YAML.SStr t -> normalizeMetaValue pMetaValue t
9687 YAML.SBool b -> return $ return $ MetaBool b
9788 YAML.SFloat d -> return $ return $ MetaString $ tshow d
9889 YAML.SInt i -> return $ return $ MetaString $ tshow i
9990 YAML.SUnknown _ t ->
10091 case checkBoolean t of
10192 Just b -> return $ return $ MetaBool b
102− Nothing -> toMetaValue pBlocks t
93+ Nothing -> normalizeMetaValue pMetaValue t
10394 YAML.SNull -> return $ return $ MetaString ""
10495
105−yamlToMetaValue pBlocks (YAML.Sequence _ _ xs) = do
106− xs' <- mapM (yamlToMetaValue pBlocks) xs
107− return $ do
108− xs'' <- sequence xs'
109− return $ B.toMetaValue xs''
110−yamlToMetaValue pBlocks (YAML.Mapping _ _ o) =
111− fmap B.toMetaValue <$> yamlMap pBlocks o
96+yamlToMetaValue pMetaValue (YAML.Sequence _ _ xs) =
97+ fmap MetaList . sequence
98+ <$> mapM (yamlToMetaValue pMetaValue) xs
99+yamlToMetaValue pMetaValue (YAML.Mapping _ _ o) =
100+ fmap MetaMap <$> yamlMap pMetaValue o
112101yamlToMetaValue _ _ = return $ return $ MetaString ""
113102
114103yamlMap :: PandocMonad m
115− => ParserT Text ParserState m (F Blocks)
104+ => ParserT Text ParserState m (F MetaValue)
116105 -> M.Map (YAML.Node YE.Pos) (YAML.Node YE.Pos)
117106 -> ParserT Text ParserState m (F (M.Map Text MetaValue))
118−yamlMap pBlocks o = do
107+yamlMap pMetaValue o = do
119108 kvs <- forM (M.toList o) $ \(key, v) -> do
120109 k <- nodeToKey key
121110 return (k, v)
122111 let kvs' = filter (not . ignorable . fst) kvs
123− (fmap M.fromList . sequence) <$> mapM toMeta kvs'
112+ fmap M.fromList . sequence <$> mapM toMeta kvs'
124113 where
125114 ignorable t = "_" `T.isSuffixOf` t
126115 toMeta (k, v) = do
127− fv <- yamlToMetaValue pBlocks v
116+ fv <- yamlToMetaValue pMetaValue v
128117 return $ do
129118 v' <- fv
130119 return (k, v')