@@ -33,8 +33,7 @@ Conversion of markdown-formatted plain text to 'Pandoc' document.
3333module Text.Pandoc.Readers.Markdown ( readMarkdown ) where
3434
3535import Control.Monad
36−import Control.Monad.Except (catchError, throwError)
37−import Control.Monad.Trans (lift)
36+import Control.Monad.Except (throwError)
3837import Data.Char (isAlphaNum, isPunctuation, isSpace, toLower)
3938import qualified Data.HashMap.Strict as H
4039import Data.List (findIndex, intercalate, sortBy, transpose)
@@ -236,13 +235,6 @@ pandocTitleBlock = try $ do
236235 updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }
237236
238237
239−-- Adapted from solution at
240−-- http://stackoverflow.com/a/29448764/1901888
241−foldrWithKeyM :: Monad m => (k -> b -> a -> m a) -> a -> H.HashMap k b -> m a
242−foldrWithKeyM f acc = H.foldrWithKey f' (return acc)
243− where
244− f' k b ma = ma >>= \a -> f k b a
245−
246238yamlMetaBlock :: PandocMonad m => MarkdownParser m (F Blocks)
247239yamlMetaBlock = try $ do
248240 guardEnabled Ext_yaml_metadata_block
@@ -254,84 +246,93 @@ yamlMetaBlock = try $ do
254246 -- by including --- and ..., we allow yaml blocks with just comments:
255247 let rawYaml = unlines ("---" : (rawYamlLines ++ ["..."]))
256248 optional blanklines
257− opts <- stateOptions <$> getState
258− meta' <- case Yaml.decodeEither' $ UTF8.fromString rawYaml of
259− Right (Yaml.Object hashmap) ->
260− foldrWithKeyM
261− (\k v m -> do
262− if ignorable k
263− then return m
264− else (do v' <- lift $ yamlToMeta opts v
265− return $ B.setMeta (T.unpack k) v' m)
266− `catchError`
267− (\_ -> return m)
268− ) nullMeta hashmap
269− Right Yaml.Null -> return nullMeta
270− Right _ -> do
271− logMessage $
272− CouldNotParseYamlMetadata "not an object"
273− pos
274− return nullMeta
275− Left err' -> do
276− case err' of
277− InvalidYaml (Just YamlParseException{
278− yamlProblem = problem
279− , yamlContext = _ctxt
280− , yamlProblemMark = Yaml.YamlMark {
281− yamlLine = yline
282− , yamlColumn = ycol
283− }}) ->
284− logMessage $ CouldNotParseYamlMetadata
285− problem (setSourceLine
286− (setSourceColumn pos
287− (sourceColumn pos + ycol))
288− (sourceLine pos + 1 + yline))
289− _ -> logMessage $ CouldNotParseYamlMetadata
290− (show err') pos
291− return nullMeta
292− updateState $ \st -> st{ stateMeta' = stateMeta' st <> (return meta') }
249+ case Yaml.decodeEither' $ UTF8.fromString rawYaml of
250+ Right (Yaml.Object hashmap) -> do
251+ let alist = H.toList hashmap
252+ mapM_ (\(k, v) -> do
253+ if ignorable k
254+ then return ()
255+ else do
256+ v' <- yamlToMeta v
257+ updateState $ \st ->
258+ let smeta = stateMeta' st
259+ in st{ stateMeta' =
260+ (do v'' <- v'
261+ m <- smeta
262+ return $ B.setMeta (T.unpack k) v'' m)}
263+ ) alist
264+ Right Yaml.Null -> return ()
265+ Right _ -> do
266+ logMessage $
267+ CouldNotParseYamlMetadata "not an object"
268+ pos
269+ return ()
270+ Left err' -> do
271+ case err' of
272+ InvalidYaml (Just YamlParseException{
273+ yamlProblem = problem
274+ , yamlContext = _ctxt
275+ , yamlProblemMark = Yaml.YamlMark {
276+ yamlLine = yline
277+ , yamlColumn = ycol
278+ }}) ->
279+ logMessage $ CouldNotParseYamlMetadata
280+ problem (setSourceLine
281+ (setSourceColumn pos
282+ (sourceColumn pos + ycol))
283+ (sourceLine pos + 1 + yline))
284+ _ -> logMessage $ CouldNotParseYamlMetadata
285+ (show err') pos
286+ return ()
293287 return mempty
294288
295289-- ignore fields ending with _
296290ignorable :: Text -> Bool
297291ignorable t = (T.pack "_") `T.isSuffixOf` t
298292
299−toMetaValue :: PandocMonad m => ReaderOptions -> Text -> m MetaValue
300−toMetaValue opts x = toMeta <$> readMarkdown opts' (T.unpack x)
293+toMetaValue :: PandocMonad m
294+ => Text -> MarkdownParser m (F MetaValue)
295+toMetaValue x = toMeta <$> parseFromString parseBlocks (T.unpack x)
301296 where
302− toMeta p =
303− case p of
304− Pandoc _ [Plain xs] -> MetaInlines xs
305− Pandoc _ [Para xs]
306− | endsWithNewline x -> MetaBlocks [Para xs]
307− | otherwise -> MetaInlines xs
308− Pandoc _ bs -> MetaBlocks bs
297+ toMeta p = do
298+ p' <- p
299+ return $
300+ case B.toList p' of
301+ [Plain xs] -> MetaInlines xs
302+ [Para xs]
303+ | endsWithNewline x -> MetaBlocks [Para xs]
304+ | otherwise -> MetaInlines xs
305+ bs -> MetaBlocks bs
309306 endsWithNewline t = T.pack "\n" `T.isSuffixOf` t
310− opts' = opts{readerExtensions =
311− disableExtension Ext_pandoc_title_block $
312− disableExtension Ext_mmd_title_block $
313− disableExtension Ext_yaml_metadata_block $
314− readerExtensions opts }
315−
316−yamlToMeta :: PandocMonad m => ReaderOptions -> Yaml.Value -> m MetaValue
317−yamlToMeta opts (Yaml.String t) = toMetaValue opts t
318−yamlToMeta _ (Yaml.Number n)
307+
308+yamlToMeta :: PandocMonad m
309+ => Yaml.Value -> MarkdownParser m (F MetaValue)
310+yamlToMeta (Yaml.String t) = toMetaValue t
311+yamlToMeta (Yaml.Number n)
319312 -- avoid decimal points for numbers that don't need them:
320− | base10Exponent n >= 0 = return $ MetaString $ show
313+ | base10Exponent n >= 0 = return $ return $ MetaString $ show
321314 $ coefficient n * (10 ^ base10Exponent n)
322− | otherwise = return $ MetaString $ show n
323−yamlToMeta _ (Yaml.Bool b) = return $ MetaBool b
324−yamlToMeta opts (Yaml.Array xs) = B.toMetaValue <$> mapM (yamlToMeta opts)
325− (V.toList xs)
326−yamlToMeta opts (Yaml.Object o) = MetaMap <$> H.foldrWithKey (\k v m ->
327− if ignorable k
328− then m
329− else (do
330− v' <- yamlToMeta opts v
331− m' <- m
332− return (M.insert (T.unpack k) v' m')))
333− (return M.empty) o
334−yamlToMeta _ _ = return $ MetaString ""
315+ | otherwise = return $ return $ MetaString $ show n
316+yamlToMeta (Yaml.Bool b) = return $ return $ MetaBool b
317+yamlToMeta (Yaml.Array xs) = do
318+ xs' <- mapM yamlToMeta (V.toList xs)
319+ return $ do
320+ xs'' <- sequence xs'
321+ return $ B.toMetaValue xs''
322+yamlToMeta (Yaml.Object o) = do
323+ let alist = H.toList o
324+ foldM (\m (k,v) -> do
325+ if ignorable k
326+ then return m
327+ else do
328+ v' <- yamlToMeta v
329+ return $ do
330+ MetaMap m' <- m
331+ v'' <- v'
332+ return (MetaMap $ M.insert (T.unpack k) v'' m'))
333+ (return $ MetaMap M.empty)
334+ alist
335+yamlToMeta _ = return $ return $ MetaString ""
335336
336337stopLine :: PandocMonad m => MarkdownParser m ()
337338stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()
@@ -361,14 +362,12 @@ parseMarkdown = do
361362 optional titleBlock
362363 blocks <- parseBlocks
363364 st <- getState
364− let meta = runF (stateMeta' st) st
365− let Pandoc _ bs = B.doc $ runF blocks st
366− eastAsianLineBreaks <- option False $
367− True <$ guardEnabled Ext_east_asian_line_breaks
365+ let doc = runF (do Pandoc _ bs <- B.doc <$> blocks
366+ meta <- stateMeta' st
367+ return $ Pandoc meta bs) st
368368 reportLogMessages
369− return $ (if eastAsianLineBreaks
370− then bottomUp softBreakFilter
371− else id) $ Pandoc meta bs
369+ (do guardEnabled Ext_east_asian_line_breaks
370+ return $ bottomUp softBreakFilter doc) <|> return doc
372371
373372softBreakFilter :: [Inline] -> [Inline]
374373softBreakFilter (x:SoftBreak:y:zs) =