@@ -1,4 +1,3 @@
1−{-# LANGUAGE ScopedTypeVariables #-}
21{-# LANGUAGE OverloadedStrings #-}
32{- |
43 Module : Text.Pandoc.Readers.Metadata
@@ -21,7 +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
2523import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
2624import Text.Pandoc.Definition
2725import Text.Pandoc.Error
@@ -33,11 +31,11 @@ yamlBsToMeta :: PandocMonad m
3331 => ParserT Text ParserState m (F MetaValue)
3432 -> BL.ByteString
3533 -> ParserT Text ParserState m (F Meta)
36−yamlBsToMeta pBlocks bstr = do
34+yamlBsToMeta pMetaValue bstr = do
3735 pos <- getPosition
3836 case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of
3937 Right (YAML.Doc (YAML.Mapping _ _ o):_)
40− -> fmap Meta <$> yamlMap pBlocks o
38+ -> fmap Meta <$> yamlMap pMetaValue o
4139 Right [] -> return . return $ mempty
4240 Right [YAML.Doc (YAML.Scalar _ YAML.SNull)]
4341 -> return . return $ mempty
@@ -57,30 +55,21 @@ nodeToKey (YAML.Scalar _ (YAML.SUnknown _ t)) = return t
5755nodeToKey _ = throwError $ PandocParseError
5856 "Non-string key in YAML mapping"
5957
60−toMetaValue :: PandocMonad m
61− => ParserT Text ParserState m (F MetaValue)
62− -> Text
63− -> ParserT Text ParserState m (F MetaValue)
64−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 =
6563 -- Note: a standard quoted or unquoted YAML value will
6664 -- not end in a newline, but a "block" set off with
6765 -- `|` or `>` will.
6866 if "\n" `T.isSuffixOf` x
69− then parseFromString' pBlocks (x <> "\n")
70− else parseFromString' pInlines x
71− where pInlines = do
72− bs <- pBlocks
73− return $ do
74− bs' <- bs
75− return $
76− case bs' of
77− MetaBlocks bs'' ->
78− case bs'' of
79− [Plain ils] -> MetaInlines ils
80− [Para ils] -> MetaInlines ils
81− xs -> MetaBlocks xs
82− _ -> bs'
83−
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
8473
8574checkBoolean :: Text -> Maybe Bool
8675checkBoolean t
@@ -92,32 +81,30 @@ yamlToMetaValue :: PandocMonad m
9281 => ParserT Text ParserState m (F MetaValue)
9382 -> YAML.Node YE.Pos
9483 -> ParserT Text ParserState m (F MetaValue)
95−yamlToMetaValue pBlocks (YAML.Scalar _ x) =
84+yamlToMetaValue pMetaValue (YAML.Scalar _ x) =
9685 case x of
97− YAML.SStr t -> toMetaValue pBlocks t
86+ YAML.SStr t -> normalizeMetaValue pMetaValue t
9887 YAML.SBool b -> return $ return $ MetaBool b
9988 YAML.SFloat d -> return $ return $ MetaString $ tshow d
10089 YAML.SInt i -> return $ return $ MetaString $ tshow i
10190 YAML.SUnknown _ t ->
10291 case checkBoolean t of
10392 Just b -> return $ return $ MetaBool b
104− Nothing -> toMetaValue pBlocks t
93+ Nothing -> normalizeMetaValue pMetaValue t
10594 YAML.SNull -> return $ return $ MetaString ""
10695
107−yamlToMetaValue pBlocks (YAML.Sequence _ _ xs) = do
108− xs' <- mapM (yamlToMetaValue pBlocks) xs
109− return $ do
110− xs'' <- sequence xs'
111− return $ B.toMetaValue xs''
112−yamlToMetaValue pBlocks (YAML.Mapping _ _ o) =
113− 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
114101yamlToMetaValue _ _ = return $ return $ MetaString ""
115102
116103yamlMap :: PandocMonad m
117104 => ParserT Text ParserState m (F MetaValue)
118105 -> M.Map (YAML.Node YE.Pos) (YAML.Node YE.Pos)
119106 -> ParserT Text ParserState m (F (M.Map Text MetaValue))
120−yamlMap pBlocks o = do
107+yamlMap pMetaValue o = do
121108 kvs <- forM (M.toList o) $ \(key, v) -> do
122109 k <- nodeToKey key
123110 return (k, v)
@@ -126,7 +113,7 @@ yamlMap pBlocks o = do
126113 where
127114 ignorable t = "_" `T.isSuffixOf` t
128115 toMeta (k, v) = do
129− fv <- yamlToMetaValue pBlocks v
116+ fv <- yamlToMetaValue pMetaValue v
130117 return $ do
131118 v' <- fv
132119 return (k, v')