@@ -203,13 +203,10 @@ dateLine = try $ do
203203 skipSpaces
204204 trimInlinesF . mconcat <$> manyTill inline newline
205205
206−titleBlock :: MarkdownParser (F (Pandoc -> Pandoc))
207−titleBlock = pandocTitleBlock
208− <|> yamlTitleBlock
209− <|> mmdTitleBlock
210− <|> return (return id)
206+titleBlock :: MarkdownParser ()
207+titleBlock = pandocTitleBlock <|> mmdTitleBlock
211208
212−pandocTitleBlock :: MarkdownParser (F (Pandoc -> Pandoc))
209+pandocTitleBlock :: MarkdownParser ()
213210pandocTitleBlock = try $ do
214211 guardEnabled Ext_pandoc_title_block
215212 lookAhead (char '%')
@@ -217,16 +214,18 @@ pandocTitleBlock = try $ do
217214 author <- option (return []) authorsLine
218215 date <- option mempty dateLine
219216 optional blanklines
220− return $ do
221− title' <- title
222− author' <- author
223− date' <- date
224− return $ if B.isNull title' then id else B.setMeta "title" title'
225− . if null author' then id else B.setMeta "author" author'
226− . if B.isNull date' then id else B.setMeta "date" date'
227−
228−yamlTitleBlock :: MarkdownParser (F (Pandoc -> Pandoc))
229−yamlTitleBlock = try $ do
217+ let meta' = do title' <- title
218+ author' <- author
219+ date' <- date
220+ return $
221+ ( if B.isNull title' then id else B.setMeta "title" title'
222+ . if null author' then id else B.setMeta "author" author'
223+ . if B.isNull date' then id else B.setMeta "date" date' )
224+ nullMeta
225+ updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }
226+
227+yamlMetaBlock :: MarkdownParser (F Blocks)
228+yamlMetaBlock = try $ do
230229 guardEnabled Ext_yaml_metadata_block
231230 pos <- getPosition
232231 string "---"
@@ -236,33 +235,39 @@ yamlTitleBlock = try $ do
236235 let rawYaml = unlines ("---" : (rawYamlLines ++ ["..."]))
237236 optional blanklines
238237 opts <- stateOptions <$> getState
239− case Yaml.decodeEither' $ UTF8.fromString rawYaml of
240− Right (Yaml.Object hashmap) -> return $ return $
241− H.foldrWithKey (\k v f ->
242− if ignorable k
243− then f
244− else B.setMeta (T.unpack k) (yamlToMeta opts v) . f)
245− id hashmap
246− Right Yaml.Null -> return $ return id
247− Right _ -> do
248− addWarning (Just pos) "YAML header is not an object"
249− return $ return id
250− Left err' -> do
251− case err' of
252− InvalidYaml (Just YamlParseException{
253− yamlProblem = problem
254− , yamlContext = _ctxt
255− , yamlProblemMark = Yaml.YamlMark {
256− yamlLine = yline
257− , yamlColumn = ycol
258− }}) ->
259− addWarning (Just $ setSourceLine
260− (setSourceColumn pos (sourceColumn pos + ycol))
261− (sourceLine pos + 1 + yline))
262− $ "Could not parse YAML header: " ++ problem
263− _ -> addWarning (Just pos)
264− $ "Could not parse YAML header: " ++ show err'
265− return $ return id
238+ meta' <- case Yaml.decodeEither' $ UTF8.fromString rawYaml of
239+ Right (Yaml.Object hashmap) -> return $ return $
240+ H.foldrWithKey (\k v m ->
241+ if ignorable k
242+ then m
243+ else B.setMeta (T.unpack k)
244+ (yamlToMeta opts v) m)
245+ nullMeta hashmap
246+ Right Yaml.Null -> return $ return nullMeta
247+ Right _ -> do
248+ addWarning (Just pos) "YAML header is not an object"
249+ return $ return nullMeta
250+ Left err' -> do
251+ case err' of
252+ InvalidYaml (Just YamlParseException{
253+ yamlProblem = problem
254+ , yamlContext = _ctxt
255+ , yamlProblemMark = Yaml.YamlMark {
256+ yamlLine = yline
257+ , yamlColumn = ycol
258+ }}) ->
259+ addWarning (Just $ setSourceLine
260+ (setSourceColumn pos
261+ (sourceColumn pos + ycol))
262+ (sourceLine pos + 1 + yline))
263+ $ "Could not parse YAML header: " ++
264+ problem
265+ _ -> addWarning (Just pos)
266+ $ "Could not parse YAML header: " ++
267+ show err'
268+ return $ return nullMeta
269+ updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }
270+ return mempty
266271
267272-- ignore fields ending with _
268273ignorable :: Text -> Bool
@@ -295,13 +300,13 @@ yamlToMeta _ _ = MetaString ""
295300stopLine :: MarkdownParser ()
296301stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()
297302
298−mmdTitleBlock :: MarkdownParser (F (Pandoc -> Pandoc))
303+mmdTitleBlock :: MarkdownParser ()
299304mmdTitleBlock = try $ do
300305 guardEnabled Ext_mmd_title_block
301306 kvPairs <- many1 kvPair
302307 blanklines
303− return $ return $ \(Pandoc m bs) ->
304− Pandoc (foldl (\m' (k,v) -> addMetaField k v m') m kvPairs) bs
308+ updateState $ \st -> st{ stateMeta' = stateMeta' st <>
309+ return (Meta $ M.fromList kvPairs) }
305310
306311kvPair :: MarkdownParser (String, MetaValue)
307312kvPair = try $ do
@@ -318,15 +323,14 @@ parseMarkdown = do
318323 updateState $ \state -> state { stateOptions =
319324 let oldOpts = stateOptions state in
320325 oldOpts{ readerParseRaw = True } }
321− titleTrans <- option (return id) titleBlock
326+ optional titleBlock
322327 blocks <- parseBlocks
323328 st <- getState
329+ let meta = runF (stateMeta' st) st
330+ let Pandoc _ bs = B.doc $ runF blocks st
324331 mbsty <- getOption readerCitationStyle
325332 refs <- getOption readerReferences
326− return $ processBiblio mbsty refs
327− $ runF titleTrans st
328− $ B.doc
329− $ runF blocks st
333+ return $ processBiblio mbsty refs $ Pandoc meta bs
330334
331335addWarning :: Maybe SourcePos -> String -> MarkdownParser ()
332336addWarning mbpos msg =
@@ -442,6 +446,7 @@ parseBlocks = mconcat <$> manyTill block eof
442446block :: MarkdownParser (F Blocks)
443447block = choice [ mempty <$ blanklines
444448 , codeBlockFenced
449+ , yamlMetaBlock
445450 , guardEnabled Ext_latex_macros *> (macro >>= return . return)
446451 , header
447452 , lhsCodeBlock