blob: b802c752b91655e97c380f0d86d9c1eea09336b4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module : Text.Pandoc.Readers.Metadata
Copyright : Copyright (C) 2006-2020 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : portable
Parse YAML/JSON metadata to 'Pandoc' 'Meta'.
-}
module Text.Pandoc.Readers.Metadata (
yamlBsToMeta,
yamlBsToRefs,
yamlMap ) where
import Control.Monad
import Control.Monad.Except (throwError)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.YAML as YAML
import qualified Data.YAML.Event as YE
import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.Parsing hiding (tableWith)
import Text.Pandoc.Shared
yamlBsToMeta :: PandocMonad m
=> ParserT Text ParserState m (F MetaValue)
-> BL.ByteString
-> ParserT Text ParserState m (F Meta)
yamlBsToMeta pMetaValue bstr = do
pos <- getPosition
case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of
Right (YAML.Doc (YAML.Mapping _ _ o):_)
-> fmap Meta <$> yamlMap pMetaValue o
Right [] -> return . return $ mempty
Right [YAML.Doc (YAML.Scalar _ YAML.SNull)]
-> return . return $ mempty
Right _ -> do logMessage $ CouldNotParseYamlMetadata "not an object"
pos
return . return $ mempty
Left (_pos, err')
-> do logMessage $ CouldNotParseYamlMetadata
(T.pack err') pos
return . return $ mempty
-- Returns filtered list of references.
yamlBsToRefs :: PandocMonad m
=> ParserT Text ParserState m (F MetaValue)
-> (Text -> Bool) -- ^ Filter for id
-> BL.ByteString
-> ParserT Text ParserState m (F [M.Map Text MetaValue])
yamlBsToRefs pMetaValue idpred bstr = do
pos <- getPosition
case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of
Right (YAML.Doc (YAML.Mapping _ _ o):_)
-> case YAML.parseEither (o YAML..: "references") of
Right ns -> do
let g n = case YAML.parseEither (n YAML..: "id") of
Right t -> idpred t ||
case YAML.parseEither (n YAML..:
"other-ids") of
Right (oids :: [Text]) ->
any idpred oids
_ -> False
_ -> False
sequence <$> mapM (yamlMap pMetaValue) (filter g ns)
Left _ -> do
logMessage $ CouldNotParseYamlMetadata
("expecting 'references' field") pos
return . return $ mempty
Right [] -> return . return $ mempty
Right [YAML.Doc (YAML.Scalar _ YAML.SNull)]
-> return . return $ mempty
Right _ -> do logMessage $ CouldNotParseYamlMetadata "not an object"
pos
return . return $ mempty
Left (_pos, err')
-> do logMessage $ CouldNotParseYamlMetadata
(T.pack err') pos
return . return $ mempty
nodeToKey :: PandocMonad m
=> YAML.Node YE.Pos
-> m Text
nodeToKey (YAML.Scalar _ (YAML.SStr t)) = return t
nodeToKey (YAML.Scalar _ (YAML.SUnknown _ t)) = return t
nodeToKey _ = throwError $ PandocParseError
"Non-string key in YAML mapping"
normalizeMetaValue :: PandocMonad m
=> ParserT Text ParserState m (F MetaValue)
-> Text
-> ParserT Text ParserState m (F MetaValue)
normalizeMetaValue pMetaValue x =
-- Note: a standard quoted or unquoted YAML value will
-- not end in a newline, but a "block" set off with
-- `|` or `>` will.
if "\n" `T.isSuffixOf` x
then parseFromString' pMetaValue (x <> "\n")
else parseFromString' asInlines x
where asInlines = fmap b2i <$> pMetaValue
b2i (MetaBlocks [Plain ils]) = MetaInlines ils
b2i (MetaBlocks [Para ils]) = MetaInlines ils
b2i bs = bs
checkBoolean :: Text -> Maybe Bool
checkBoolean t
| t == T.pack "true" || t == T.pack "True" || t == T.pack "TRUE" = Just True
| t == T.pack "false" || t == T.pack "False" || t == T.pack "FALSE" = Just False
| otherwise = Nothing
yamlToMetaValue :: PandocMonad m
=> ParserT Text ParserState m (F MetaValue)
-> YAML.Node YE.Pos
-> ParserT Text ParserState m (F MetaValue)
yamlToMetaValue pMetaValue (YAML.Scalar _ x) =
case x of
YAML.SStr t -> normalizeMetaValue pMetaValue t
YAML.SBool b -> return $ return $ MetaBool b
YAML.SFloat d -> return $ return $ MetaString $ tshow d
YAML.SInt i -> return $ return $ MetaString $ tshow i
YAML.SUnknown _ t ->
case checkBoolean t of
Just b -> return $ return $ MetaBool b
Nothing -> normalizeMetaValue pMetaValue t
YAML.SNull -> return $ return $ MetaString ""
yamlToMetaValue pMetaValue (YAML.Sequence _ _ xs) =
fmap MetaList . sequence
<$> mapM (yamlToMetaValue pMetaValue) xs
yamlToMetaValue pMetaValue (YAML.Mapping _ _ o) =
fmap MetaMap <$> yamlMap pMetaValue o
yamlToMetaValue _ _ = return $ return $ MetaString ""
yamlMap :: PandocMonad m
=> 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 pMetaValue o = do
kvs <- forM (M.toList o) $ \(key, v) -> do
k <- nodeToKey key
return (k, v)
let kvs' = filter (not . ignorable . fst) kvs
fmap M.fromList . sequence <$> mapM toMeta kvs'
where
ignorable t = "_" `T.isSuffixOf` t
toMeta (k, v) = do
fv <- yamlToMetaValue pMetaValue v
return $ do
v' <- fv
return (k, v')
|
