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