@@ -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 )
@@ -55,8 +55,9 @@ import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock )
5555import Text.Pandoc.Readers.HTML ( htmlTag, htmlInBalanced, isInlineTag, isBlockTag,
5656 isTextTag, isCommentTag )
5757import Data.Monoid (mconcat, mempty)
58−import Control.Applicative ((<$>), (<*), (*>), (<$))
58+import Control.Applicative ((<$>), (<*), (*>), (<$), (<*>))
5959import Control.Monad
60+import Control.Monad.Reader
6061import System.FilePath (takeExtension, addExtension)
6162import Text.HTML.TagSoup
6263import Text.HTML.TagSoup.Match (tagOpen)
@@ -64,25 +65,29 @@ import qualified Data.Set as Set
6465import Text.Printf (printf)
6566import Debug.Trace (trace)
6667
67−type MarkdownParser = Parser [Char] ParserState
68+type MarkdownParser a = ParserT [Char] ParserState (Reader ParserState) a
6869
6970-- | Read markdown from an input string and return a Pandoc document.
7071readMarkdown :: ReaderOptions -- ^ Reader options
7172 -> String -- ^ String to parse (assuming @'\n'@ line endings)
7273 -> Pandoc
7374readMarkdown opts s =
74− (readWith parseMarkdown) def{ stateOptions = opts } (s ++ "\n\n")
75+ runMarkdown opts s parseMarkdown
7576
7677-- | Read markdown from an input string and return a pair of a Pandoc document
7778-- and a list of warnings.
7879readMarkdownWithWarnings :: ReaderOptions -- ^ Reader options
7980 -> String -- ^ String to parse (assuming @'\n'@ line endings)
8081 -> (Pandoc, [String])
81−readMarkdownWithWarnings opts s =
82− (readWithWarnings parseMarkdown) def{ stateOptions = opts } (s ++ "\n\n")
82+readMarkdownWithWarnings opts s = runMarkdown opts s (returnWarnings parseMarkdown)
8383
84−trimInlinesF :: F Inlines -> F Inlines
85−trimInlinesF = liftM trimInlines
84+runMarkdown :: ReaderOptions -> String -> MarkdownParser a -> a
85+runMarkdown opts inp p = fst res
86+ where
87+ imd = readWithM (returnState p) def{ stateOptions = opts } (inp ++ "\n\n")
88+ res = runReader imd s
89+ s :: ParserState
90+ s = snd $ runReader imd s
8691
8792--
8893-- Constants and data structure definitions
@@ -119,10 +124,10 @@ inList = do
119124 ctx <- stateParserContext <$> getState
120125 guard (ctx == ListItemState)
121126
122−isNull :: F Inlines -> Bool
123−isNull ils = B.isNull $ runF ils def
127+isNull :: Inlines -> Bool
128+isNull = B.isNull
124129
125−spnl :: Parser [Char] st ()
130+spnl :: Monad m => ParserT [Char] st m ()
126131spnl = try $ do
127132 skipSpaces
128133 optional newline
@@ -162,9 +167,9 @@ litChar = escapedChar'
162167
163168-- | Parse a sequence of inline elements between square brackets,
164169-- including inlines between balanced pairs of square brackets.
165−inlinesInBalancedBrackets :: MarkdownParser (F Inlines)
170+inlinesInBalancedBrackets :: MarkdownParser Inlines
166171inlinesInBalancedBrackets = charsInBalancedBrackets >>=
167− parseFromString (trimInlinesF . mconcat <$> many inline)
172+ parseFromString (trimInlines . mconcat <$> many inline)
168173
169174charsInBalancedBrackets :: MarkdownParser [Char]
170175charsInBalancedBrackets = do
@@ -181,16 +186,16 @@ charsInBalancedBrackets = do
181186-- document structure
182187--
183188
184−titleLine :: MarkdownParser (F Inlines)
189+titleLine :: MarkdownParser Inlines
185190titleLine = try $ do
186191 char '%'
187192 skipSpaces
188193 res <- many $ (notFollowedBy newline >> inline)
189194 <|> try (endline >> whitespace)
190195 newline
191− return $ trimInlinesF $ mconcat res
196+ return $ trimInlines $ mconcat res
192197
193−authorsLine :: MarkdownParser (F [Inlines])
198+authorsLine :: MarkdownParser [Inlines]
194199authorsLine = try $ do
195200 char '%'
196201 skipSpaces
@@ -199,13 +204,13 @@ authorsLine = try $ do
199204 (char ';' <|>
200205 try (newline >> notFollowedBy blankline >> spaceChar))
201206 newline
202− return $ sequence $ filter (not . isNull) $ map (trimInlinesF . mconcat) authors
207+ return $ filter (not . isNull) $ map (trimInlines . mconcat) authors
203208
204−dateLine :: MarkdownParser (F Inlines)
209+dateLine :: MarkdownParser Inlines
205210dateLine = try $ do
206211 char '%'
207212 skipSpaces
208− trimInlinesF . mconcat <$> manyTill inline newline
213+ trimInlines . mconcat <$> manyTill inline newline
209214
210215titleBlock :: MarkdownParser ()
211216titleBlock = pandocTitleBlock <|> mmdTitleBlock
@@ -215,20 +220,16 @@ pandocTitleBlock = try $ do
215220 guardEnabled Ext_pandoc_title_block
216221 lookAhead (char '%')
217222 title <- option mempty titleLine
218− author <- option (return []) authorsLine
223+ author <- option [] authorsLine
219224 date <- option mempty dateLine
220225 optional blanklines
221− let meta' = do title' <- title
222− author' <- author
223− date' <- date
224− return $
225− (if B.isNull title' then id else B.setMeta "title" title')
226− . (if null author' then id else B.setMeta "author" author')
227− . (if B.isNull date' then id else B.setMeta "date" date')
228− $ nullMeta
229− updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }
230−
231−yamlMetaBlock :: MarkdownParser (F Blocks)
226+ let meta' = (if B.isNull title then id else B.setMeta "title" title)
227+ . (if null author then id else B.setMeta "author" author)
228+ . (if B.isNull date then id else B.setMeta "date" date)
229+ $ nullMeta
230+ updateState $ \st -> st{ stateMeta = stateMeta st <> meta' }
231+
232+yamlMetaBlock :: MarkdownParser Blocks
232233yamlMetaBlock = try $ do
233234 guardEnabled Ext_yaml_metadata_block
234235 pos <- getPosition
@@ -241,17 +242,17 @@ yamlMetaBlock = try $ do
241242 optional blanklines
242243 opts <- stateOptions <$> getState
243244 meta' <- case Yaml.decodeEither' $ UTF8.fromString rawYaml of
244− Right (Yaml.Object hashmap) -> return $ return $
245+ Right (Yaml.Object hashmap) -> return $
245246 H.foldrWithKey (\k v m ->
246247 if ignorable k
247248 then m
248249 else B.setMeta (T.unpack k)
249250 (yamlToMeta opts v) m)
250251 nullMeta hashmap
251− Right Yaml.Null -> return $ return nullMeta
252+ Right Yaml.Null -> return nullMeta
252253 Right _ -> do
253254 addWarning (Just pos) "YAML header is not an object"
254− return $ return nullMeta
255+ return nullMeta
255256 Left err' -> do
256257 case err' of
257258 InvalidYaml (Just YamlParseException{
@@ -270,13 +271,13 @@ yamlMetaBlock = try $ do
270271 _ -> addWarning (Just pos)
271272 $ "Could not parse YAML header: " ++
272273 show err'
273− return $ return nullMeta
274− updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }
274+ return nullMeta
275+ updateState $ \st -> st{ stateMeta = stateMeta st <> meta' }
275276 return mempty
276277
277278-- ignore fields ending with _
278279ignorable :: Text -> Bool
279−ignorable t = (T.pack "_") `T.isSuffixOf` t
280+ignorable t = T.pack "_" `T.isSuffixOf` t
280281
281282toMetaValue :: ReaderOptions -> Text -> MetaValue
282283toMetaValue opts x =
@@ -286,7 +287,7 @@ toMetaValue opts x =
286287 | endsWithNewline x -> MetaBlocks [Para xs]
287288 | otherwise -> MetaInlines xs
288289 Pandoc _ bs -> MetaBlocks bs
289− where endsWithNewline t = (T.pack "\n") `T.isSuffixOf` t
290+ where endsWithNewline t = T.pack "\n" `T.isSuffixOf` t
290291
291292yamlToMeta :: ReaderOptions -> Yaml.Value -> MetaValue
292293yamlToMeta opts (Yaml.String t) = toMetaValue opts t
@@ -314,8 +315,8 @@ mmdTitleBlock = try $ do
314315 guardEnabled Ext_mmd_title_block
315316 kvPairs <- many1 kvPair
316317 blanklines
317− updateState $ \st -> st{ stateMeta' = stateMeta' st <>
318− return (Meta $ M.fromList kvPairs) }
318+ updateState $ \st -> st{ stateMeta = stateMeta st <>
319+ (Meta $ M.fromList kvPairs) }
319320
320321kvPair :: MarkdownParser (String, MetaValue)
321322kvPair = try $ do
@@ -335,11 +336,11 @@ parseMarkdown = do
335336 optional titleBlock
336337 blocks <- parseBlocks
337338 st <- getState
338− let meta = runF (stateMeta' st) st
339− let Pandoc _ bs = B.doc $ runF blocks st
339+ let meta = stateMeta st
340+ let Pandoc _ bs = B.doc blocks
340341 return $ Pandoc meta bs
341342
342−referenceKey :: MarkdownParser (F Blocks)
343+referenceKey :: MarkdownParser Blocks
343344referenceKey = try $ do
344345 pos <- getPosition
345346 skipNonindentSpaces
@@ -366,7 +367,7 @@ referenceKey = try $ do
366367 Just _ -> addWarning (Just pos) $ "Duplicate link reference `" ++ raw ++ "'"
367368 Nothing -> return ()
368369 updateState $ \s -> s { stateKeys = M.insert key target oldkeys }
369− return $ return mempty
370+ return mempty
370371
371372referenceTitle :: MarkdownParser String
372373referenceTitle = try $ do
@@ -386,7 +387,7 @@ quotedTitle c = try $ do
386387-- | PHP Markdown Extra style abbreviation key. Currently
387388-- we just skip them, since Pandoc doesn't have an element for
388389-- an abbreviation.
389−abbrevKey :: MarkdownParser (F Blocks)
390+abbrevKey :: MarkdownParser Blocks
390391abbrevKey = do
391392 guardEnabled Ext_abbreviations
392393 try $ do
@@ -395,7 +396,7 @@ abbrevKey = do
395396 char ':'
396397 skipMany (satisfy (/= '\n'))
397398 blanklines
398− return $ return mempty
399+ return mempty
399400
400401noteMarker :: MarkdownParser String
401402noteMarker = string "[^" >> many1Till (satisfy $ not . isBlank) (char ']')
@@ -413,7 +414,7 @@ rawLines = do
413414 rest <- many rawLine
414415 return $ unlines (first:rest)
415416
416−noteBlock :: MarkdownParser (F Blocks)
417+noteBlock :: MarkdownParser Blocks
417418noteBlock = try $ do
418419 pos <- getPosition
419420 skipNonindentSpaces
@@ -425,7 +426,7 @@ noteBlock = try $ do
425426 rest <- many $ try $ blanklines >> indentSpaces >> rawLines
426427 let raw = unlines (first:rest) ++ "\n"
427428 optional blanklines
428− parsed <- parseFromString parseBlocks raw
429+ parsed <- parseFromString (inFootnote parseBlocks) raw
429430 let newnote = (ref, parsed)
430431 oldnotes <- stateNotes' <$> getState
431432 case lookup ref oldnotes of
@@ -434,14 +435,22 @@ noteBlock = try $ do
434435 updateState $ \s -> s { stateNotes' = newnote : oldnotes }
435436 return mempty
436437
438+inFootnote :: MarkdownParser a -> MarkdownParser a
439+inFootnote p = do
440+ st <- stateInFootnote <$> getState
441+ updateState (\s -> s { stateInFootnote = True } )
442+ r <- p
443+ updateState (\s -> s { stateInFootnote = st } )
444+ return r
445+
437446--
438447-- parsing blocks
439448--
440449
441−parseBlocks :: MarkdownParser (F Blocks)
450+parseBlocks :: MarkdownParser Blocks
442451parseBlocks = mconcat <$> manyTill block eof
443452
444−block :: MarkdownParser (F Blocks)
453+block :: MarkdownParser Blocks
445454block = do
446455 tr <- getOption readerTrace
447456 pos <- getPosition
@@ -457,7 +466,7 @@ block = do
457466 , htmlBlock
458467 , table
459468 , codeBlockIndented
460− , guardEnabled Ext_latex_macros *> (macro >>= return . return)
469+ , guardEnabled Ext_latex_macros *> macro
461470 , rawTeXBlock
462471 , lineBlock
463472 , blockQuote
@@ -470,29 +479,28 @@ block = do
470479 , para
471480 , plain
472481 ] <?> "block"
473− when tr $ do
474− st <- getState
482+ when tr $
475483 trace (printf "line %d: %s" (sourceLine pos)
476− (take 60 $ show $ B.toList $ runF res st)) (return ())
484+ (take 60 . show . B.toList $ res)) (return ())
477485 return res
478486
479487--
480488-- header blocks
481489--
482490
483−header :: MarkdownParser (F Blocks)
491+header :: MarkdownParser Blocks
484492header = setextHeader <|> atxHeader <?> "header"
485493
486−atxHeader :: MarkdownParser (F Blocks)
494+atxHeader :: MarkdownParser Blocks
487495atxHeader = try $ do
488− level <- many1 (char '#') >>= return . length
496+ level <- length <$> many1 (char '#')
489497 notFollowedBy $ guardEnabled Ext_fancy_lists >>
490498 (char '.' <|> char ')') -- this would be a list
491499 skipSpaces
492− text <- trimInlinesF . mconcat <$> many (notFollowedBy atxClosing >> inline)
500+ text <- trimInlines . mconcat <$> many (notFollowedBy atxClosing >> inline)
493501 attr <- atxClosing
494− attr' <- registerHeader attr (runF text defaultParserState)
495− return $ B.headerWith attr' level <$> text
502+ attr' <- registerHeader attr text
503+ return $ B.headerWith attr' level text
496504
497505atxClosing :: MarkdownParser Attr
498506atxClosing = try $ do
@@ -519,25 +527,25 @@ mmdHeaderIdentifier = do
519527 skipSpaces
520528 return (ident,[],[])
521529
522−setextHeader :: MarkdownParser (F Blocks)
530+setextHeader :: MarkdownParser Blocks
523531setextHeader = try $ do
524532 -- This lookahead prevents us from wasting time parsing Inlines
525533 -- unless necessary -- it gives a significant performance boost.
526534 lookAhead $ anyLine >> many1 (oneOf setextHChars) >> blankline
527− text <- trimInlinesF . mconcat <$> many1 (notFollowedBy setextHeaderEnd >> inline)
535+ text <- trimInlines . mconcat <$> many1 (notFollowedBy setextHeaderEnd >> inline)
528536 attr <- setextHeaderEnd
529537 underlineChar <- oneOf setextHChars
530538 many (char underlineChar)
531539 blanklines
532− let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1
533− attr' <- registerHeader attr (runF text defaultParserState)
534− return $ B.headerWith attr' level <$> text
540+ let level = (fromMaybe 0 $ elemIndex underlineChar setextHChars) + 1
541+ attr' <- registerHeader attr text
542+ return $ B.headerWith attr' level text
535543
536544--
537545-- hrule block
538546--
539547
540−hrule :: Parser [Char] st (F Blocks)
548+hrule :: Monad m => ParserT [Char] st m Blocks
541549hrule = try $ do
542550 skipSpaces
543551 start <- satisfy isHruleChar
@@ -545,24 +553,24 @@ hrule = try $ do
545553 skipMany (spaceChar <|> char start)
546554 newline
547555 optional blanklines
548− return $ return B.horizontalRule
556+ return B.horizontalRule
549557
550558--
551559-- code blocks
552560--
553561
554562indentedLine :: MarkdownParser String
555−indentedLine = indentSpaces >> anyLine >>= return . (++ "\n")
563+indentedLine = indentSpaces >> ((++ "\n") <$> anyLine)
556564
557−blockDelimiter :: (Char -> Bool)
565+blockDelimiter :: Monad m
566+ => (Char -> Bool)
558567 -> Maybe Int
559− -> Parser [Char] st Int
568+ -> ParserT [Char] st m Int
560569blockDelimiter f len = try $ do
561570 c <- lookAhead (satisfy f)
562571 case len of
563572 Just l -> count l (char c) >> many (char c) >> return l
564− Nothing -> count 3 (char c) >> many (char c) >>=
565− return . (+ 3) . length
573+ Nothing -> count 3 (char c) >> ((+ 3) . length <$> many (char c))
566574
567575attributes :: MarkdownParser Attr
568576attributes = try $ do
@@ -607,7 +615,7 @@ specialAttr = do
607615 char '-'
608616 return $ \(id',cs,kvs) -> (id',cs ++ ["unnumbered"],kvs)
609617
610−codeBlockFenced :: MarkdownParser (F Blocks)
618+codeBlockFenced :: MarkdownParser Blocks
611619codeBlockFenced = try $ do
612620 c <- try (guardEnabled Ext_fenced_code_blocks >> lookAhead (char '~'))
613621 <|> (guardEnabled Ext_backtick_code_blocks >> lookAhead (char '`'))
@@ -619,7 +627,7 @@ codeBlockFenced = try $ do
619627 blankline
620628 contents <- manyTill anyLine (blockDelimiter (== c) (Just size))
621629 blanklines
622− return $ return $ B.codeBlockWith attr $ intercalate "\n" contents
630+ return $ B.codeBlockWith attr $ intercalate "\n" contents
623631
624632-- correctly handle github language identifiers
625633toLanguageId :: String -> String
@@ -628,7 +636,7 @@ toLanguageId = map toLower . go
628636 go "objective-c" = "objectivec"
629637 go x = x
630638
631−codeBlockIndented :: MarkdownParser (F Blocks)
639+codeBlockIndented :: MarkdownParser Blocks
632640codeBlockIndented = do
633641 contents <- many1 (indentedLine <|>
634642 try (do b <- blanklines
@@ -636,15 +644,15 @@ codeBlockIndented = do
636644 return $ b ++ l))
637645 optional blanklines
638646 classes <- getOption readerIndentedCodeClasses
639− return $ return $ B.codeBlockWith ("", classes, []) $
647+ return $ B.codeBlockWith ("", classes, []) $
640648 stripTrailingNewlines $ concat contents
641649
642−lhsCodeBlock :: MarkdownParser (F Blocks)
650+lhsCodeBlock :: MarkdownParser Blocks
643651lhsCodeBlock = do
644652 guardEnabled Ext_literate_haskell
645− (return . B.codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
653+ (B.codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
646654 (lhsCodeBlockBird <|> lhsCodeBlockLaTeX))
647− <|> (return . B.codeBlockWith ("",["sourceCode","haskell"],[]) <$>
655+ <|> (B.codeBlockWith ("",["sourceCode","haskell"],[]) <$>
648656 lhsCodeBlockInverseBird)
649657
650658lhsCodeBlockLaTeX :: MarkdownParser String
@@ -673,7 +681,7 @@ lhsCodeBlockBirdWith c = try $ do
673681 blanklines
674682 return $ intercalate "\n" lns'
675683
676−birdTrackLine :: Char -> Parser [Char] st String
684+birdTrackLine :: Monad m => Char -> ParserT [Char] st m String
677685birdTrackLine c = try $ do
678686 char c
679687 -- allow html tags on left margin:
@@ -701,12 +709,12 @@ emailBlockQuote = try $ do
701709 optional blanklines
702710 return raw
703711
704−blockQuote :: MarkdownParser (F Blocks)
712+blockQuote :: MarkdownParser Blocks
705713blockQuote = do
706714 raw <- emailBlockQuote
707715 -- parse the extracted block, which may contain various block elements:
708− contents <- parseFromString parseBlocks $ (intercalate "\n" raw) ++ "\n\n"
709− return $ B.blockQuote <$> contents
716+ contents <- parseFromString parseBlocks $ intercalate "\n" raw ++ "\n\n"
717+ return $ B.blockQuote contents
710718
711719--
712720-- list blocks
@@ -749,7 +757,7 @@ anyOrderedListStart = try $ do
749757 return res
750758
751759listStart :: MarkdownParser ()
752−listStart = bulletListStart <|> (anyOrderedListStart >> return ())
760+listStart = bulletListStart <|> void anyOrderedListStart
753761
754762listLine :: MarkdownParser String
755763listLine = try $ do
@@ -804,7 +812,7 @@ listContinuationLine = try $ do
804812 return $ result ++ "\n"
805813
806814listItem :: MarkdownParser a
807− -> MarkdownParser (F Blocks)
815+ -> MarkdownParser Blocks
808816listItem start = try $ do
809817 first <- rawListItem start
810818 continuations <- many listContinuation
@@ -820,14 +828,14 @@ listItem start = try $ do
820828 updateState (\st -> st {stateParserContext = oldContext})
821829 return contents
822830
823−orderedList :: MarkdownParser (F Blocks)
831+orderedList :: MarkdownParser Blocks
824832orderedList = try $ do
825833 (start, style, delim) <- lookAhead anyOrderedListStart
826834 unless (style `elem` [DefaultStyle, Decimal, Example] &&
827835 delim `elem` [DefaultDelim, Period]) $
828836 guardEnabled Ext_fancy_lists
829837 when (style == Example) $ guardEnabled Ext_example_lists
830− items <- fmap sequence $ many1 $ listItem
838+ items <- many1 $ listItem
831839 ( try $ do
832840 optional newline -- if preceded by Plain block in a list
833841 startpos <- sourceColumn <$> getPosition
@@ -839,12 +847,12 @@ orderedList = try $ do
839847 atMostSpaces (tabStop - (endpos - startpos))
840848 return res )
841849 start' <- option 1 $ guardEnabled Ext_startnum >> return start
842− return $ B.orderedListWith (start', style, delim) <$> fmap compactify' items
850+ return $ B.orderedListWith (start', style, delim) (compactify' items)
843851
844−bulletList :: MarkdownParser (F Blocks)
852+bulletList :: MarkdownParser Blocks
845853bulletList = do
846− items <- fmap sequence $ many1 $ listItem bulletListStart
847− return $ B.bulletList <$> fmap compactify' items
854+ items <- many1 $ listItem bulletListStart
855+ return $ B.bulletList (compactify' items)
848856
849857-- definition lists
850858
@@ -859,14 +867,14 @@ defListMarker = do
859867 else mzero
860868 return ()
861869
862−definitionListItem :: Bool -> MarkdownParser (F (Inlines, [Blocks]))
870+definitionListItem :: Bool -> MarkdownParser (Inlines, [Blocks])
863871definitionListItem compact = try $ do
864872 rawLine' <- anyLine
865873 raw <- many1 $ defRawBlock compact
866− term <- parseFromString (trimInlinesF . mconcat <$> many inline) rawLine'
874+ term <- parseFromString (trimInlines . mconcat <$> many inline) rawLine'
867875 contents <- mapM (parseFromString parseBlocks) raw
868876 optional blanklines
869− return $ liftM2 (,) term (sequence contents)
877+ return (term, contents)
870878
871879defRawBlock :: Bool -> MarkdownParser String
872880defRawBlock compact = try $ do
@@ -889,32 +897,32 @@ defRawBlock compact = try $ do
889897 return $ trimr (firstline ++ "\n" ++ unlines rawlines ++ cont) ++
890898 if hasBlank || not (null cont) then "\n\n" else ""
891899
892−definitionList :: MarkdownParser (F Blocks)
900+definitionList :: MarkdownParser Blocks
893901definitionList = try $ do
894902 lookAhead (anyLine >> optional blankline >> defListMarker)
895903 compactDefinitionList <|> normalDefinitionList
896904
897−compactDefinitionList :: MarkdownParser (F Blocks)
905+compactDefinitionList :: MarkdownParser Blocks
898906compactDefinitionList = do
899907 guardEnabled Ext_compact_definition_lists
900− items <- fmap sequence $ many1 $ definitionListItem True
901− return $ B.definitionList <$> fmap compactify'DL items
908+ items <- many1 $ definitionListItem True
909+ return $ B.definitionList (compactify'DL items)
902910
903−normalDefinitionList :: MarkdownParser (F Blocks)
911+normalDefinitionList :: MarkdownParser Blocks
904912normalDefinitionList = do
905913 guardEnabled Ext_definition_lists
906− items <- fmap sequence $ many1 $ definitionListItem False
907− return $ B.definitionList <$> items
914+ items <- many1 $ definitionListItem False
915+ return $ B.definitionList items
908916
909917--
910918-- paragraph block
911919--
912920
913−para :: MarkdownParser (F Blocks)
921+para :: MarkdownParser Blocks
914922para = try $ do
915923 exts <- getOption readerExtensions
916− result <- trimInlinesF . mconcat <$> many1 inline
917− option (B.plain <$> result)
924+ result <- trimInlines . mconcat <$> many1 inline
925+ option (B.plain result)
918926 $ try $ do
919927 newline
920928 (blanklines >> return mempty)
@@ -931,18 +939,17 @@ para = try $ do
931939 Just "div" -> () <$
932940 lookAhead (htmlTag (~== TagClose "div"))
933941 _ -> mzero
934− return $ do
935− result' <- result
936− case B.toList result' of
942+ return $
943+ case B.toList result of
937944 [Image alt (src,tit)]
938945 | Ext_implicit_figures `Set.member` exts ->
939946 -- the fig: at beginning of title indicates a figure
940− return $ B.para $ B.singleton
947+ B.para $ B.singleton
941948 $ Image alt (src,'f':'i':'g':':':tit)
942− _ -> return $ B.para result'
949+ _ -> B.para result
943950
944−plain :: MarkdownParser (F Blocks)
945−plain = fmap B.plain . trimInlinesF . mconcat <$> many1 inline
951+plain :: MarkdownParser Blocks
952+plain = B.plain . trimInlines . mconcat <$> many1 inline
946953
947954--
948955-- raw html
@@ -953,13 +960,13 @@ htmlElement = rawVerbatimBlock
953960 <|> strictHtmlBlock
954961 <|> liftM snd (htmlTag isBlockTag)
955962
956−htmlBlock :: MarkdownParser (F Blocks)
963+htmlBlock :: MarkdownParser Blocks
957964htmlBlock = do
958965 guardEnabled Ext_raw_html
959966 try (do
960967 (TagOpen t attrs) <- lookAhead $ fst <$> htmlTag isBlockTag
961968 (guard (t `elem` ["pre","style","script"]) >>
962− (return . B.rawBlock "html") <$> rawVerbatimBlock)
969+ B.rawBlock "html" <$> rawVerbatimBlock)
963970 <|> (do guardEnabled Ext_markdown_attribute
964971 oldMarkdownAttribute <- stateMarkdownAttribute <$> getState
965972 markdownAttribute <-
@@ -978,35 +985,35 @@ htmlBlock = do
978985 <|> (guardEnabled Ext_markdown_in_html_blocks >> rawHtmlBlocks))
979986 <|> htmlBlock'
980987
981−htmlBlock' :: MarkdownParser (F Blocks)
988+htmlBlock' :: MarkdownParser Blocks
982989htmlBlock' = try $ do
983990 first <- htmlElement
984991 skipMany spaceChar
985992 optional blanklines
986− return $ return $ B.rawBlock "html" first
993+ return $ B.rawBlock "html" first
987994
988995strictHtmlBlock :: MarkdownParser String
989996strictHtmlBlock = htmlInBalanced (not . isInlineTag)
990997
991998rawVerbatimBlock :: MarkdownParser String
992999rawVerbatimBlock = try $ do
993− (TagOpen tag _, open) <- htmlTag (tagOpen (flip elem
994− ["pre", "style", "script"])
995− (const True))
1000+ (TagOpen tag _, open) <-
1001+ htmlTag (tagOpen (`elem` ["pre", "style", "script"])
1002+ (const True))
9961003 contents <- manyTill anyChar (htmlTag (~== TagClose tag))
9971004 return $ open ++ contents ++ renderTags' [TagClose tag]
9981005
999−rawTeXBlock :: MarkdownParser (F Blocks)
1006+rawTeXBlock :: MarkdownParser Blocks
10001007rawTeXBlock = do
10011008 guardEnabled Ext_raw_tex
10021009 result <- (B.rawBlock "latex" . concat <$>
1003− rawLaTeXBlock `sepEndBy1` blankline)
1010+ generalize rawLaTeXBlock `sepEndBy1` blankline)
10041011 <|> (B.rawBlock "context" . concat <$>
10051012 rawConTeXtEnvironment `sepEndBy1` blankline)
10061013 spaces
1007− return $ return result
1014+ return result
10081015
1009−rawHtmlBlocks :: MarkdownParser (F Blocks)
1016+rawHtmlBlocks :: MarkdownParser Blocks
10101017rawHtmlBlocks = do
10111018 (TagOpen tagtype _, raw) <- htmlTag isBlockTag
10121019 -- try to find closing tag
@@ -1018,10 +1025,10 @@ rawHtmlBlocks = do
10181025 contents <- mconcat <$> many (notFollowedBy' closer >> block)
10191026 result <-
10201027 (closer >>= \(_, rawcloser) -> return (
1021− return (B.rawBlock "html" $ stripMarkdownAttribute raw) <>
1028+ (B.rawBlock "html" $ stripMarkdownAttribute raw) <>
10221029 contents <>
1023− return (B.rawBlock "html" rawcloser)))
1024− <|> return (return (B.rawBlock "html" raw) <> contents)
1030+ (B.rawBlock "html" rawcloser)))
1031+ <|> return (B.rawBlock "html" raw <> contents)
10251032 updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock }
10261033 return result
10271034
@@ -1036,12 +1043,12 @@ stripMarkdownAttribute s = renderTags' $ map filterAttrib $ parseTags s
10361043-- line block
10371044--
10381045
1039−lineBlock :: MarkdownParser (F Blocks)
1046+lineBlock :: MarkdownParser Blocks
10401047lineBlock = try $ do
10411048 guardEnabled Ext_line_blocks
10421049 lines' <- lineBlockLines >>=
1043− mapM (parseFromString (trimInlinesF . mconcat <$> many inline))
1044− return $ B.para <$> (mconcat $ intersperse (return B.linebreak) lines')
1050+ mapM (parseFromString (trimInlines . mconcat <$> many inline))
1051+ return $ B.para (mconcat $ intersperse B.linebreak lines')
10451052
10461053--
10471054-- Tables
@@ -1049,17 +1056,17 @@ lineBlock = try $ do
10491056
10501057-- Parse a dashed line with optional trailing spaces; return its length
10511058-- and the length including trailing space.
1052−dashedLine :: Char
1053− -> Parser [Char] st (Int, Int)
1059+dashedLine :: Monad m => Char
1060+ -> ParserT [Char] st m (Int, Int)
10541061dashedLine ch = do
10551062 dashes <- many1 (char ch)
10561063 sp <- many spaceChar
1057− return $ (length dashes, length $ dashes ++ sp)
1064+ return (length dashes, length $ dashes ++ sp)
10581065
10591066-- Parse a table header with dashed lines of '-' preceded by
10601067-- one (or zero) line of text.
10611068simpleTableHeader :: Bool -- ^ Headerless table
1062− -> MarkdownParser (F [Blocks], [Alignment], [Int])
1069+ -> MarkdownParser ([Blocks], [Alignment], [Int])
10631070simpleTableHeader headless = try $ do
10641071 rawContent <- if headless
10651072 then return ""
@@ -1078,9 +1085,8 @@ simpleTableHeader headless = try $ do
10781085 let rawHeads' = if headless
10791086 then replicate (length dashes) ""
10801087 else rawHeads
1081− heads <- fmap sequence
1082− $ mapM (parseFromString (mconcat <$> many plain))
1083− $ map trim rawHeads'
1088+ heads <-
1089+ mapM (parseFromString (mconcat <$> many plain) . trim) rawHeads'
10841090 return (heads, aligns, indices)
10851091
10861092-- Returns an alignment type for a table, based on a list of strings
@@ -1121,30 +1127,30 @@ rawTableLine indices = do
11211127
11221128-- Parse a table line and return a list of lists of blocks (columns).
11231129tableLine :: [Int]
1124− -> MarkdownParser (F [Blocks])
1130+ -> MarkdownParser [Blocks]
11251131tableLine indices = rawTableLine indices >>=
1126− fmap sequence . mapM (parseFromString (mconcat <$> many plain))
1132+ mapM (parseFromString (mconcat <$> many plain))
11271133
11281134-- Parse a multiline table row and return a list of blocks (columns).
11291135multilineRow :: [Int]
1130− -> MarkdownParser (F [Blocks])
1136+ -> MarkdownParser [Blocks]
11311137multilineRow indices = do
11321138 colLines <- many1 (rawTableLine indices)
11331139 let cols = map unlines $ transpose colLines
1134− fmap sequence $ mapM (parseFromString (mconcat <$> many plain)) cols
1140+ mapM (parseFromString (mconcat <$> many plain)) cols
11351141
11361142-- Parses a table caption: inlines beginning with 'Table:'
11371143-- and followed by blank lines.
1138−tableCaption :: MarkdownParser (F Inlines)
1144+tableCaption :: MarkdownParser Inlines
11391145tableCaption = try $ do
11401146 guardEnabled Ext_table_captions
11411147 skipNonindentSpaces
11421148 string ":" <|> string "Table:"
1143− trimInlinesF . mconcat <$> many1 inline <* blanklines
1149+ trimInlines . mconcat <$> many1 inline <* blanklines
11441150
11451151-- Parse a simple table with '---' header and one line per row.
11461152simpleTable :: Bool -- ^ Headerless table
1147− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])
1153+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])
11481154simpleTable headless = do
11491155 (aligns, _widths, heads', lines') <-
11501156 tableWith (simpleTableHeader headless) tableLine
@@ -1158,12 +1164,12 @@ simpleTable headless = do
11581164-- which may be multiline, separated by blank lines, and
11591165-- ending with a footer (dashed line followed by blank line).
11601166multilineTable :: Bool -- ^ Headerless table
1161− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])
1167+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])
11621168multilineTable headless =
11631169 tableWith (multilineTableHeader headless) multilineRow blanklines tableFooter
11641170
11651171multilineTableHeader :: Bool -- ^ Headerless table
1166− -> MarkdownParser (F [Blocks], [Alignment], [Int])
1172+ -> MarkdownParser ([Blocks], [Alignment], [Int])
11671173multilineTableHeader headless = try $ do
11681174 unless headless $
11691175 tableSep >> notFollowedBy blankline
@@ -1185,7 +1191,7 @@ multilineTableHeader headless = try $ do
11851191 let rawHeads = if headless
11861192 then replicate (length dashes) ""
11871193 else map (unlines . map trim) rawHeadsList
1188− heads <- fmap sequence $
1194+ heads <-
11891195 mapM (parseFromString (mconcat <$> many plain)) $
11901196 map trim rawHeads
11911197 return (heads, aligns, indices)
@@ -1195,7 +1201,7 @@ multilineTableHeader headless = try $ do
11951201-- which may be grid, separated by blank lines, and
11961202-- ending with a footer (dashed line followed by blank line).
11971203gridTable :: Bool -- ^ Headerless table
1198− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])
1204+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])
11991205gridTable headless =
12001206 tableWith (gridTableHeader headless) gridTableRow
12011207 (gridTableSep '-') gridTableFooter
@@ -1204,13 +1210,13 @@ gridTableSplitLine :: [Int] -> String -> [String]
12041210gridTableSplitLine indices line = map removeFinalBar $ tail $
12051211 splitStringByIndices (init indices) $ trimr line
12061212
1207−gridPart :: Char -> Parser [Char] st (Int, Int)
1213+gridPart :: Monad m => Char -> ParserT [Char] st m (Int, Int)
12081214gridPart ch = do
12091215 dashes <- many1 (char ch)
12101216 char '+'
12111217 return (length dashes, length dashes + 1)
12121218
1213−gridDashedLines :: Char -> Parser [Char] st [(Int,Int)]
1219+gridDashedLines :: Monad m => Char -> ParserT [Char] st m [(Int,Int)]
12141220gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline
12151221
12161222removeFinalBar :: String -> String
@@ -1223,7 +1229,7 @@ gridTableSep ch = try $ gridDashedLines ch >> return '\n'
12231229
12241230-- | Parse header for a grid table.
12251231gridTableHeader :: Bool -- ^ Headerless table
1226− -> MarkdownParser (F [Blocks], [Alignment], [Int])
1232+ -> MarkdownParser ([Blocks], [Alignment], [Int])
12271233gridTableHeader headless = try $ do
12281234 optional blanklines
12291235 dashes <- gridDashedLines '-'
@@ -1232,9 +1238,7 @@ gridTableHeader headless = try $ do
12321238 else many1
12331239 (notFollowedBy (gridTableSep '=') >> char '|' >>
12341240 many1Till anyChar newline)
1235− if headless
1236− then return ()
1237− else gridTableSep '=' >> return ()
1241+ unless headless (void $ gridTableSep '=')
12381242 let lines' = map snd dashes
12391243 let indices = scanl (+) 0 lines'
12401244 let aligns = replicate (length lines') AlignDefault
@@ -1243,7 +1247,7 @@ gridTableHeader headless = try $ do
12431247 then replicate (length dashes) ""
12441248 else map (unlines . map trim) $ transpose
12451249 $ map (gridTableSplitLine indices) rawContent
1246− heads <- fmap sequence $ mapM (parseFromString parseBlocks . trim) rawHeads
1250+ heads <- mapM (parseFromString parseBlocks . trim) rawHeads
12471251 return (heads, aligns, indices)
12481252
12491253gridTableRawLine :: [Int] -> MarkdownParser [String]
@@ -1254,12 +1258,12 @@ gridTableRawLine indices = do
12541258
12551259-- | Parse row of grid table.
12561260gridTableRow :: [Int]
1257− -> MarkdownParser (F [Blocks])
1261+ -> MarkdownParser [Blocks]
12581262gridTableRow indices = do
12591263 colLines <- many1 (gridTableRawLine indices)
12601264 let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $
12611265 transpose colLines
1262− fmap compactify' <$> fmap sequence (mapM (parseFromString parseBlocks) cols)
1266+ compactify' <$> mapM (parseFromString parseBlocks) cols
12631267
12641268removeOneLeadingSpace :: [String] -> [String]
12651269removeOneLeadingSpace xs =
@@ -1285,14 +1289,12 @@ pipeBreak = try $ do
12851289 blankline
12861290 return (first:rest)
12871291
1288−pipeTable :: MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])
1292+pipeTable :: MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])
12891293pipeTable = try $ do
1290− (heads,aligns) <- pipeTableRow >>= \row ->
1291− pipeBreak >>= \als ->
1292− return (row, als)
1293− lines' <- sequence <$> many1 pipeTableRow
1294+ (heads,aligns) <- (,) <$> pipeTableRow <*> pipeBreak
1295+ lines' <- many1 pipeTableRow
12941296 let widths = replicate (length aligns) 0.0
1295− return $ (aligns, widths, heads, lines')
1297+ return (aligns, widths, heads, lines')
12961298
12971299sepPipe :: MarkdownParser ()
12981300sepPipe = try $ do
@@ -1300,7 +1302,7 @@ sepPipe = try $ do
13001302 notFollowedBy blankline
13011303
13021304-- parse a row, also returning probable alignments for org-table cells
1303−pipeTableRow :: MarkdownParser (F [Blocks])
1305+pipeTableRow :: MarkdownParser [Blocks]
13041306pipeTableRow = do
13051307 nonindentSpaces
13061308 openPipe <- (True <$ char '|') <|> return False
@@ -1312,16 +1314,14 @@ pipeTableRow = do
13121314 guard $ not (null rest && not openPipe)
13131315 optional (char '|')
13141316 blankline
1315− let cells = sequence (first:rest)
1316− return $ do
1317− cells' <- cells
1318− return $ map
1319− (\ils ->
1317+ let cells = first:rest
1318+ return $
1319+ map (\ils ->
13201320 case trimInlines ils of
13211321 ils' | B.isNull ils' -> mempty
1322− | otherwise -> B.plain $ ils') cells'
1322+ | otherwise -> B.plain ils') cells
13231323
1324−pipeTableHeaderPart :: Parser [Char] st Alignment
1324+pipeTableHeaderPart :: Monad m => ParserT [Char] st m Alignment
13251325pipeTableHeaderPart = try $ do
13261326 skipMany spaceChar
13271327 left <- optionMaybe (char ':')
@@ -1336,7 +1336,7 @@ pipeTableHeaderPart = try $ do
13361336 (Just _,Just _) -> AlignCenter
13371337
13381338-- Succeed only if current line contains a pipe.
1339−scanForPipe :: Parser [Char] st ()
1339+scanForPipe :: Monad m => ParserT [Char] st m ()
13401340scanForPipe = do
13411341 inp <- getInput
13421342 case break (\c -> c == '\n' || c == '|') inp of
@@ -1346,22 +1346,22 @@ scanForPipe = do
13461346-- | Parse a table using 'headerParser', 'rowParser',
13471347-- 'lineParser', and 'footerParser'. Variant of the version in
13481348-- Text.Pandoc.Parsing.
1349−tableWith :: MarkdownParser (F [Blocks], [Alignment], [Int])
1350− -> ([Int] -> MarkdownParser (F [Blocks]))
1349+tableWith :: MarkdownParser ([Blocks], [Alignment], [Int])
1350+ -> ([Int] -> MarkdownParser [Blocks])
13511351 -> MarkdownParser sep
13521352 -> MarkdownParser end
1353− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])
1353+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])
13541354tableWith headerParser rowParser lineParser footerParser = try $ do
13551355 (heads, aligns, indices) <- headerParser
1356− lines' <- fmap sequence $ rowParser indices `sepEndBy1` lineParser
1356+ lines' <- rowParser indices `sepEndBy1` lineParser
13571357 footerParser
13581358 numColumns <- getOption readerColumns
1359− let widths = if (indices == [])
1360− then replicate (length aligns) 0.0
1361− else widthsFromIndices numColumns indices
1362− return $ (aligns, widths, heads, lines')
1359+ let widths = case indices of
1360+ [] -> replicate (length aligns) 0.0
1361+ _ -> widthsFromIndices numColumns indices
1362+ return (aligns, widths, heads, lines')
13631363
1364−table :: MarkdownParser (F Blocks)
1364+table :: MarkdownParser Blocks
13651365table = try $ do
13661366 frontCaption <- option Nothing (Just <$> tableCaption)
13671367 (aligns, widths, heads, lns) <-
@@ -1376,19 +1376,15 @@ table = try $ do
13761376 (gridTable False <|> gridTable True)) <?> "table"
13771377 optional blanklines
13781378 caption <- case frontCaption of
1379− Nothing -> option (return mempty) tableCaption
1379+ Nothing -> option mempty tableCaption
13801380 Just c -> return c
1381− return $ do
1382− caption' <- caption
1383− heads' <- heads
1384− lns' <- lns
1385− return $ B.table caption' (zip aligns widths) heads' lns'
1381+ return $ B.table caption (zip aligns widths) heads lns
13861382
13871383--
13881384-- inline
13891385--
13901386
1391−inline :: MarkdownParser (F Inlines)
1387+inline :: MarkdownParser Inlines
13921388inline = choice [ whitespace
13931389 , bareURL
13941390 , str
@@ -1411,7 +1407,7 @@ inline = choice [ whitespace
14111407 , rawLaTeXInline'
14121408 , exampleRef
14131409 , smart
1414− , return . B.singleton <$> charRef
1410+ , B.singleton <$> charRef
14151411 , symbol
14161412 , ltSign
14171413 ] <?> "inline"
@@ -1422,43 +1418,42 @@ escapedChar' = try $ do
14221418 (guardEnabled Ext_all_symbols_escapable >> satisfy (not . isAlphaNum))
14231419 <|> oneOf "\\`*_{}[]()>#+-.!~\""
14241420
1425−escapedChar :: MarkdownParser (F Inlines)
1421+escapedChar :: MarkdownParser Inlines
14261422escapedChar = do
14271423 result <- escapedChar'
14281424 case result of
1429− ' ' -> return $ return $ B.str "\160" -- "\ " is a nonbreaking space
1425+ ' ' -> return $ B.str "\160" -- "\ " is a nonbreaking space
14301426 '\n' -> guardEnabled Ext_escaped_line_breaks >>
1431− return (return B.linebreak) -- "\[newline]" is a linebreak
1432− _ -> return $ return $ B.str [result]
1427+ return B.linebreak -- "\[newline]" is a linebreak
1428+ _ -> return $ B.str [result]
14331429
1434−ltSign :: MarkdownParser (F Inlines)
1430+ltSign :: MarkdownParser Inlines
14351431ltSign = do
14361432 guardDisabled Ext_raw_html
14371433 <|> (notFollowedByHtmlCloser >> notFollowedBy' (htmlTag isBlockTag))
14381434 char '<'
1439− return $ return $ B.str "<"
1435+ return $ B.str "<"
14401436
1441−exampleRef :: MarkdownParser (F Inlines)
1437+exampleRef :: MarkdownParser Inlines
14421438exampleRef = try $ do
14431439 guardEnabled Ext_example_lists
14441440 char '@'
14451441 lab <- many1 (alphaNum <|> oneOf "-_")
1446− return $ do
1447− st <- askF
1448− return $ case M.lookup lab (stateExamples st) of
1449− Just n -> B.str (show n)
1450− Nothing -> B.str ('@':lab)
1442+ st <- ask
1443+ return $ case M.lookup lab (stateExamples st) of
1444+ Just n -> B.str (show n)
1445+ Nothing -> B.str ('@':lab)
14511446
1452−symbol :: MarkdownParser (F Inlines)
1447+symbol :: MarkdownParser Inlines
14531448symbol = do
14541449 result <- noneOf "<\\\n\t "
14551450 <|> try (do lookAhead $ char '\\'
14561451 notFollowedBy' (() <$ rawTeXBlock)
14571452 char '\\')
1458− return $ return $ B.str [result]
1453+ return $ B.str [result]
14591454
14601455-- parses inline code, between n `s and n `s
1461−code :: MarkdownParser (F Inlines)
1456+code :: MarkdownParser Inlines
14621457code = try $ do
14631458 starts <- many1 (char '`')
14641459 skipSpaces
@@ -1468,16 +1463,16 @@ code = try $ do
14681463 notFollowedBy (char '`')))
14691464 attr <- option ([],[],[]) (try $ guardEnabled Ext_inline_code_attributes >>
14701465 optional whitespace >> attributes)
1471− return $ return $ B.codeWith attr $ trim $ concat result
1466+ return $ B.codeWith attr $ trim $ concat result
14721467
1473−math :: MarkdownParser (F Inlines)
1474−math = (return . B.displayMath <$> (mathDisplay >>= applyMacros'))
1475− <|> (return . B.math <$> (mathInline >>= applyMacros'))
1468+math :: MarkdownParser Inlines
1469+math = (B.displayMath <$> (mathDisplay >>= applyMacros'))
1470+ <|> (B.math <$> (mathInline >>= applyMacros'))
14761471
14771472-- Parses material enclosed in *s, **s, _s, or __s.
14781473-- Designed to avoid backtracking.
14791474enclosure :: Char
1480− -> MarkdownParser (F Inlines)
1475+ -> MarkdownParser Inlines
14811476enclosure c = do
14821477 -- we can't start an enclosure with _ if after a string and
14831478 -- the intraword_underscores extension is enabled:
@@ -1485,13 +1480,13 @@ enclosure c = do
14851480 <|> guard (c == '*')
14861481 <|> (guard =<< notAfterString)
14871482 cs <- many1 (char c)
1488− (return (B.str cs) <>) <$> whitespace
1489− <|> do
1483+ (B.str cs <>) <$> whitespace
1484+ <|>
14901485 case length cs of
14911486 3 -> three c
14921487 2 -> two c mempty
14931488 1 -> one c mempty
1494− _ -> return (return $ B.str cs)
1489+ _ -> return $ B.str cs
14951490
14961491ender :: Char -> Int -> MarkdownParser ()
14971492ender c n = try $ do
@@ -1504,74 +1499,74 @@ ender c n = try $ do
15041499-- If one c, emit emph and then parse two.
15051500-- If two cs, emit strong and then parse one.
15061501-- Otherwise, emit ccc then the results.
1507−three :: Char -> MarkdownParser (F Inlines)
1502+three :: Char -> MarkdownParser Inlines
15081503three c = do
15091504 contents <- mconcat <$> many (notFollowedBy (ender c 1) >> inline)
1510− (ender c 3 >> return ((B.strong . B.emph) <$> contents))
1511− <|> (ender c 2 >> one c (B.strong <$> contents))
1512− <|> (ender c 1 >> two c (B.emph <$> contents))
1513− <|> return (return (B.str [c,c,c]) <> contents)
1505+ (ender c 3 >> return ((B.strong . B.emph) contents))
1506+ <|> (ender c 2 >> one c (B.strong contents))
1507+ <|> (ender c 1 >> two c (B.emph contents))
1508+ <|> return (B.str [c,c,c] <> contents)
15141509
15151510-- Parse inlines til you hit two c's, and emit strong.
15161511-- If you never do hit two cs, emit ** plus inlines parsed.
1517−two :: Char -> F Inlines -> MarkdownParser (F Inlines)
1512+two :: Char -> Inlines -> MarkdownParser Inlines
15181513two c prefix' = do
15191514 contents <- mconcat <$> many (try $ notFollowedBy (ender c 2) >> inline)
1520− (ender c 2 >> return (B.strong <$> (prefix' <> contents)))
1521− <|> return (return (B.str [c,c]) <> (prefix' <> contents))
1515+ (ender c 2 >> return (B.strong (prefix' <> contents)))
1516+ <|> return (B.str [c,c] <> (prefix' <> contents))
15221517
15231518-- Parse inlines til you hit a c, and emit emph.
15241519-- If you never hit a c, emit * plus inlines parsed.
1525−one :: Char -> F Inlines -> MarkdownParser (F Inlines)
1520+one :: Char -> Inlines -> MarkdownParser Inlines
15261521one c prefix' = do
15271522 contents <- mconcat <$> many ( (notFollowedBy (ender c 1) >> inline)
15281523 <|> try (string [c,c] >>
15291524 notFollowedBy (ender c 1) >>
15301525 two c mempty) )
1531− (ender c 1 >> return (B.emph <$> (prefix' <> contents)))
1532− <|> return (return (B.str [c]) <> (prefix' <> contents))
1526+ (ender c 1 >> return (B.emph (prefix' <> contents)))
1527+ <|> return (B.str [c] <> (prefix' <> contents))
15331528
1534−strongOrEmph :: MarkdownParser (F Inlines)
1529+strongOrEmph :: MarkdownParser Inlines
15351530strongOrEmph = enclosure '*' <|> enclosure '_'
15361531
1537−-- | Parses a list of inlines between start and end delimiters.
1532+-- | Parses a list oInlines between start and end delimiters.
15381533inlinesBetween :: (Show b)
15391534 => MarkdownParser a
15401535 -> MarkdownParser b
1541− -> MarkdownParser (F Inlines)
1536+ -> MarkdownParser Inlines
15421537inlinesBetween start end =
1543− (trimInlinesF . mconcat) <$> try (start >> many1Till inner end)
1538+ (trimInlines . mconcat) <$> try (start >> many1Till inner end)
15441539 where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline)
15451540 innerSpace = try $ whitespace <* notFollowedBy' end
15461541
1547−strikeout :: MarkdownParser (F Inlines)
1548−strikeout = fmap B.strikeout <$>
1542+strikeout :: MarkdownParser Inlines
1543+strikeout = B.strikeout <$>
15491544 (guardEnabled Ext_strikeout >> inlinesBetween strikeStart strikeEnd)
15501545 where strikeStart = string "~~" >> lookAhead nonspaceChar
15511546 >> notFollowedBy (char '~')
15521547 strikeEnd = try $ string "~~"
15531548
1554−superscript :: MarkdownParser (F Inlines)
1555−superscript = fmap B.superscript <$> try (do
1549+superscript :: MarkdownParser Inlines
1550+superscript = B.superscript <$> try (do
15561551 guardEnabled Ext_superscript
15571552 char '^'
15581553 mconcat <$> many1Till (notFollowedBy spaceChar >> inline) (char '^'))
15591554
1560−subscript :: MarkdownParser (F Inlines)
1561−subscript = fmap B.subscript <$> try (do
1555+subscript :: MarkdownParser Inlines
1556+subscript = B.subscript <$> try (do
15621557 guardEnabled Ext_subscript
15631558 char '~'
15641559 mconcat <$> many1Till (notFollowedBy spaceChar >> inline) (char '~'))
15651560
1566−whitespace :: MarkdownParser (F Inlines)
1567−whitespace = spaceChar >> return <$> (lb <|> regsp) <?> "whitespace"
1561+whitespace :: MarkdownParser Inlines
1562+whitespace = spaceChar >> (lb <|> regsp) <?> "whitespace"
15681563 where lb = spaceChar >> skipMany spaceChar >> option B.space (endline >> return B.linebreak)
15691564 regsp = skipMany spaceChar >> return B.space
15701565
1571−nonEndline :: Parser [Char] st Char
1566+nonEndline :: Monad m => ParserT [Char] st m Char
15721567nonEndline = satisfy (/='\n')
15731568
1574−str :: MarkdownParser (F Inlines)
1569+str :: MarkdownParser Inlines
15751570str = do
15761571 result <- many1 alphaNum
15771572 updateLastStrPos
@@ -1579,14 +1574,14 @@ str = do
15791574 isSmart <- getOption readerSmart
15801575 if isSmart
15811576 then case likelyAbbrev result of
1582− [] -> return $ return $ B.str result
1577+ [] -> return $ B.str result
15831578 xs -> choice (map (\x ->
15841579 try (string x >> oneOf " \n" >>
15851580 lookAhead alphaNum >>
1586− return (return $ B.str
1587− $ result ++ spacesToNbr x ++ "\160"))) xs)
1588− <|> (return $ return $ B.str result)
1589− else return $ return $ B.str result
1581+ return (B.str $
1582+ result ++ spacesToNbr x ++ "\160"))) xs)
1583+ <|> (return $ B.str result)
1584+ else return $ B.str result
15901585
15911586-- | if the string matches the beginning of an abbreviation (before
15921587-- the first period, return strings that would finish the abbreviation.
@@ -1601,7 +1596,7 @@ likelyAbbrev x =
16011596 in map snd $ filter (\(y,_) -> y == x) abbrPairs
16021597
16031598-- an endline character that can be treated as a space, not a structural break
1604−endline :: MarkdownParser (F Inlines)
1599+endline :: MarkdownParser Inlines
16051600endline = try $ do
16061601 newline
16071602 notFollowedBy blankline
@@ -1614,18 +1609,18 @@ endline = try $ do
16141609 notFollowedBy (() <$ (lookAhead (char '`') >> codeBlockFenced))
16151610 notFollowedByHtmlCloser
16161611 (eof >> return mempty)
1617− <|> (guardEnabled Ext_hard_line_breaks >> return (return B.linebreak))
1612+ <|> (guardEnabled Ext_hard_line_breaks >> return B.linebreak)
16181613 <|> (guardEnabled Ext_ignore_line_breaks >> return mempty)
1619− <|> (return $ return B.space)
1614+ <|> return B.space
16201615
16211616--
16221617-- links
16231618--
16241619
16251620-- a reference label for a link
1626−reference :: MarkdownParser (F Inlines, String)
1621+reference :: MarkdownParser (Inlines, String)
16271622reference = do notFollowedBy' (string "[^") -- footnote reference
1628− withRaw $ trimInlinesF <$> inlinesInBalancedBrackets
1623+ withRaw $ trimInlines <$> inlinesInBalancedBrackets
16291624
16301625parenthesizedChars :: MarkdownParser [Char]
16311626parenthesizedChars = do
@@ -1653,7 +1648,7 @@ source = do
16531648linkTitle :: MarkdownParser String
16541649linkTitle = quotedTitle '"' <|> quotedTitle '\''
16551650
1656−link :: MarkdownParser (F Inlines)
1651+link :: MarkdownParser Inlines
16571652link = try $ do
16581653 st <- getState
16591654 guard $ stateAllowLinks st
@@ -1663,14 +1658,14 @@ link = try $ do
16631658 regLink B.link lab <|> referenceLink B.link (lab,raw)
16641659
16651660regLink :: (String -> String -> Inlines -> Inlines)
1666− -> F Inlines -> MarkdownParser (F Inlines)
1661+ -> Inlines -> MarkdownParser Inlines
16671662regLink constructor lab = try $ do
16681663 (src, tit) <- source
1669− return $ constructor src tit <$> lab
1664+ return $ constructor src tit lab
16701665
16711666-- a link like [this][ref] or [this][] or [this]
16721667referenceLink :: (String -> String -> Inlines -> Inlines)
1673− -> (F Inlines, String) -> MarkdownParser (F Inlines)
1668+ -> (Inlines, String) -> MarkdownParser Inlines
16741669referenceLink constructor (lab, raw) = do
16751670 sp <- (True <$ lookAhead (char ' ')) <|> return False
16761671 (ref,raw') <- option (mempty, "") $
@@ -1684,24 +1679,22 @@ referenceLink constructor (lab, raw) = do
16841679 fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw
16851680 implicitHeaderRefs <- option False $
16861681 True <$ guardEnabled Ext_implicit_header_references
1687− let makeFallback = do
1688− parsedRaw' <- parsedRaw
1689− fallback' <- fallback
1690− return $ B.str "[" <> fallback' <> B.str "]" <>
1682+ let makeFallback =
1683+ B.str "[" <> fallback <> B.str "]" <>
16911684 (if sp && not (null raw) then B.space else mempty) <>
1692− parsedRaw'
1693− return $ do
1694− keys <- asksF stateKeys
1695− case M.lookup key keys of
1696− Nothing -> do
1697− headers <- asksF stateHeaders
1698− ref' <- if labIsRef then lab else ref
1699− if implicitHeaderRefs
1700− then case M.lookup ref' headers of
1701− Just ident -> constructor ('#':ident) "" <$> lab
1702− Nothing -> makeFallback
1703− else makeFallback
1704− Just (src,tit) -> constructor src tit <$> lab
1685+ parsedRaw
1686+ keys <- asks stateKeys
1687+ headers <- asks stateHeaders
1688+ return $
1689+ case M.lookup key keys of
1690+ Nothing ->
1691+ let ref' = if labIsRef then lab else ref in
1692+ if implicitHeaderRefs
1693+ then case M.lookup ref' headers of
1694+ Just ident -> constructor ('#':ident) "" lab
1695+ Nothing -> makeFallback
1696+ else makeFallback
1697+ Just (src,tit) -> constructor src tit lab
17051698
17061699dropBrackets :: String -> String
17071700dropBrackets = reverse . dropRB . reverse . dropLB
@@ -1710,14 +1703,14 @@ dropBrackets = reverse . dropRB . reverse . dropLB
17101703 dropLB ('[':xs) = xs
17111704 dropLB xs = xs
17121705
1713−bareURL :: MarkdownParser (F Inlines)
1706+bareURL :: MarkdownParser Inlines
17141707bareURL = try $ do
17151708 guardEnabled Ext_autolink_bare_uris
17161709 (orig, src) <- uri <|> emailAddress
17171710 notFollowedBy $ try $ spaces >> htmlTag (~== TagClose "a")
1718− return $ return $ B.link src "" (B.str orig)
1711+ return $ B.link src "" (B.str orig)
17191712
1720−autoLink :: MarkdownParser (F Inlines)
1713+autoLink :: MarkdownParser Inlines
17211714autoLink = try $ do
17221715 char '<'
17231716 (orig, src) <- uri <|> emailAddress
@@ -1726,9 +1719,9 @@ autoLink = try $ do
17261719 -- final punctuation. for example: in `<http://hi---there>`,
17271720 -- the URI parser will stop before the dashes.
17281721 extra <- fromEntities <$> manyTill nonspaceChar (char '>')
1729− return $ return $ B.link (src ++ escapeURI extra) "" (B.str $ orig ++ extra)
1722+ return $ B.link (src ++ escapeURI extra) "" (B.str $ orig ++ extra)
17301723
1731−image :: MarkdownParser (F Inlines)
1724+image :: MarkdownParser Inlines
17321725image = try $ do
17331726 char '!'
17341727 (lab,raw) <- reference
@@ -1738,38 +1731,33 @@ image = try $ do
17381731 _ -> B.image src
17391732 regLink constructor lab <|> referenceLink constructor (lab,raw)
17401733
1741−note :: MarkdownParser (F Inlines)
1734+note :: MarkdownParser Inlines
17421735note = try $ do
17431736 guardEnabled Ext_footnotes
1737+ (stateInFootnote <$> getState) >>= guard . not
17441738 ref <- noteMarker
1745− return $ do
1746− notes <- asksF stateNotes'
1739+ notes <- asks stateNotes'
1740+ return $
17471741 case lookup ref notes of
1748− Nothing -> return $ B.str $ "[^" ++ ref ++ "]"
1749− Just contents -> do
1750− st <- askF
1751− -- process the note in a context that doesn't resolve
1752− -- notes, to avoid infinite looping with notes inside
1753− -- notes:
1754− let contents' = runF contents st{ stateNotes' = [] }
1755− return $ B.note contents'
1756−
1757−inlineNote :: MarkdownParser (F Inlines)
1742+ Nothing -> B.str $ "[^" ++ ref ++ "]"
1743+ Just contents -> B.note contents
1744+
1745+inlineNote :: MarkdownParser Inlines
17581746inlineNote = try $ do
17591747 guardEnabled Ext_inline_notes
17601748 char '^'
17611749 contents <- inlinesInBalancedBrackets
1762− return $ B.note . B.para <$> contents
1750+ return . B.note . B.para $ contents
17631751
1764−rawLaTeXInline' :: MarkdownParser (F Inlines)
1752+rawLaTeXInline' :: MarkdownParser Inlines
17651753rawLaTeXInline' = try $ do
17661754 guardEnabled Ext_raw_tex
17671755 lookAhead $ char '\\' >> notFollowedBy' (string "start") -- context env
1768− RawInline _ s <- rawLaTeXInline
1769− return $ return $ B.rawInline "tex" s
1756+ RawInline _ s <- generalize rawLaTeXInline
1757+ return $ B.rawInline "tex" s
17701758 -- "tex" because it might be context or latex
17711759
1772−rawConTeXtEnvironment :: Parser [Char] st String
1760+rawConTeXtEnvironment :: Monad m => ParserT [Char] st m String
17731761rawConTeXtEnvironment = try $ do
17741762 string "\\start"
17751763 completion <- inBrackets (letter <|> digit <|> spaceChar)
@@ -1778,14 +1766,14 @@ rawConTeXtEnvironment = try $ do
17781766 (try $ string "\\stop" >> string completion)
17791767 return $ "\\start" ++ completion ++ concat contents ++ "\\stop" ++ completion
17801768
1781−inBrackets :: (Parser [Char] st Char) -> Parser [Char] st String
1769+inBrackets :: Monad m => (ParserT [Char] st m Char) -> ParserT [Char] st m String
17821770inBrackets parser = do
17831771 char '['
17841772 contents <- many parser
17851773 char ']'
17861774 return $ "[" ++ contents ++ "]"
17871775
1788−spanHtml :: MarkdownParser (F Inlines)
1776+spanHtml :: MarkdownParser Inlines
17891777spanHtml = try $ do
17901778 guardEnabled Ext_native_spans
17911779 (TagOpen _ attrs, _) <- htmlTag (~== TagOpen "span" [])
@@ -1797,10 +1785,10 @@ spanHtml = try $ do
17971785 Just s | null ident && null classes &&
17981786 map toLower (filter (`notElem` " \t;") s) ==
17991787 "font-variant:small-caps"
1800− -> return $ B.smallcaps <$> contents
1801− _ -> return $ B.spanWith (ident, classes, keyvals) <$> contents
1788+ -> return $ B.smallcaps contents
1789+ _ -> return $ B.spanWith (ident, classes, keyvals) contents
18021790
1803−divHtml :: MarkdownParser (F Blocks)
1791+divHtml :: MarkdownParser Blocks
18041792divHtml = try $ do
18051793 guardEnabled Ext_native_divs
18061794 (TagOpen _ attrs, rawtag) <- htmlTag (~== TagOpen "div" [])
@@ -1818,11 +1806,11 @@ divHtml = try $ do
18181806 let ident = fromMaybe "" $ lookup "id" attrs
18191807 let classes = maybe [] words $ lookup "class" attrs
18201808 let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]
1821− return $ B.divWith (ident, classes, keyvals) <$> contents
1809+ return $ B.divWith (ident, classes, keyvals) contents
18221810 else -- avoid backtracing
1823− return $ return (B.rawBlock "html" (rawtag <> bls)) <> contents
1811+ return $ B.rawBlock "html" (rawtag <> bls) <> contents
18241812
1825−rawHtmlInline :: MarkdownParser (F Inlines)
1813+rawHtmlInline :: MarkdownParser Inlines
18261814rawHtmlInline = do
18271815 guardEnabled Ext_raw_html
18281816 inHtmlBlock <- stateInHtmlBlock <$> getState
@@ -1837,19 +1825,17 @@ rawHtmlInline = do
18371825 then (\x -> isInlineTag x &&
18381826 not (isCloseBlockTag x))
18391827 else not . isTextTag
1840− return $ return $ B.rawInline "html" result
1828+ return $ B.rawInline "html" result
18411829
18421830-- Citations
18431831
1844−cite :: MarkdownParser (F Inlines)
1832+cite :: MarkdownParser Inlines
18451833cite = do
18461834 guardEnabled Ext_citations
1847− citations <- textualCite
1848− <|> do (cs, raw) <- withRaw normalCite
1849− return $ (flip B.cite (B.text raw)) <$> cs
1850− return citations
1835+ textualCite <|> do (cs, raw) <- withRaw normalCite
1836+ return $ B.cite cs (B.text raw)
18511837
1852−textualCite :: MarkdownParser (F Inlines)
1838+textualCite :: MarkdownParser Inlines
18531839textualCite = try $ do
18541840 (_, key) <- citeKey
18551841 let first = Citation{ citationId = key
@@ -1863,29 +1849,26 @@ textualCite = try $ do
18631849 case mbrest of
18641850 Just (rest, raw) ->
18651851 return $ (flip B.cite (B.text $ '@':key ++ " " ++ raw) . (first:))
1866− <$> rest
1852+ rest
18671853 Nothing ->
18681854 (do (cs, raw) <- withRaw $ bareloc first
1869− return $ (flip B.cite (B.text $ '@':key ++ " " ++ raw)) <$> cs)
1870− <|> return (do st <- askF
1871− return $ case M.lookup key (stateExamples st) of
1872− Just n -> B.str (show n)
1873− _ -> B.cite [first] $ B.str $ '@':key)
1855+ return $ B.cite cs (B.text $ '@':key ++ " " ++ raw))
1856+ <|> do st <- ask
1857+ return $ case M.lookup key (stateExamples st) of
1858+ Just n -> B.str (show n)
1859+ _ -> B.cite [first] $ B.str $ '@':key
18741860
1875−bareloc :: Citation -> MarkdownParser (F [Citation])
1861+bareloc :: Citation -> MarkdownParser [Citation]
18761862bareloc c = try $ do
18771863 spnl
18781864 char '['
18791865 suff <- suffix
1880− rest <- option (return []) $ try $ char ';' >> citeList
1866+ rest <- option [] $ try $ char ';' >> citeList
18811867 spnl
18821868 char ']'
1883− return $ do
1884− suff' <- suff
1885− rest' <- rest
1886− return $ c{ citationSuffix = B.toList suff' } : rest'
1869+ return $ c{ citationSuffix = B.toList suff } : rest
18871870
1888−normalCite :: MarkdownParser (F [Citation])
1871+normalCite :: MarkdownParser [Citation]
18891872normalCite = try $ do
18901873 char '['
18911874 spnl
@@ -1894,60 +1877,57 @@ normalCite = try $ do
18941877 char ']'
18951878 return citations
18961879
1897−suffix :: MarkdownParser (F Inlines)
1880+suffix :: MarkdownParser Inlines
18981881suffix = try $ do
18991882 hasSpace <- option False (notFollowedBy nonspaceChar >> return True)
19001883 spnl
1901− rest <- trimInlinesF . mconcat <$> many (notFollowedBy (oneOf ";]") >> inline)
1884+ rest <- trimInlines . mconcat <$> many (notFollowedBy (oneOf ";]") >> inline)
19021885 return $ if hasSpace
1903− then (B.space <>) <$> rest
1886+ then B.space <> rest
19041887 else rest
19051888
1906−prefix :: MarkdownParser (F Inlines)
1907−prefix = trimInlinesF . mconcat <$>
1889+prefix :: MarkdownParser Inlines
1890+prefix = trimInlines . mconcat <$>
19081891 manyTill inline (char ']' <|> liftM (const ']') (lookAhead citeKey))
19091892
1910−citeList :: MarkdownParser (F [Citation])
1911−citeList = fmap sequence $ sepBy1 citation (try $ char ';' >> spnl)
1893+citeList :: MarkdownParser [Citation]
1894+citeList = sepBy1 citation (try $ char ';' >> spnl)
19121895
1913−citation :: MarkdownParser (F Citation)
1896+citation :: MarkdownParser Citation
19141897citation = try $ do
19151898 pref <- prefix
19161899 (suppress_author, key) <- citeKey
19171900 suff <- suffix
1918− return $ do
1919− x <- pref
1920− y <- suff
1921− return $ Citation{ citationId = key
1922− , citationPrefix = B.toList x
1923− , citationSuffix = B.toList y
1924− , citationMode = if suppress_author
1925− then SuppressAuthor
1926− else NormalCitation
1927− , citationNoteNum = 0
1928− , citationHash = 0
1929− }
1930−
1931−smart :: MarkdownParser (F Inlines)
1901+ return Citation{ citationId = key
1902+ , citationPrefix = B.toList pref
1903+ , citationSuffix = B.toList suff
1904+ , citationMode = if suppress_author
1905+ then SuppressAuthor
1906+ else NormalCitation
1907+ , citationNoteNum = 0
1908+ , citationHash = 0
1909+ }
1910+
1911+smart :: MarkdownParser Inlines
19321912smart = do
19331913 getOption readerSmart >>= guard
19341914 doubleQuoted <|> singleQuoted <|>
1935− choice (map (return <$>) [apostrophe, dash, ellipses])
1915+ choice [apostrophe, dash, ellipses]
19361916
1937−singleQuoted :: MarkdownParser (F Inlines)
1917+singleQuoted :: MarkdownParser Inlines
19381918singleQuoted = try $ do
19391919 singleQuoteStart
19401920 withQuoteContext InSingleQuote $
1941− fmap B.singleQuoted . trimInlinesF . mconcat <$>
1921+ B.singleQuoted . trimInlines . mconcat <$>
19421922 many1Till inline singleQuoteEnd
19431923
19441924-- doubleQuoted will handle regular double-quoted sections, as well
19451925-- as dialogues with an open double-quote without a close double-quote
19461926-- in the same paragraph.
1947−doubleQuoted :: MarkdownParser (F Inlines)
1927+doubleQuoted :: MarkdownParser Inlines
19481928doubleQuoted = try $ do
19491929 doubleQuoteStart
19501930 contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)
1951− (withQuoteContext InDoubleQuote $ doubleQuoteEnd >> return
1952− (fmap B.doubleQuoted . trimInlinesF $ contents))
1953− <|> (return $ return (B.str "\8220") <> contents)
1931+ (withQuoteContext InDoubleQuote doubleQuoteEnd >> return
1932+ (B.doubleQuoted . trimInlines $ contents))
1933+ <|> return (B.str "\8220" <> contents)