@@ -20,6 +20,7 @@ import Control.Monad
2020import Control.Monad.Except (throwError)
2121import qualified Data.ByteString.Lazy as BL
2222import qualified Data.Map as M
23+import Data.Maybe
2324import Data.Text (Text)
2425import qualified Data.Text as T
2526import qualified Data.YAML as YAML
@@ -51,28 +52,49 @@ yamlBsToMeta pMetaValue bstr = do
5152 (T.pack err') pos
5253 return . return $ mempty
5354
55+
56+fakePos :: YAML.Pos
57+fakePos = YAML.Pos (-1) (-1) 1 0
58+
59+lookupYAML :: Text
60+ -> YAML.Node YE.Pos
61+ -> Maybe (YAML.Node YE.Pos)
62+lookupYAML t (YAML.Mapping _ _ m) =
63+ M.lookup (YAML.Scalar fakePos (YAML.SUnknown YE.untagged t)) m
64+ `mplus`
65+ M.lookup (YAML.Scalar fakePos (YAML.SStr t)) m
66+lookupYAML _ _ = Nothing
67+
5468-- Returns filtered list of references.
5569yamlBsToRefs :: PandocMonad m
5670 => ParserT Text ParserState m (F MetaValue)
5771 -> (Text -> Bool) -- ^ Filter for id
5872 -> BL.ByteString
59− -> ParserT Text ParserState m (F [M.Map Text MetaValue])
73+ -> ParserT Text ParserState m (F [MetaValue])
6074yamlBsToRefs pMetaValue idpred bstr = do
6175 pos <- getPosition
6276 case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of
63− Right (YAML.Doc (YAML.Mapping _ _ o):_)
64− -> case YAML.parseEither (o YAML..: "references") of
65− Right ns -> do
66− let g n = case YAML.parseEither (n YAML..: "id") of
67− Right t -> idpred t ||
68− case YAML.parseEither (n YAML..:
69− "other-ids") of
70− Right (oids :: [Text]) ->
71− any idpred oids
77+ Right (YAML.Doc o@(YAML.Mapping _ _ _):_)
78+ -> case lookupYAML "references" o of
79+ Just (YAML.Sequence _ _ ns) -> do
80+ let g n = case lookupYAML "id" n of
81+ Just n' ->
82+ case nodeToKey n' of
83+ Nothing -> False
84+ Just t -> idpred t ||
85+ case lookupYAML "other-ids" n of
86+ Just (YAML.Sequence _ _ ns') ->
87+ let ts' = mapMaybe nodeToKey ns'
88+ in any idpred ts'
7289 _ -> False
73− _ -> False
74− sequence <$> mapM (yamlMap pMetaValue) (filter g ns)
75− Left _ -> do
90+ Nothing -> False
91+ sequence <$>
92+ mapM (yamlToMetaValue pMetaValue) (filter g ns)
93+ Just _ -> do
94+ logMessage $ CouldNotParseYamlMetadata
95+ ("expecting sequence in 'references' field") pos
96+ return . return $ mempty
97+ Nothing -> do
7698 logMessage $ CouldNotParseYamlMetadata
7799 ("expecting 'references' field") pos
78100 return . return $ mempty
@@ -90,13 +112,10 @@ yamlBsToRefs pMetaValue idpred bstr = do
90112
91113
92114
93−nodeToKey :: PandocMonad m
94− => YAML.Node YE.Pos
95− -> m Text
96−nodeToKey (YAML.Scalar _ (YAML.SStr t)) = return t
97−nodeToKey (YAML.Scalar _ (YAML.SUnknown _ t)) = return t
98−nodeToKey _ = throwError $ PandocParseError
99− "Non-string key in YAML mapping"
115+nodeToKey :: YAML.Node YE.Pos -> Maybe Text
116+nodeToKey (YAML.Scalar _ (YAML.SStr t)) = Just t
117+nodeToKey (YAML.Scalar _ (YAML.SUnknown _ t)) = Just t
118+nodeToKey _ = Nothing
100119
101120normalizeMetaValue :: PandocMonad m
102121 => ParserT Text ParserState m (F MetaValue)
@@ -149,7 +168,9 @@ yamlMap :: PandocMonad m
149168 -> ParserT Text ParserState m (F (M.Map Text MetaValue))
150169yamlMap pMetaValue o = do
151170 kvs <- forM (M.toList o) $ \(key, v) -> do
152− k <- nodeToKey key
171+ k <- maybe (throwError $ PandocParseError
172+ "Non-string key in YAML mapping")
173+ return $ nodeToKey key
153174 return (k, v)
154175 let kvs' = filter (not . ignorable . fst) kvs
155176 fmap M.fromList . sequence <$> mapM toMeta kvs'