@@ -31,7 +31,7 @@ Conversion of markdown-formatted plain text to 'Pandoc' document.
3131module Text.Pandoc.Readers.Markdown ( readMarkdown,
3232 readMarkdownWithWarnings ) where
3333
34−import Data.List ( transpose, sortBy, findIndex, intersperse, intercalate )
34+import Data.List ( transpose, sortBy, intersperse, intercalate, elemIndex)
3535import qualified Data.Map as M
3636import Data.Scientific (coefficient, base10Exponent)
3737import Data.Ord ( comparing )
@@ -72,7 +72,7 @@ readMarkdown :: ReaderOptions -- ^ Reader options
7272 -> String -- ^ String to parse (assuming @'\n'@ line endings)
7373 -> Pandoc
7474readMarkdown opts s =
75− (runMarkdown opts s parseMarkdown)
75+ runMarkdown opts s parseMarkdown
7676
7777-- | Read markdown from an input string and return a pair of a Pandoc document
7878-- and a list of warnings.
@@ -132,7 +132,7 @@ inList = do
132132 guard (ctx == ListItemState)
133133
134134isNull :: Inlines -> Bool
135−isNull ils = B.isNull ils
135+isNull = B.isNull
136136
137137spnl :: Monad m => ParserT [Char] st m ()
138138spnl = try $ do
@@ -236,7 +236,7 @@ pandocTitleBlock = try $ do
236236 $ nullMeta
237237 updateState $ \st -> st{ stateMeta = stateMeta st <> meta' }
238238
239−yamlMetaBlock :: MarkdownParser (Blocks)
239+yamlMetaBlock :: MarkdownParser Blocks
240240yamlMetaBlock = try $ do
241241 guardEnabled Ext_yaml_metadata_block
242242 pos <- getPosition
@@ -284,7 +284,7 @@ yamlMetaBlock = try $ do
284284
285285-- ignore fields ending with _
286286ignorable :: Text -> Bool
287−ignorable t = (T.pack "_") `T.isSuffixOf` t
287+ignorable t = T.pack "_" `T.isSuffixOf` t
288288
289289toMetaValue :: ReaderOptions -> Text -> MetaValue
290290toMetaValue opts x =
@@ -294,7 +294,7 @@ toMetaValue opts x =
294294 | endsWithNewline x -> MetaBlocks [Para xs]
295295 | otherwise -> MetaInlines xs
296296 Pandoc _ bs -> MetaBlocks bs
297− where endsWithNewline t = (T.pack "\n") `T.isSuffixOf` t
297+ where endsWithNewline t = T.pack "\n" `T.isSuffixOf` t
298298
299299yamlToMeta :: ReaderOptions -> Yaml.Value -> MetaValue
300300yamlToMeta opts (Yaml.String t) = toMetaValue opts t
@@ -347,7 +347,7 @@ parseMarkdown = do
347347 let Pandoc _ bs = B.doc blocks
348348 return $ Pandoc meta bs
349349
350−referenceKey :: MarkdownParser (Blocks)
350+referenceKey :: MarkdownParser Blocks
351351referenceKey = try $ do
352352 pos <- getPosition
353353 skipNonindentSpaces
@@ -394,7 +394,7 @@ quotedTitle c = try $ do
394394-- | PHP Markdown Extra style abbreviation key. Currently
395395-- we just skip them, since Pandoc doesn't have an element for
396396-- an abbreviation.
397−abbrevKey :: MarkdownParser (Blocks)
397+abbrevKey :: MarkdownParser Blocks
398398abbrevKey = do
399399 guardEnabled Ext_abbreviations
400400 try $ do
@@ -421,7 +421,7 @@ rawLines = do
421421 rest <- many rawLine
422422 return $ unlines (first:rest)
423423
424−noteBlock :: MarkdownParser (Blocks)
424+noteBlock :: MarkdownParser Blocks
425425noteBlock = try $ do
426426 pos <- getPosition
427427 skipNonindentSpaces
@@ -454,10 +454,10 @@ inFootnote p = do
454454-- parsing blocks
455455--
456456
457−parseBlocks :: MarkdownParser (Blocks)
457+parseBlocks :: MarkdownParser Blocks
458458parseBlocks = mconcat <$> manyTill block eof
459459
460−block :: MarkdownParser (Blocks)
460+block :: MarkdownParser Blocks
461461block = do
462462 tr <- getOption readerTrace
463463 pos <- getPosition
@@ -486,21 +486,21 @@ block = do
486486 , para
487487 , plain
488488 ] <?> "block"
489− when tr $ do
489+ when tr $
490490 trace (printf "line %d: %s" (sourceLine pos)
491− (take 60 $ show $ B.toList $ res)) (return ())
491+ (take 60 . show . B.toList $ res)) (return ())
492492 return res
493493
494494--
495495-- header blocks
496496--
497497
498−header :: MarkdownParser (Blocks)
498+header :: MarkdownParser Blocks
499499header = setextHeader <|> atxHeader <?> "header"
500500
501501atxHeader :: MarkdownParser Blocks
502502atxHeader = try $ do
503− level <- many1 (char '#') >>= return . length
503+ level <- length <$> many1 (char '#')
504504 notFollowedBy $ guardEnabled Ext_fancy_lists >>
505505 (char '.' <|> char ')') -- this would be a list
506506 skipSpaces
@@ -544,7 +544,7 @@ setextHeader = try $ do
544544 underlineChar <- oneOf setextHChars
545545 many (char underlineChar)
546546 blanklines
547− let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1
547+ let level = (fromMaybe 0 $ elemIndex underlineChar setextHChars) + 1
548548 attr' <- registerHeader attr text
549549 return $ B.headerWith attr' level text
550550
@@ -567,7 +567,7 @@ hrule = try $ do
567567--
568568
569569indentedLine :: MarkdownParser String
570−indentedLine = indentSpaces >> anyLine >>= return . (++ "\n")
570+indentedLine = indentSpaces >> ((++ "\n") <$> anyLine)
571571
572572blockDelimiter :: Monad m
573573 => (Char -> Bool)
@@ -577,8 +577,7 @@ blockDelimiter f len = try $ do
577577 c <- lookAhead (satisfy f)
578578 case len of
579579 Just l -> count l (char c) >> many (char c) >> return l
580− Nothing -> count 3 (char c) >> many (char c) >>=
581− return . (+ 3) . length
580+ Nothing -> count 3 (char c) >> ((+ 3) . length <$> many (char c))
582581
583582attributes :: MarkdownParser Attr
584583attributes = try $ do
@@ -644,7 +643,7 @@ toLanguageId = map toLower . go
644643 go "objective-c" = "objectivec"
645644 go x = x
646645
647−codeBlockIndented :: MarkdownParser (Blocks)
646+codeBlockIndented :: MarkdownParser Blocks
648647codeBlockIndented = do
649648 contents <- many1 (indentedLine <|>
650649 try (do b <- blanklines
@@ -655,7 +654,7 @@ codeBlockIndented = do
655654 return $ B.codeBlockWith ("", classes, []) $
656655 stripTrailingNewlines $ concat contents
657656
658−lhsCodeBlock :: MarkdownParser (Blocks)
657+lhsCodeBlock :: MarkdownParser Blocks
659658lhsCodeBlock = do
660659 guardEnabled Ext_literate_haskell
661660 (B.codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
@@ -717,11 +716,11 @@ emailBlockQuote = try $ do
717716 optional blanklines
718717 return raw
719718
720−blockQuote :: MarkdownParser (Blocks)
719+blockQuote :: MarkdownParser Blocks
721720blockQuote = do
722721 raw <- emailBlockQuote
723722 -- parse the extracted block, which may contain various block elements:
724− contents <- parseFromString parseBlocks $ (intercalate "\n" raw) ++ "\n\n"
723+ contents <- parseFromString parseBlocks $ intercalate "\n" raw ++ "\n\n"
725724 return $ B.blockQuote contents
726725
727726--
@@ -765,7 +764,7 @@ anyOrderedListStart = try $ do
765764 return res
766765
767766listStart :: MarkdownParser ()
768−listStart = bulletListStart <|> (anyOrderedListStart >> return ())
767+listStart = bulletListStart <|> void anyOrderedListStart
769768
770769listLine :: MarkdownParser String
771770listLine = try $ do
@@ -820,7 +819,7 @@ listContinuationLine = try $ do
820819 return $ result ++ "\n"
821820
822821listItem :: MarkdownParser a
823− -> MarkdownParser (Blocks)
822+ -> MarkdownParser Blocks
824823listItem start = try $ do
825824 first <- rawListItem start
826825 continuations <- many listContinuation
@@ -857,7 +856,7 @@ orderedList = try $ do
857856 start' <- option 1 $ guardEnabled Ext_startnum >> return start
858857 return $ B.orderedListWith (start', style, delim) (compactify' items)
859858
860−bulletList :: MarkdownParser (Blocks)
859+bulletList :: MarkdownParser Blocks
861860bulletList = do
862861 items <- many1 $ listItem bulletListStart
863862 return $ B.bulletList (compactify' items)
@@ -882,7 +881,7 @@ definitionListItem compact = try $ do
882881 term <- parseFromString (trimInlines . mconcat <$> many inline) rawLine'
883882 contents <- mapM (parseFromString parseBlocks) raw
884883 optional blanklines
885− return $ (term, contents)
884+ return (term, contents)
886885
887886defRawBlock :: Bool -> MarkdownParser String
888887defRawBlock compact = try $ do
@@ -905,18 +904,18 @@ defRawBlock compact = try $ do
905904 return $ trimr (firstline ++ "\n" ++ unlines rawlines ++ cont) ++
906905 if hasBlank || not (null cont) then "\n\n" else ""
907906
908−definitionList :: MarkdownParser (Blocks)
907+definitionList :: MarkdownParser Blocks
909908definitionList = try $ do
910909 lookAhead (anyLine >> optional blankline >> defListMarker)
911910 compactDefinitionList <|> normalDefinitionList
912911
913−compactDefinitionList :: MarkdownParser (Blocks)
912+compactDefinitionList :: MarkdownParser Blocks
914913compactDefinitionList = do
915914 guardEnabled Ext_compact_definition_lists
916915 items <- many1 $ definitionListItem True
917916 return $ B.definitionList (compactify'DL items)
918917
919−normalDefinitionList :: MarkdownParser (Blocks)
918+normalDefinitionList :: MarkdownParser Blocks
920919normalDefinitionList = do
921920 guardEnabled Ext_definition_lists
922921 items <- many1 $ definitionListItem False
@@ -947,7 +946,7 @@ para = try $ do
947946 Just "div" -> () <$
948947 lookAhead (htmlTag (~== TagClose "div"))
949948 _ -> mzero
950− return $ do
949+ return $
951950 case B.toList result of
952951 [Image alt (src,tit)]
953952 | Ext_implicit_figures `Set.member` exts ->
@@ -956,7 +955,7 @@ para = try $ do
956955 $ Image alt (src,'f':'i':'g':':':tit)
957956 _ -> B.para result
958957
959−plain :: MarkdownParser (Blocks)
958+plain :: MarkdownParser Blocks
960959plain = B.plain . trimInlines . mconcat <$> many1 inline
961960
962961--
@@ -968,13 +967,13 @@ htmlElement = rawVerbatimBlock
968967 <|> strictHtmlBlock
969968 <|> liftM snd (htmlTag isBlockTag)
970969
971−htmlBlock :: MarkdownParser (Blocks)
970+htmlBlock :: MarkdownParser Blocks
972971htmlBlock = do
973972 guardEnabled Ext_raw_html
974973 try (do
975974 (TagOpen t attrs) <- lookAhead $ fst <$> htmlTag isBlockTag
976975 (guard (t `elem` ["pre","style","script"]) >>
977− (B.rawBlock "html") <$> rawVerbatimBlock)
976+ B.rawBlock "html" <$> rawVerbatimBlock)
978977 <|> (do guardEnabled Ext_markdown_attribute
979978 oldMarkdownAttribute <- stateMarkdownAttribute <$> getState
980979 markdownAttribute <-
@@ -993,7 +992,7 @@ htmlBlock = do
993992 <|> (guardEnabled Ext_markdown_in_html_blocks >> rawHtmlBlocks))
994993 <|> htmlBlock'
995994
996−htmlBlock' :: MarkdownParser (Blocks)
995+htmlBlock' :: MarkdownParser Blocks
997996htmlBlock' = try $ do
998997 first <- htmlElement
999998 skipMany spaceChar
@@ -1005,23 +1004,23 @@ strictHtmlBlock = htmlInBalanced (not . isInlineTag)
10051004
10061005rawVerbatimBlock :: MarkdownParser String
10071006rawVerbatimBlock = try $ do
1008− (TagOpen tag _, open) <- htmlTag (tagOpen (flip elem
1009− ["pre", "style", "script"])
1010− (const True))
1007+ (TagOpen tag _, open) <-
1008+ htmlTag (tagOpen (`elem` ["pre", "style", "script"])
1009+ (const True))
10111010 contents <- manyTill anyChar (htmlTag (~== TagClose tag))
10121011 return $ open ++ contents ++ renderTags' [TagClose tag]
10131012
1014−rawTeXBlock :: MarkdownParser (Blocks)
1013+rawTeXBlock :: MarkdownParser Blocks
10151014rawTeXBlock = do
10161015 guardEnabled Ext_raw_tex
10171016 result <- (B.rawBlock "latex" . concat <$>
1018− (generalize rawLaTeXBlock) `sepEndBy1` blankline)
1017+ generalize rawLaTeXBlock `sepEndBy1` blankline)
10191018 <|> (B.rawBlock "context" . concat <$>
10201019 rawConTeXtEnvironment `sepEndBy1` blankline)
10211020 spaces
10221021 return result
10231022
1024−rawHtmlBlocks :: MarkdownParser (Blocks)
1023+rawHtmlBlocks :: MarkdownParser Blocks
10251024rawHtmlBlocks = do
10261025 (TagOpen tagtype _, raw) <- htmlTag isBlockTag
10271026 -- try to find closing tag
@@ -1036,7 +1035,7 @@ rawHtmlBlocks = do
10361035 (B.rawBlock "html" $ stripMarkdownAttribute raw) <>
10371036 contents <>
10381037 (B.rawBlock "html" rawcloser)))
1039− <|> return ((B.rawBlock "html" raw) <> contents)
1038+ <|> return (B.rawBlock "html" raw <> contents)
10401039 updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock }
10411040 return result
10421041
@@ -1051,7 +1050,7 @@ stripMarkdownAttribute s = renderTags' $ map filterAttrib $ parseTags s
10511050-- line block
10521051--
10531052
1054−lineBlock :: MarkdownParser (Blocks)
1053+lineBlock :: MarkdownParser Blocks
10551054lineBlock = try $ do
10561055 guardEnabled Ext_line_blocks
10571056 lines' <- lineBlockLines >>=
@@ -1069,7 +1068,7 @@ dashedLine :: Monad m => Char
10691068dashedLine ch = do
10701069 dashes <- many1 (char ch)
10711070 sp <- many spaceChar
1072− return $ (length dashes, length $ dashes ++ sp)
1071+ return (length dashes, length $ dashes ++ sp)
10731072
10741073-- Parse a table header with dashed lines of '-' preceded by
10751074-- one (or zero) line of text.
@@ -1094,8 +1093,7 @@ simpleTableHeader headless = try $ do
10941093 then replicate (length dashes) ""
10951094 else rawHeads
10961095 heads <-
1097− mapM (parseFromString (mconcat <$> many plain))
1098− $ map trim rawHeads'
1096+ mapM (parseFromString (mconcat <$> many plain) . trim) rawHeads'
10991097 return (heads, aligns, indices)
11001098
11011099-- Returns an alignment type for a table, based on a list of strings
@@ -1247,9 +1245,7 @@ gridTableHeader headless = try $ do
12471245 else many1
12481246 (notFollowedBy (gridTableSep '=') >> char '|' >>
12491247 many1Till anyChar newline)
1250− if headless
1251− then return ()
1252− else gridTableSep '=' >> return ()
1248+ unless headless (void $ gridTableSep '=')
12531249 let lines' = map snd dashes
12541250 let indices = scanl (+) 0 lines'
12551251 let aligns = replicate (length lines') AlignDefault
@@ -1274,7 +1270,7 @@ gridTableRow indices = do
12741270 colLines <- many1 (gridTableRawLine indices)
12751271 let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $
12761272 transpose colLines
1277− compactify' <$> (mapM (parseFromString parseBlocks) cols)
1273+ compactify' <$> mapM (parseFromString parseBlocks) cols
12781274
12791275removeOneLeadingSpace :: [String] -> [String]
12801276removeOneLeadingSpace xs =
@@ -1305,7 +1301,7 @@ pipeTable = try $ do
13051301 (heads,aligns) <- (,) <$> pipeTableRow <*> pipeBreak
13061302 lines' <- sequence <$> many1 pipeTableRow
13071303 let widths = replicate (length aligns) 0.0
1308− return $ (aligns, widths, heads, lines')
1304+ return (aligns, widths, heads, lines')
13091305
13101306sepPipe :: MarkdownParser ()
13111307sepPipe = try $ do
@@ -1330,7 +1326,7 @@ pipeTableRow = do
13301326 map (\ils ->
13311327 case trimInlines ils of
13321328 ils' | B.isNull ils' -> mempty
1333− | otherwise -> B.plain $ ils') cells
1329+ | otherwise -> B.plain ils') cells
13341330
13351331pipeTableHeaderPart :: Monad m => ParserT [Char] st m Alignment
13361332pipeTableHeaderPart = try $ do
@@ -1367,10 +1363,10 @@ tableWith headerParser rowParser lineParser footerParser = try $ do
13671363 lines' <- rowParser indices `sepEndBy1` lineParser
13681364 footerParser
13691365 numColumns <- getOption readerColumns
1370− let widths = if (indices == [])
1371− then replicate (length aligns) 0.0
1372− else widthsFromIndices numColumns indices
1373− return $ (aligns, widths, heads, lines')
1366+ let widths = case indices of
1367+ [] -> replicate (length aligns) 0.0
1368+ _ -> widthsFromIndices numColumns indices
1369+ return (aligns, widths, heads, lines')
13741370
13751371table :: MarkdownParser Blocks
13761372table = try $ do
@@ -1491,8 +1487,8 @@ enclosure c = do
14911487 <|> guard (c == '*')
14921488 <|> (guard =<< notAfterString)
14931489 cs <- many1 (char c)
1494− ((B.str cs) <>) <$> whitespace
1495− <|> do
1490+ (B.str cs <>) <$> whitespace
1491+ <|>
14961492 case length cs of
14971493 3 -> three c
14981494 2 -> two c mempty
@@ -1516,7 +1512,7 @@ three c = do
15161512 (ender c 3 >> return ((B.strong . B.emph) contents))
15171513 <|> (ender c 2 >> one c (B.strong contents))
15181514 <|> (ender c 1 >> two c (B.emph contents))
1519− <|> return ((B.str [c,c,c]) <> contents)
1515+ <|> return (B.str [c,c,c] <> contents)
15201516
15211517-- Parse inlines til you hit two c's, and emit strong.
15221518-- If you never do hit two cs, emit ** plus inlines parsed.
@@ -1524,7 +1520,7 @@ two :: Char -> Inlines -> MarkdownParser Inlines
15241520two c prefix' = do
15251521 contents <- mconcat <$> many (try $ notFollowedBy (ender c 2) >> inline)
15261522 (ender c 2 >> return (B.strong (prefix' <> contents)))
1527− <|> return ((B.str [c,c]) <> (prefix' <> contents))
1523+ <|> return (B.str [c,c] <> (prefix' <> contents))
15281524
15291525-- Parse inlines til you hit a c, and emit emph.
15301526-- If you never hit a c, emit * plus inlines parsed.
@@ -1535,7 +1531,7 @@ one c prefix' = do
15351531 notFollowedBy (ender c 1) >>
15361532 two c mempty) )
15371533 (ender c 1 >> return (B.emph (prefix' <> contents)))
1538− <|> return ((B.str [c]) <> (prefix' <> contents))
1534+ <|> return (B.str [c] <> (prefix' <> contents))
15391535
15401536strongOrEmph :: MarkdownParser Inlines
15411537strongOrEmph = enclosure '*' <|> enclosure '_'
@@ -1589,8 +1585,8 @@ str = do
15891585 xs -> choice (map (\x ->
15901586 try (string x >> oneOf " \n" >>
15911587 lookAhead alphaNum >>
1592− return (B.str
1593− $ result ++ spacesToNbr x ++ "\160"))) xs)
1588+ return (B.str $
1589+ result ++ spacesToNbr x ++ "\160"))) xs)
15941590 <|> (return $ B.str result)
15951591 else return $ B.str result
15961592
@@ -1622,7 +1618,7 @@ endline = try $ do
16221618 (eof >> return mempty)
16231619 <|> (guardEnabled Ext_hard_line_breaks >> return B.linebreak)
16241620 <|> (guardEnabled Ext_ignore_line_breaks >> return mempty)
1625− <|> (return B.space)
1621+ <|> return B.space
16261622
16271623--
16281624-- links
@@ -1819,7 +1815,7 @@ divHtml = try $ do
18191815 let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]
18201816 return $ B.divWith (ident, classes, keyvals) contents
18211817 else -- avoid backtracing
1822− return $ (B.rawBlock "html" (rawtag <> bls)) <> contents
1818+ return $ B.rawBlock "html" (rawtag <> bls) <> contents
18231819
18241820rawHtmlInline :: MarkdownParser Inlines
18251821rawHtmlInline = do
@@ -1843,10 +1839,8 @@ rawHtmlInline = do
18431839cite :: MarkdownParser Inlines
18441840cite = do
18451841 guardEnabled Ext_citations
1846− citations <- textualCite
1847− <|> do (cs, raw) <- withRaw normalCite
1848− return $ (flip B.cite (B.text raw)) cs
1849− return citations
1842+ textualCite <|> do (cs, raw) <- withRaw normalCite
1843+ return $ B.cite cs (B.text raw)
18501844
18511845textualCite :: MarkdownParser Inlines
18521846textualCite = try $ do
@@ -1865,7 +1859,7 @@ textualCite = try $ do
18651859 rest
18661860 Nothing ->
18671861 (do (cs, raw) <- withRaw $ bareloc first
1868− return $ (flip B.cite (B.text $ '@':key ++ " " ++ raw)) cs)
1862+ return $ B.cite cs (B.text $ '@':key ++ " " ++ raw))
18691863 <|> do st <- ask
18701864 return $ case M.lookup key (stateExamples st) of
18711865 Just n -> B.str (show n)
@@ -1906,20 +1900,20 @@ prefix = trimInlines . mconcat <$>
19061900citeList :: MarkdownParser [Citation]
19071901citeList = sepBy1 citation (try $ char ';' >> spnl)
19081902
1909−citation :: MarkdownParser (Citation)
1903+citation :: MarkdownParser Citation
19101904citation = try $ do
19111905 pref <- prefix
19121906 (suppress_author, key) <- citeKey
19131907 suff <- suffix
1914− return $ Citation{ citationId = key
1915− , citationPrefix = B.toList pref
1916− , citationSuffix = B.toList suff
1917− , citationMode = if suppress_author
1918− then SuppressAuthor
1919− else NormalCitation
1920− , citationNoteNum = 0
1921− , citationHash = 0
1922− }
1908+ return Citation{ citationId = key
1909+ , citationPrefix = B.toList pref
1910+ , citationSuffix = B.toList suff
1911+ , citationMode = if suppress_author
1912+ then SuppressAuthor
1913+ else NormalCitation
1914+ , citationNoteNum = 0
1915+ , citationHash = 0
1916+ }
19231917
19241918smart :: MarkdownParser Inlines
19251919smart = do
@@ -1941,6 +1935,6 @@ doubleQuoted :: MarkdownParser Inlines
19411935doubleQuoted = try $ do
19421936 doubleQuoteStart
19431937 contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)
1944− (withQuoteContext InDoubleQuote $ doubleQuoteEnd >> return
1938+ (withQuoteContext InDoubleQuote doubleQuoteEnd >> return
19451939 (B.doubleQuoted . trimInlines $ contents))
1946− <|> return ((B.str "\8220") <> contents)
1940+ <|> return (B.str "\8220" <> contents)