@@ -241,51 +241,33 @@ yamlMetaBlock = try $ do
241241 -- by including --- and ..., we allow yaml blocks with just comments:
242242 let rawYaml = unlines ("---" : (rawYamlLines ++ ["..."]))
243243 optional blanklines
244− yamlBsToMeta $ UTF8.fromStringLazy rawYaml
244+ newMetaF <- yamlBsToMeta $ UTF8.fromStringLazy rawYaml
245+ -- Since `<>` is left-biased, existing values are not touched:
246+ updateState $ \st -> st{ stateMeta' = (stateMeta' st) <> newMetaF }
245247 return mempty
246248
247−yamlBsToMeta :: PandocMonad m => BS.ByteString -> MarkdownParser m ()
249+yamlBsToMeta :: PandocMonad m => BS.ByteString -> MarkdownParser m (F Meta)
248250yamlBsToMeta bstr = do
249251 pos <- getPosition
250252 case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of
251− Right [YAML.Doc (YAML.Mapping _ hashmap)] ->
252− mapM_ (\(key, v) -> do
253− k <- nodeToKey key
254− if ignorable k
255− then return ()
256− else do
257− v' <- yamlToMetaValue v
258− let k' = T.unpack k
259− updateState $ \st -> st{ stateMeta' =
260− do m <- stateMeta' st
261− -- if there's already a value, leave it unchanged
262− case lookupMeta k' m of
263− Just _ -> return m
264− Nothing -> do
265− v'' <- v'
266− return $ B.setMeta (T.unpack k) v'' m})
267− (M.toList hashmap)
268− Right [] -> return ()
269− Right [YAML.Doc (YAML.Scalar YAML.SNull)] -> return ()
253+ Right [YAML.Doc (YAML.Mapping _ o)] -> (fmap Meta) <$> yamlMap o
254+ Right [] -> return . return $ mempty
255+ Right [YAML.Doc (YAML.Scalar YAML.SNull)] -> return . return $ mempty
270256 Right _ -> do
271257 logMessage $
272258 CouldNotParseYamlMetadata "not an object"
273259 pos
274− return ()
260+ return . return $ mempty
275261 Left err' -> do
276262 logMessage $ CouldNotParseYamlMetadata
277263 err' pos
278− return ()
264+ return . return $ mempty
279265
280266nodeToKey :: Monad m => YAML.Node -> m Text
281267nodeToKey (YAML.Scalar (YAML.SStr t)) = return t
282268nodeToKey (YAML.Scalar (YAML.SUnknown _ t)) = return t
283269nodeToKey _ = fail "Non-string key in YAML mapping"
284270
285−-- ignore fields ending with _
286−ignorable :: Text -> Bool
287−ignorable t = (T.pack "_") `T.isSuffixOf` t
288−
289271toMetaValue :: PandocMonad m
290272 => Text -> MarkdownParser m (F MetaValue)
291273toMetaValue x =
@@ -331,21 +313,26 @@ yamlToMetaValue (YAML.Sequence _ xs) = do
331313 return $ do
332314 xs'' <- sequence xs'
333315 return $ B.toMetaValue xs''
334−yamlToMetaValue (YAML.Mapping _ o) =
335− foldM (\m (key, v) -> do
336− k <- nodeToKey key
337− if ignorable k
338− then return m
339− else do
340− v' <- yamlToMetaValue v
341− return $ do
342− MetaMap m' <- m
343− v'' <- v'
344− return (MetaMap $ M.insert (T.unpack k) v'' m'))
345− (return $ MetaMap M.empty)
346− (M.toList o)
316+yamlToMetaValue (YAML.Mapping _ o) = fmap B.toMetaValue <$> yamlMap o
347317yamlToMetaValue _ = return $ return $ MetaString ""
348318
319+yamlMap :: PandocMonad m
320+ => M.Map YAML.Node YAML.Node
321+ -> MarkdownParser m (F (M.Map String MetaValue))
322+yamlMap o = do
323+ kvs <- forM (M.toList o) $ \(key, v) -> do
324+ k <- nodeToKey key
325+ return (k, v)
326+ let kvs' = filter (not . ignorable . fst) kvs
327+ (fmap M.fromList . sequence) <$> mapM toMeta kvs'
328+ where
329+ ignorable t = (T.pack "_") `T.isSuffixOf` t
330+ toMeta (k, v) = do
331+ fv <- yamlToMetaValue v
332+ return $ do
333+ v' <- fv
334+ return (T.unpack k, v')
335+
349336stopLine :: PandocMonad m => MarkdownParser m ()
350337stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()
351338