@@ -57,6 +57,7 @@ import Text.Pandoc.Readers.HTML ( htmlTag, htmlInBalanced, isInlineTag, isBlockT
5757import Data.Monoid (mconcat, mempty)
5858import 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,36 @@ 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+
85+retState :: MarkdownParser a -> MarkdownParser (a, ParserState)
86+retState p = do
87+ r <- p
88+ s <- getState
89+ return (r, s)
90+
91+runMarkdown :: ReaderOptions -> String -> MarkdownParser a -> a
92+runMarkdown opts inp p = fst res
93+ where
94+ imd = readWithM (retState p) def{ stateOptions = opts } (inp ++ "\n\n")
95+ res = runReader imd s
96+ s :: ParserState
97+ s = snd $ runReader imd s
8698
8799--
88100-- Constants and data structure definitions
@@ -119,10 +131,10 @@ inList = do
119131 ctx <- stateParserContext <$> getState
120132 guard (ctx == ListItemState)
121133
122−isNull :: F Inlines -> Bool
123−isNull ils = B.isNull $ runF ils def
134+isNull :: Inlines -> Bool
135+isNull ils = B.isNull ils
124136
125−spnl :: Parser [Char] st ()
137+spnl :: Monad m => ParserT [Char] st m ()
126138spnl = try $ do
127139 skipSpaces
128140 optional newline
@@ -162,9 +174,9 @@ litChar = escapedChar'
162174
163175-- | Parse a sequence of inline elements between square brackets,
164176-- including inlines between balanced pairs of square brackets.
165−inlinesInBalancedBrackets :: MarkdownParser (F Inlines)
177+inlinesInBalancedBrackets :: MarkdownParser Inlines
166178inlinesInBalancedBrackets = charsInBalancedBrackets >>=
167− parseFromString (trimInlinesF . mconcat <$> many inline)
179+ parseFromString (trimInlines . mconcat <$> many inline)
168180
169181charsInBalancedBrackets :: MarkdownParser [Char]
170182charsInBalancedBrackets = do
@@ -181,16 +193,16 @@ charsInBalancedBrackets = do
181193-- document structure
182194--
183195
184−titleLine :: MarkdownParser (F Inlines)
196+titleLine :: MarkdownParser Inlines
185197titleLine = try $ do
186198 char '%'
187199 skipSpaces
188200 res <- many $ (notFollowedBy newline >> inline)
189201 <|> try (endline >> whitespace)
190202 newline
191− return $ trimInlinesF $ mconcat res
203+ return $ trimInlines $ mconcat res
192204
193−authorsLine :: MarkdownParser (F [Inlines])
205+authorsLine :: MarkdownParser [Inlines]
194206authorsLine = try $ do
195207 char '%'
196208 skipSpaces
@@ -199,13 +211,13 @@ authorsLine = try $ do
199211 (char ';' <|>
200212 try (newline >> notFollowedBy blankline >> spaceChar))
201213 newline
202− return $ sequence $ filter (not . isNull) $ map (trimInlinesF . mconcat) authors
214+ return $ filter (not . isNull) $ map (trimInlines . mconcat) authors
203215
204−dateLine :: MarkdownParser (F Inlines)
216+dateLine :: MarkdownParser Inlines
205217dateLine = try $ do
206218 char '%'
207219 skipSpaces
208− trimInlinesF . mconcat <$> manyTill inline newline
220+ trimInlines . mconcat <$> manyTill inline newline
209221
210222titleBlock :: MarkdownParser ()
211223titleBlock = pandocTitleBlock <|> mmdTitleBlock
@@ -215,20 +227,16 @@ pandocTitleBlock = try $ do
215227 guardEnabled Ext_pandoc_title_block
216228 lookAhead (char '%')
217229 title <- option mempty titleLine
218− author <- option (return []) authorsLine
230+ author <- option [] authorsLine
219231 date <- option mempty dateLine
220232 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)
233+ let meta' = (if B.isNull title then id else B.setMeta "title" title)
234+ . (if null author then id else B.setMeta "author" author)
235+ . (if B.isNull date then id else B.setMeta "date" date)
236+ $ nullMeta
237+ updateState $ \st -> st{ stateMeta = stateMeta st <> meta' }
238+
239+yamlMetaBlock :: MarkdownParser (Blocks)
232240yamlMetaBlock = try $ do
233241 guardEnabled Ext_yaml_metadata_block
234242 pos <- getPosition
@@ -241,17 +249,17 @@ yamlMetaBlock = try $ do
241249 optional blanklines
242250 opts <- stateOptions <$> getState
243251 meta' <- case Yaml.decodeEither' $ UTF8.fromString rawYaml of
244− Right (Yaml.Object hashmap) -> return $ return $
252+ Right (Yaml.Object hashmap) -> return $
245253 H.foldrWithKey (\k v m ->
246254 if ignorable k
247255 then m
248256 else B.setMeta (T.unpack k)
249257 (yamlToMeta opts v) m)
250258 nullMeta hashmap
251− Right Yaml.Null -> return $ return nullMeta
259+ Right Yaml.Null -> return nullMeta
252260 Right _ -> do
253261 addWarning (Just pos) "YAML header is not an object"
254− return $ return nullMeta
262+ return nullMeta
255263 Left err' -> do
256264 case err' of
257265 InvalidYaml (Just YamlParseException{
@@ -270,8 +278,8 @@ yamlMetaBlock = try $ do
270278 _ -> addWarning (Just pos)
271279 $ "Could not parse YAML header: " ++
272280 show err'
273− return $ return nullMeta
274− updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }
281+ return nullMeta
282+ updateState $ \st -> st{ stateMeta = stateMeta st <> meta' }
275283 return mempty
276284
277285-- ignore fields ending with _
@@ -314,8 +322,8 @@ mmdTitleBlock = try $ do
314322 guardEnabled Ext_mmd_title_block
315323 kvPairs <- many1 kvPair
316324 blanklines
317− updateState $ \st -> st{ stateMeta' = stateMeta' st <>
318− return (Meta $ M.fromList kvPairs) }
325+ updateState $ \st -> st{ stateMeta = stateMeta st <>
326+ (Meta $ M.fromList kvPairs) }
319327
320328kvPair :: MarkdownParser (String, MetaValue)
321329kvPair = try $ do
@@ -335,11 +343,11 @@ parseMarkdown = do
335343 optional titleBlock
336344 blocks <- parseBlocks
337345 st <- getState
338− let meta = runF (stateMeta' st) st
339− let Pandoc _ bs = B.doc $ runF blocks st
346+ let meta = stateMeta st
347+ let Pandoc _ bs = B.doc blocks
340348 return $ Pandoc meta bs
341349
342−referenceKey :: MarkdownParser (F Blocks)
350+referenceKey :: MarkdownParser (Blocks)
343351referenceKey = try $ do
344352 pos <- getPosition
345353 skipNonindentSpaces
@@ -366,7 +374,7 @@ referenceKey = try $ do
366374 Just _ -> addWarning (Just pos) $ "Duplicate link reference `" ++ raw ++ "'"
367375 Nothing -> return ()
368376 updateState $ \s -> s { stateKeys = M.insert key target oldkeys }
369− return $ return mempty
377+ return mempty
370378
371379referenceTitle :: MarkdownParser String
372380referenceTitle = try $ do
@@ -386,7 +394,7 @@ quotedTitle c = try $ do
386394-- | PHP Markdown Extra style abbreviation key. Currently
387395-- we just skip them, since Pandoc doesn't have an element for
388396-- an abbreviation.
389−abbrevKey :: MarkdownParser (F Blocks)
397+abbrevKey :: MarkdownParser (Blocks)
390398abbrevKey = do
391399 guardEnabled Ext_abbreviations
392400 try $ do
@@ -395,7 +403,7 @@ abbrevKey = do
395403 char ':'
396404 skipMany (satisfy (/= '\n'))
397405 blanklines
398− return $ return mempty
406+ return mempty
399407
400408noteMarker :: MarkdownParser String
401409noteMarker = string "[^" >> many1Till (satisfy $ not . isBlank) (char ']')
@@ -413,7 +421,7 @@ rawLines = do
413421 rest <- many rawLine
414422 return $ unlines (first:rest)
415423
416−noteBlock :: MarkdownParser (F Blocks)
424+noteBlock :: MarkdownParser (Blocks)
417425noteBlock = try $ do
418426 pos <- getPosition
419427 skipNonindentSpaces
@@ -425,7 +433,7 @@ noteBlock = try $ do
425433 rest <- many $ try $ blanklines >> indentSpaces >> rawLines
426434 let raw = unlines (first:rest) ++ "\n"
427435 optional blanklines
428− parsed <- parseFromString parseBlocks raw
436+ parsed <- parseFromString (inFootnote parseBlocks) raw
429437 let newnote = (ref, parsed)
430438 oldnotes <- stateNotes' <$> getState
431439 case lookup ref oldnotes of
@@ -434,14 +442,22 @@ noteBlock = try $ do
434442 updateState $ \s -> s { stateNotes' = newnote : oldnotes }
435443 return mempty
436444
445+inFootnote :: MarkdownParser a -> MarkdownParser a
446+inFootnote p = do
447+ st <- stateInFootnote <$> getState
448+ updateState (\s -> s { stateInFootnote = True } )
449+ r <- p
450+ updateState (\s -> s { stateInFootnote = st } )
451+ return r
452+
437453--
438454-- parsing blocks
439455--
440456
441−parseBlocks :: MarkdownParser (F Blocks)
457+parseBlocks :: MarkdownParser (Blocks)
442458parseBlocks = mconcat <$> manyTill block eof
443459
444−block :: MarkdownParser (F Blocks)
460+block :: MarkdownParser (Blocks)
445461block = do
446462 tr <- getOption readerTrace
447463 pos <- getPosition
@@ -457,7 +473,7 @@ block = do
457473 , htmlBlock
458474 , table
459475 , codeBlockIndented
460− , guardEnabled Ext_latex_macros *> (macro >>= return . return)
476+ , guardEnabled Ext_latex_macros *> macro
461477 , rawTeXBlock
462478 , lineBlock
463479 , blockQuote
@@ -471,28 +487,27 @@ block = do
471487 , plain
472488 ] <?> "block"
473489 when tr $ do
474− st <- getState
475490 trace (printf "line %d: %s" (sourceLine pos)
476− (take 60 $ show $ B.toList $ runF res st)) (return ())
491+ (take 60 $ show $ B.toList $ res)) (return ())
477492 return res
478493
479494--
480495-- header blocks
481496--
482497
483−header :: MarkdownParser (F Blocks)
498+header :: MarkdownParser (Blocks)
484499header = setextHeader <|> atxHeader <?> "header"
485500
486−atxHeader :: MarkdownParser (F Blocks)
501+atxHeader :: MarkdownParser Blocks
487502atxHeader = try $ do
488503 level <- many1 (char '#') >>= return . length
489504 notFollowedBy $ guardEnabled Ext_fancy_lists >>
490505 (char '.' <|> char ')') -- this would be a list
491506 skipSpaces
492− text <- trimInlinesF . mconcat <$> many (notFollowedBy atxClosing >> inline)
507+ text <- trimInlines . mconcat <$> many (notFollowedBy atxClosing >> inline)
493508 attr <- atxClosing
494− attr' <- registerHeader attr (runF text defaultParserState)
495− return $ B.headerWith attr' level <$> text
509+ attr' <- registerHeader attr text
510+ return $ B.headerWith attr' level text
496511
497512atxClosing :: MarkdownParser Attr
498513atxClosing = try $ do
@@ -519,25 +534,25 @@ mmdHeaderIdentifier = do
519534 skipSpaces
520535 return (ident,[],[])
521536
522−setextHeader :: MarkdownParser (F Blocks)
537+setextHeader :: MarkdownParser Blocks
523538setextHeader = try $ do
524539 -- This lookahead prevents us from wasting time parsing Inlines
525540 -- unless necessary -- it gives a significant performance boost.
526541 lookAhead $ anyLine >> many1 (oneOf setextHChars) >> blankline
527− text <- trimInlinesF . mconcat <$> many1 (notFollowedBy setextHeaderEnd >> inline)
542+ text <- trimInlines . mconcat <$> many1 (notFollowedBy setextHeaderEnd >> inline)
528543 attr <- setextHeaderEnd
529544 underlineChar <- oneOf setextHChars
530545 many (char underlineChar)
531546 blanklines
532547 let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1
533− attr' <- registerHeader attr (runF text defaultParserState)
534− return $ B.headerWith attr' level <$> text
548+ attr' <- registerHeader attr text
549+ return $ B.headerWith attr' level text
535550
536551--
537552-- hrule block
538553--
539554
540−hrule :: Parser [Char] st (F Blocks)
555+hrule :: Monad m => ParserT [Char] st m Blocks
541556hrule = try $ do
542557 skipSpaces
543558 start <- satisfy isHruleChar
@@ -545,7 +560,7 @@ hrule = try $ do
545560 skipMany (spaceChar <|> char start)
546561 newline
547562 optional blanklines
548− return $ return B.horizontalRule
563+ return B.horizontalRule
549564
550565--
551566-- code blocks
@@ -554,9 +569,10 @@ hrule = try $ do
554569indentedLine :: MarkdownParser String
555570indentedLine = indentSpaces >> anyLine >>= return . (++ "\n")
556571
557−blockDelimiter :: (Char -> Bool)
572+blockDelimiter :: Monad m
573+ => (Char -> Bool)
558574 -> Maybe Int
559− -> Parser [Char] st Int
575+ -> ParserT [Char] st m Int
560576blockDelimiter f len = try $ do
561577 c <- lookAhead (satisfy f)
562578 case len of
@@ -607,7 +623,7 @@ specialAttr = do
607623 char '-'
608624 return $ \(id',cs,kvs) -> (id',cs ++ ["unnumbered"],kvs)
609625
610−codeBlockFenced :: MarkdownParser (F Blocks)
626+codeBlockFenced :: MarkdownParser Blocks
611627codeBlockFenced = try $ do
612628 c <- try (guardEnabled Ext_fenced_code_blocks >> lookAhead (char '~'))
613629 <|> (guardEnabled Ext_backtick_code_blocks >> lookAhead (char '`'))
@@ -619,7 +635,7 @@ codeBlockFenced = try $ do
619635 blankline
620636 contents <- manyTill anyLine (blockDelimiter (== c) (Just size))
621637 blanklines
622− return $ return $ B.codeBlockWith attr $ intercalate "\n" contents
638+ return $ B.codeBlockWith attr $ intercalate "\n" contents
623639
624640-- correctly handle github language identifiers
625641toLanguageId :: String -> String
@@ -628,7 +644,7 @@ toLanguageId = map toLower . go
628644 go "objective-c" = "objectivec"
629645 go x = x
630646
631−codeBlockIndented :: MarkdownParser (F Blocks)
647+codeBlockIndented :: MarkdownParser (Blocks)
632648codeBlockIndented = do
633649 contents <- many1 (indentedLine <|>
634650 try (do b <- blanklines
@@ -636,15 +652,15 @@ codeBlockIndented = do
636652 return $ b ++ l))
637653 optional blanklines
638654 classes <- getOption readerIndentedCodeClasses
639− return $ return $ B.codeBlockWith ("", classes, []) $
655+ return $ B.codeBlockWith ("", classes, []) $
640656 stripTrailingNewlines $ concat contents
641657
642−lhsCodeBlock :: MarkdownParser (F Blocks)
658+lhsCodeBlock :: MarkdownParser (Blocks)
643659lhsCodeBlock = do
644660 guardEnabled Ext_literate_haskell
645− (return . B.codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
661+ (B.codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
646662 (lhsCodeBlockBird <|> lhsCodeBlockLaTeX))
647− <|> (return . B.codeBlockWith ("",["sourceCode","haskell"],[]) <$>
663+ <|> (B.codeBlockWith ("",["sourceCode","haskell"],[]) <$>
648664 lhsCodeBlockInverseBird)
649665
650666lhsCodeBlockLaTeX :: MarkdownParser String
@@ -673,7 +689,7 @@ lhsCodeBlockBirdWith c = try $ do
673689 blanklines
674690 return $ intercalate "\n" lns'
675691
676−birdTrackLine :: Char -> Parser [Char] st String
692+birdTrackLine :: Monad m => Char -> ParserT [Char] st m String
677693birdTrackLine c = try $ do
678694 char c
679695 -- allow html tags on left margin:
@@ -701,12 +717,12 @@ emailBlockQuote = try $ do
701717 optional blanklines
702718 return raw
703719
704−blockQuote :: MarkdownParser (F Blocks)
720+blockQuote :: MarkdownParser (Blocks)
705721blockQuote = do
706722 raw <- emailBlockQuote
707723 -- parse the extracted block, which may contain various block elements:
708724 contents <- parseFromString parseBlocks $ (intercalate "\n" raw) ++ "\n\n"
709− return $ B.blockQuote <$> contents
725+ return $ B.blockQuote contents
710726
711727--
712728-- list blocks
@@ -804,7 +820,7 @@ listContinuationLine = try $ do
804820 return $ result ++ "\n"
805821
806822listItem :: MarkdownParser a
807− -> MarkdownParser (F Blocks)
823+ -> MarkdownParser (Blocks)
808824listItem start = try $ do
809825 first <- rawListItem start
810826 continuations <- many listContinuation
@@ -820,14 +836,14 @@ listItem start = try $ do
820836 updateState (\st -> st {stateParserContext = oldContext})
821837 return contents
822838
823−orderedList :: MarkdownParser (F Blocks)
839+orderedList :: MarkdownParser Blocks
824840orderedList = try $ do
825841 (start, style, delim) <- lookAhead anyOrderedListStart
826842 unless (style `elem` [DefaultStyle, Decimal, Example] &&
827843 delim `elem` [DefaultDelim, Period]) $
828844 guardEnabled Ext_fancy_lists
829845 when (style == Example) $ guardEnabled Ext_example_lists
830− items <- fmap sequence $ many1 $ listItem
846+ items <- many1 $ listItem
831847 ( try $ do
832848 optional newline -- if preceded by Plain block in a list
833849 startpos <- sourceColumn <$> getPosition
@@ -839,12 +855,12 @@ orderedList = try $ do
839855 atMostSpaces (tabStop - (endpos - startpos))
840856 return res )
841857 start' <- option 1 $ guardEnabled Ext_startnum >> return start
842− return $ B.orderedListWith (start', style, delim) <$> fmap compactify' items
858+ return $ B.orderedListWith (start', style, delim) (compactify' items)
843859
844−bulletList :: MarkdownParser (F Blocks)
860+bulletList :: MarkdownParser (Blocks)
845861bulletList = do
846− items <- fmap sequence $ many1 $ listItem bulletListStart
847− return $ B.bulletList <$> fmap compactify' items
862+ items <- many1 $ listItem bulletListStart
863+ return $ B.bulletList (compactify' items)
848864
849865-- definition lists
850866
@@ -859,14 +875,14 @@ defListMarker = do
859875 else mzero
860876 return ()
861877
862−definitionListItem :: Bool -> MarkdownParser (F (Inlines, [Blocks]))
878+definitionListItem :: Bool -> MarkdownParser (Inlines, [Blocks])
863879definitionListItem compact = try $ do
864880 rawLine' <- anyLine
865881 raw <- many1 $ defRawBlock compact
866− term <- parseFromString (trimInlinesF . mconcat <$> many inline) rawLine'
882+ term <- parseFromString (trimInlines . mconcat <$> many inline) rawLine'
867883 contents <- mapM (parseFromString parseBlocks) raw
868884 optional blanklines
869− return $ liftM2 (,) term (sequence contents)
885+ return $ (term, contents)
870886
871887defRawBlock :: Bool -> MarkdownParser String
872888defRawBlock compact = try $ do
@@ -889,32 +905,32 @@ defRawBlock compact = try $ do
889905 return $ trimr (firstline ++ "\n" ++ unlines rawlines ++ cont) ++
890906 if hasBlank || not (null cont) then "\n\n" else ""
891907
892−definitionList :: MarkdownParser (F Blocks)
908+definitionList :: MarkdownParser (Blocks)
893909definitionList = try $ do
894910 lookAhead (anyLine >> optional blankline >> defListMarker)
895911 compactDefinitionList <|> normalDefinitionList
896912
897−compactDefinitionList :: MarkdownParser (F Blocks)
913+compactDefinitionList :: MarkdownParser (Blocks)
898914compactDefinitionList = do
899915 guardEnabled Ext_compact_definition_lists
900− items <- fmap sequence $ many1 $ definitionListItem True
901− return $ B.definitionList <$> fmap compactify'DL items
916+ items <- many1 $ definitionListItem True
917+ return $ B.definitionList (compactify'DL items)
902918
903−normalDefinitionList :: MarkdownParser (F Blocks)
919+normalDefinitionList :: MarkdownParser (Blocks)
904920normalDefinitionList = do
905921 guardEnabled Ext_definition_lists
906− items <- fmap sequence $ many1 $ definitionListItem False
907− return $ B.definitionList <$> items
922+ items <- many1 $ definitionListItem False
923+ return $ B.definitionList items
908924
909925--
910926-- paragraph block
911927--
912928
913−para :: MarkdownParser (F Blocks)
929+para :: MarkdownParser Blocks
914930para = try $ do
915931 exts <- getOption readerExtensions
916− result <- trimInlinesF . mconcat <$> many1 inline
917− option (B.plain <$> result)
932+ result <- trimInlines . mconcat <$> many1 inline
933+ option (B.plain result)
918934 $ try $ do
919935 newline
920936 (blanklines >> return mempty)
@@ -932,17 +948,16 @@ para = try $ do
932948 lookAhead (htmlTag (~== TagClose "div"))
933949 _ -> mzero
934950 return $ do
935− result' <- result
936− case B.toList result' of
951+ case B.toList result of
937952 [Image alt (src,tit)]
938953 | Ext_implicit_figures `Set.member` exts ->
939954 -- the fig: at beginning of title indicates a figure
940− return $ B.para $ B.singleton
955+ B.para $ B.singleton
941956 $ Image alt (src,'f':'i':'g':':':tit)
942− _ -> return $ B.para result'
957+ _ -> B.para result
943958
944−plain :: MarkdownParser (F Blocks)
945−plain = fmap B.plain . trimInlinesF . mconcat <$> many1 inline
959+plain :: MarkdownParser (Blocks)
960+plain = B.plain . trimInlines . mconcat <$> many1 inline
946961
947962--
948963-- raw html
@@ -953,13 +968,13 @@ htmlElement = rawVerbatimBlock
953968 <|> strictHtmlBlock
954969 <|> liftM snd (htmlTag isBlockTag)
955970
956−htmlBlock :: MarkdownParser (F Blocks)
971+htmlBlock :: MarkdownParser (Blocks)
957972htmlBlock = do
958973 guardEnabled Ext_raw_html
959974 try (do
960975 (TagOpen t attrs) <- lookAhead $ fst <$> htmlTag isBlockTag
961976 (guard (t `elem` ["pre","style","script"]) >>
962− (return . B.rawBlock "html") <$> rawVerbatimBlock)
977+ (B.rawBlock "html") <$> rawVerbatimBlock)
963978 <|> (do guardEnabled Ext_markdown_attribute
964979 oldMarkdownAttribute <- stateMarkdownAttribute <$> getState
965980 markdownAttribute <-
@@ -978,12 +993,12 @@ htmlBlock = do
978993 <|> (guardEnabled Ext_markdown_in_html_blocks >> rawHtmlBlocks))
979994 <|> htmlBlock'
980995
981−htmlBlock' :: MarkdownParser (F Blocks)
996+htmlBlock' :: MarkdownParser (Blocks)
982997htmlBlock' = try $ do
983998 first <- htmlElement
984999 skipMany spaceChar
9851000 optional blanklines
986− return $ return $ B.rawBlock "html" first
1001+ return $ B.rawBlock "html" first
9871002
9881003strictHtmlBlock :: MarkdownParser String
9891004strictHtmlBlock = htmlInBalanced (not . isInlineTag)
@@ -996,17 +1011,17 @@ rawVerbatimBlock = try $ do
9961011 contents <- manyTill anyChar (htmlTag (~== TagClose tag))
9971012 return $ open ++ contents ++ renderTags' [TagClose tag]
9981013
999−rawTeXBlock :: MarkdownParser (F Blocks)
1014+rawTeXBlock :: MarkdownParser (Blocks)
10001015rawTeXBlock = do
10011016 guardEnabled Ext_raw_tex
10021017 result <- (B.rawBlock "latex" . concat <$>
1003− rawLaTeXBlock `sepEndBy1` blankline)
1018+ (generalize rawLaTeXBlock) `sepEndBy1` blankline)
10041019 <|> (B.rawBlock "context" . concat <$>
10051020 rawConTeXtEnvironment `sepEndBy1` blankline)
10061021 spaces
1007− return $ return result
1022+ return result
10081023
1009−rawHtmlBlocks :: MarkdownParser (F Blocks)
1024+rawHtmlBlocks :: MarkdownParser (Blocks)
10101025rawHtmlBlocks = do
10111026 (TagOpen tagtype _, raw) <- htmlTag isBlockTag
10121027 -- try to find closing tag
@@ -1018,10 +1033,10 @@ rawHtmlBlocks = do
10181033 contents <- mconcat <$> many (notFollowedBy' closer >> block)
10191034 result <-
10201035 (closer >>= \(_, rawcloser) -> return (
1021− return (B.rawBlock "html" $ stripMarkdownAttribute raw) <>
1036+ (B.rawBlock "html" $ stripMarkdownAttribute raw) <>
10221037 contents <>
1023− return (B.rawBlock "html" rawcloser)))
1024− <|> return (return (B.rawBlock "html" raw) <> contents)
1038+ (B.rawBlock "html" rawcloser)))
1039+ <|> return ((B.rawBlock "html" raw) <> contents)
10251040 updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock }
10261041 return result
10271042
@@ -1036,12 +1051,12 @@ stripMarkdownAttribute s = renderTags' $ map filterAttrib $ parseTags s
10361051-- line block
10371052--
10381053
1039−lineBlock :: MarkdownParser (F Blocks)
1054+lineBlock :: MarkdownParser (Blocks)
10401055lineBlock = try $ do
10411056 guardEnabled Ext_line_blocks
10421057 lines' <- lineBlockLines >>=
1043− mapM (parseFromString (trimInlinesF . mconcat <$> many inline))
1044− return $ B.para <$> (mconcat $ intersperse (return B.linebreak) lines')
1058+ mapM (parseFromString (trimInlines . mconcat <$> many inline))
1059+ return $ B.para (mconcat $ intersperse B.linebreak lines')
10451060
10461061--
10471062-- Tables
@@ -1049,8 +1064,8 @@ lineBlock = try $ do
10491064
10501065-- Parse a dashed line with optional trailing spaces; return its length
10511066-- and the length including trailing space.
1052−dashedLine :: Char
1053− -> Parser [Char] st (Int, Int)
1067+dashedLine :: Monad m => Char
1068+ -> ParserT [Char] st m (Int, Int)
10541069dashedLine ch = do
10551070 dashes <- many1 (char ch)
10561071 sp <- many spaceChar
@@ -1059,7 +1074,7 @@ dashedLine ch = do
10591074-- Parse a table header with dashed lines of '-' preceded by
10601075-- one (or zero) line of text.
10611076simpleTableHeader :: Bool -- ^ Headerless table
1062− -> MarkdownParser (F [Blocks], [Alignment], [Int])
1077+ -> MarkdownParser ([Blocks], [Alignment], [Int])
10631078simpleTableHeader headless = try $ do
10641079 rawContent <- if headless
10651080 then return ""
@@ -1078,8 +1093,8 @@ simpleTableHeader headless = try $ do
10781093 let rawHeads' = if headless
10791094 then replicate (length dashes) ""
10801095 else rawHeads
1081− heads <- fmap sequence
1082− $ mapM (parseFromString (mconcat <$> many plain))
1096+ heads <-
1097+ mapM (parseFromString (mconcat <$> many plain))
10831098 $ map trim rawHeads'
10841099 return (heads, aligns, indices)
10851100
@@ -1121,30 +1136,30 @@ rawTableLine indices = do
11211136
11221137-- Parse a table line and return a list of lists of blocks (columns).
11231138tableLine :: [Int]
1124− -> MarkdownParser (F [Blocks])
1139+ -> MarkdownParser [Blocks]
11251140tableLine indices = rawTableLine indices >>=
1126− fmap sequence . mapM (parseFromString (mconcat <$> many plain))
1141+ mapM (parseFromString (mconcat <$> many plain))
11271142
11281143-- Parse a multiline table row and return a list of blocks (columns).
11291144multilineRow :: [Int]
1130− -> MarkdownParser (F [Blocks])
1145+ -> MarkdownParser [Blocks]
11311146multilineRow indices = do
11321147 colLines <- many1 (rawTableLine indices)
11331148 let cols = map unlines $ transpose colLines
1134− fmap sequence $ mapM (parseFromString (mconcat <$> many plain)) cols
1149+ mapM (parseFromString (mconcat <$> many plain)) cols
11351150
11361151-- Parses a table caption: inlines beginning with 'Table:'
11371152-- and followed by blank lines.
1138−tableCaption :: MarkdownParser (F Inlines)
1153+tableCaption :: MarkdownParser Inlines
11391154tableCaption = try $ do
11401155 guardEnabled Ext_table_captions
11411156 skipNonindentSpaces
11421157 string ":" <|> string "Table:"
1143− trimInlinesF . mconcat <$> many1 inline <* blanklines
1158+ trimInlines . mconcat <$> many1 inline <* blanklines
11441159
11451160-- Parse a simple table with '---' header and one line per row.
11461161simpleTable :: Bool -- ^ Headerless table
1147− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])
1162+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])
11481163simpleTable headless = do
11491164 (aligns, _widths, heads', lines') <-
11501165 tableWith (simpleTableHeader headless) tableLine
@@ -1158,12 +1173,12 @@ simpleTable headless = do
11581173-- which may be multiline, separated by blank lines, and
11591174-- ending with a footer (dashed line followed by blank line).
11601175multilineTable :: Bool -- ^ Headerless table
1161− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])
1176+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])
11621177multilineTable headless =
11631178 tableWith (multilineTableHeader headless) multilineRow blanklines tableFooter
11641179
11651180multilineTableHeader :: Bool -- ^ Headerless table
1166− -> MarkdownParser (F [Blocks], [Alignment], [Int])
1181+ -> MarkdownParser ([Blocks], [Alignment], [Int])
11671182multilineTableHeader headless = try $ do
11681183 unless headless $
11691184 tableSep >> notFollowedBy blankline
@@ -1185,7 +1200,7 @@ multilineTableHeader headless = try $ do
11851200 let rawHeads = if headless
11861201 then replicate (length dashes) ""
11871202 else map (unlines . map trim) rawHeadsList
1188− heads <- fmap sequence $
1203+ heads <-
11891204 mapM (parseFromString (mconcat <$> many plain)) $
11901205 map trim rawHeads
11911206 return (heads, aligns, indices)
@@ -1195,7 +1210,7 @@ multilineTableHeader headless = try $ do
11951210-- which may be grid, separated by blank lines, and
11961211-- ending with a footer (dashed line followed by blank line).
11971212gridTable :: Bool -- ^ Headerless table
1198− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])
1213+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])
11991214gridTable headless =
12001215 tableWith (gridTableHeader headless) gridTableRow
12011216 (gridTableSep '-') gridTableFooter
@@ -1204,13 +1219,13 @@ gridTableSplitLine :: [Int] -> String -> [String]
12041219gridTableSplitLine indices line = map removeFinalBar $ tail $
12051220 splitStringByIndices (init indices) $ trimr line
12061221
1207−gridPart :: Char -> Parser [Char] st (Int, Int)
1222+gridPart :: Monad m => Char -> ParserT [Char] st m (Int, Int)
12081223gridPart ch = do
12091224 dashes <- many1 (char ch)
12101225 char '+'
12111226 return (length dashes, length dashes + 1)
12121227
1213−gridDashedLines :: Char -> Parser [Char] st [(Int,Int)]
1228+gridDashedLines :: Monad m => Char -> ParserT [Char] st m [(Int,Int)]
12141229gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline
12151230
12161231removeFinalBar :: String -> String
@@ -1223,7 +1238,7 @@ gridTableSep ch = try $ gridDashedLines ch >> return '\n'
12231238
12241239-- | Parse header for a grid table.
12251240gridTableHeader :: Bool -- ^ Headerless table
1226− -> MarkdownParser (F [Blocks], [Alignment], [Int])
1241+ -> MarkdownParser ([Blocks], [Alignment], [Int])
12271242gridTableHeader headless = try $ do
12281243 optional blanklines
12291244 dashes <- gridDashedLines '-'
@@ -1243,7 +1258,7 @@ gridTableHeader headless = try $ do
12431258 then replicate (length dashes) ""
12441259 else map (unlines . map trim) $ transpose
12451260 $ map (gridTableSplitLine indices) rawContent
1246− heads <- fmap sequence $ mapM (parseFromString parseBlocks . trim) rawHeads
1261+ heads <- mapM (parseFromString parseBlocks . trim) rawHeads
12471262 return (heads, aligns, indices)
12481263
12491264gridTableRawLine :: [Int] -> MarkdownParser [String]
@@ -1254,12 +1269,12 @@ gridTableRawLine indices = do
12541269
12551270-- | Parse row of grid table.
12561271gridTableRow :: [Int]
1257− -> MarkdownParser (F [Blocks])
1272+ -> MarkdownParser [Blocks]
12581273gridTableRow indices = do
12591274 colLines <- many1 (gridTableRawLine indices)
12601275 let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $
12611276 transpose colLines
1262− fmap compactify' <$> fmap sequence (mapM (parseFromString parseBlocks) cols)
1277+ compactify' <$> (mapM (parseFromString parseBlocks) cols)
12631278
12641279removeOneLeadingSpace :: [String] -> [String]
12651280removeOneLeadingSpace xs =
@@ -1285,11 +1300,9 @@ pipeBreak = try $ do
12851300 blankline
12861301 return (first:rest)
12871302
1288−pipeTable :: MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])
1303+pipeTable :: MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])
12891304pipeTable = try $ do
1290− (heads,aligns) <- pipeTableRow >>= \row ->
1291− pipeBreak >>= \als ->
1292− return (row, als)
1305+ (heads,aligns) <- (,) <$> pipeTableRow <*> pipeBreak
12931306 lines' <- sequence <$> many1 pipeTableRow
12941307 let widths = replicate (length aligns) 0.0
12951308 return $ (aligns, widths, heads, lines')
@@ -1300,7 +1313,7 @@ sepPipe = try $ do
13001313 notFollowedBy blankline
13011314
13021315-- parse a row, also returning probable alignments for org-table cells
1303−pipeTableRow :: MarkdownParser (F [Blocks])
1316+pipeTableRow :: MarkdownParser [Blocks]
13041317pipeTableRow = do
13051318 nonindentSpaces
13061319 openPipe <- (True <$ char '|') <|> return False
@@ -1312,16 +1325,14 @@ pipeTableRow = do
13121325 guard $ not (null rest && not openPipe)
13131326 optional (char '|')
13141327 blankline
1315− let cells = sequence (first:rest)
1316− return $ do
1317− cells' <- cells
1318− return $ map
1319− (\ils ->
1328+ let cells = first:rest
1329+ return $
1330+ map (\ils ->
13201331 case trimInlines ils of
13211332 ils' | B.isNull ils' -> mempty
1322− | otherwise -> B.plain $ ils') cells'
1333+ | otherwise -> B.plain $ ils') cells
13231334
1324−pipeTableHeaderPart :: Parser [Char] st Alignment
1335+pipeTableHeaderPart :: Monad m => ParserT [Char] st m Alignment
13251336pipeTableHeaderPart = try $ do
13261337 skipMany spaceChar
13271338 left <- optionMaybe (char ':')
@@ -1336,7 +1347,7 @@ pipeTableHeaderPart = try $ do
13361347 (Just _,Just _) -> AlignCenter
13371348
13381349-- Succeed only if current line contains a pipe.
1339−scanForPipe :: Parser [Char] st ()
1350+scanForPipe :: Monad m => ParserT [Char] st m ()
13401351scanForPipe = do
13411352 inp <- getInput
13421353 case break (\c -> c == '\n' || c == '|') inp of
@@ -1346,14 +1357,14 @@ scanForPipe = do
13461357-- | Parse a table using 'headerParser', 'rowParser',
13471358-- 'lineParser', and 'footerParser'. Variant of the version in
13481359-- Text.Pandoc.Parsing.
1349−tableWith :: MarkdownParser (F [Blocks], [Alignment], [Int])
1350− -> ([Int] -> MarkdownParser (F [Blocks]))
1360+tableWith :: MarkdownParser ([Blocks], [Alignment], [Int])
1361+ -> ([Int] -> MarkdownParser [Blocks])
13511362 -> MarkdownParser sep
13521363 -> MarkdownParser end
1353− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])
1364+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])
13541365tableWith headerParser rowParser lineParser footerParser = try $ do
13551366 (heads, aligns, indices) <- headerParser
1356− lines' <- fmap sequence $ rowParser indices `sepEndBy1` lineParser
1367+ lines' <- rowParser indices `sepEndBy1` lineParser
13571368 footerParser
13581369 numColumns <- getOption readerColumns
13591370 let widths = if (indices == [])
@@ -1361,7 +1372,7 @@ tableWith headerParser rowParser lineParser footerParser = try $ do
13611372 else widthsFromIndices numColumns indices
13621373 return $ (aligns, widths, heads, lines')
13631374
1364−table :: MarkdownParser (F Blocks)
1375+table :: MarkdownParser Blocks
13651376table = try $ do
13661377 frontCaption <- option Nothing (Just <$> tableCaption)
13671378 (aligns, widths, heads, lns) <-
@@ -1376,19 +1387,15 @@ table = try $ do
13761387 (gridTable False <|> gridTable True)) <?> "table"
13771388 optional blanklines
13781389 caption <- case frontCaption of
1379− Nothing -> option (return mempty) tableCaption
1390+ Nothing -> option mempty tableCaption
13801391 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'
1392+ return $ B.table caption (zip aligns widths) heads lns
13861393
13871394--
13881395-- inline
13891396--
13901397
1391−inline :: MarkdownParser (F Inlines)
1398+inline :: MarkdownParser Inlines
13921399inline = choice [ whitespace
13931400 , bareURL
13941401 , str
@@ -1411,7 +1418,7 @@ inline = choice [ whitespace
14111418 , rawLaTeXInline'
14121419 , exampleRef
14131420 , smart
1414− , return . B.singleton <$> charRef
1421+ , B.singleton <$> charRef
14151422 , symbol
14161423 , ltSign
14171424 ] <?> "inline"
@@ -1422,43 +1429,42 @@ escapedChar' = try $ do
14221429 (guardEnabled Ext_all_symbols_escapable >> satisfy (not . isAlphaNum))
14231430 <|> oneOf "\\`*_{}[]()>#+-.!~\""
14241431
1425−escapedChar :: MarkdownParser (F Inlines)
1432+escapedChar :: MarkdownParser Inlines
14261433escapedChar = do
14271434 result <- escapedChar'
14281435 case result of
1429− ' ' -> return $ return $ B.str "\160" -- "\ " is a nonbreaking space
1436+ ' ' -> return $ B.str "\160" -- "\ " is a nonbreaking space
14301437 '\n' -> guardEnabled Ext_escaped_line_breaks >>
1431− return (return B.linebreak) -- "\[newline]" is a linebreak
1432− _ -> return $ return $ B.str [result]
1438+ return B.linebreak -- "\[newline]" is a linebreak
1439+ _ -> return $ B.str [result]
14331440
1434−ltSign :: MarkdownParser (F Inlines)
1441+ltSign :: MarkdownParser Inlines
14351442ltSign = do
14361443 guardDisabled Ext_raw_html
14371444 <|> (notFollowedByHtmlCloser >> notFollowedBy' (htmlTag isBlockTag))
14381445 char '<'
1439− return $ return $ B.str "<"
1446+ return $ B.str "<"
14401447
1441−exampleRef :: MarkdownParser (F Inlines)
1448+exampleRef :: MarkdownParser Inlines
14421449exampleRef = try $ do
14431450 guardEnabled Ext_example_lists
14441451 char '@'
14451452 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)
1453+ st <- ask
1454+ return $ case M.lookup lab (stateExamples st) of
1455+ Just n -> B.str (show n)
1456+ Nothing -> B.str ('@':lab)
14511457
1452−symbol :: MarkdownParser (F Inlines)
1458+symbol :: MarkdownParser Inlines
14531459symbol = do
14541460 result <- noneOf "<\\\n\t "
14551461 <|> try (do lookAhead $ char '\\'
14561462 notFollowedBy' (() <$ rawTeXBlock)
14571463 char '\\')
1458− return $ return $ B.str [result]
1464+ return $ B.str [result]
14591465
14601466-- parses inline code, between n `s and n `s
1461−code :: MarkdownParser (F Inlines)
1467+code :: MarkdownParser Inlines
14621468code = try $ do
14631469 starts <- many1 (char '`')
14641470 skipSpaces
@@ -1468,16 +1474,16 @@ code = try $ do
14681474 notFollowedBy (char '`')))
14691475 attr <- option ([],[],[]) (try $ guardEnabled Ext_inline_code_attributes >>
14701476 optional whitespace >> attributes)
1471− return $ return $ B.codeWith attr $ trim $ concat result
1477+ return $ B.codeWith attr $ trim $ concat result
14721478
1473−math :: MarkdownParser (F Inlines)
1474−math = (return . B.displayMath <$> (mathDisplay >>= applyMacros'))
1475− <|> (return . B.math <$> (mathInline >>= applyMacros'))
1479+math :: MarkdownParser Inlines
1480+math = (B.displayMath <$> (mathDisplay >>= applyMacros'))
1481+ <|> (B.math <$> (mathInline >>= applyMacros'))
14761482
14771483-- Parses material enclosed in *s, **s, _s, or __s.
14781484-- Designed to avoid backtracking.
14791485enclosure :: Char
1480− -> MarkdownParser (F Inlines)
1486+ -> MarkdownParser Inlines
14811487enclosure c = do
14821488 -- we can't start an enclosure with _ if after a string and
14831489 -- the intraword_underscores extension is enabled:
@@ -1485,13 +1491,13 @@ enclosure c = do
14851491 <|> guard (c == '*')
14861492 <|> (guard =<< notAfterString)
14871493 cs <- many1 (char c)
1488− (return (B.str cs) <>) <$> whitespace
1494+ ((B.str cs) <>) <$> whitespace
14891495 <|> do
14901496 case length cs of
14911497 3 -> three c
14921498 2 -> two c mempty
14931499 1 -> one c mempty
1494− _ -> return (return $ B.str cs)
1500+ _ -> return $ B.str cs
14951501
14961502ender :: Char -> Int -> MarkdownParser ()
14971503ender c n = try $ do
@@ -1504,74 +1510,74 @@ ender c n = try $ do
15041510-- If one c, emit emph and then parse two.
15051511-- If two cs, emit strong and then parse one.
15061512-- Otherwise, emit ccc then the results.
1507−three :: Char -> MarkdownParser (F Inlines)
1513+three :: Char -> MarkdownParser Inlines
15081514three c = do
15091515 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)
1516+ (ender c 3 >> return ((B.strong . B.emph) contents))
1517+ <|> (ender c 2 >> one c (B.strong contents))
1518+ <|> (ender c 1 >> two c (B.emph contents))
1519+ <|> return ((B.str [c,c,c]) <> contents)
15141520
15151521-- Parse inlines til you hit two c's, and emit strong.
15161522-- If you never do hit two cs, emit ** plus inlines parsed.
1517−two :: Char -> F Inlines -> MarkdownParser (F Inlines)
1523+two :: Char -> Inlines -> MarkdownParser Inlines
15181524two c prefix' = do
15191525 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))
1526+ (ender c 2 >> return (B.strong (prefix' <> contents)))
1527+ <|> return ((B.str [c,c]) <> (prefix' <> contents))
15221528
15231529-- Parse inlines til you hit a c, and emit emph.
15241530-- If you never hit a c, emit * plus inlines parsed.
1525−one :: Char -> F Inlines -> MarkdownParser (F Inlines)
1531+one :: Char -> Inlines -> MarkdownParser Inlines
15261532one c prefix' = do
15271533 contents <- mconcat <$> many ( (notFollowedBy (ender c 1) >> inline)
15281534 <|> try (string [c,c] >>
15291535 notFollowedBy (ender c 1) >>
15301536 two c mempty) )
1531− (ender c 1 >> return (B.emph <$> (prefix' <> contents)))
1532− <|> return (return (B.str [c]) <> (prefix' <> contents))
1537+ (ender c 1 >> return (B.emph (prefix' <> contents)))
1538+ <|> return ((B.str [c]) <> (prefix' <> contents))
15331539
1534−strongOrEmph :: MarkdownParser (F Inlines)
1540+strongOrEmph :: MarkdownParser Inlines
15351541strongOrEmph = enclosure '*' <|> enclosure '_'
15361542
1537−-- | Parses a list of inlines between start and end delimiters.
1543+-- | Parses a list oInlines between start and end delimiters.
15381544inlinesBetween :: (Show b)
15391545 => MarkdownParser a
15401546 -> MarkdownParser b
1541− -> MarkdownParser (F Inlines)
1547+ -> MarkdownParser Inlines
15421548inlinesBetween start end =
1543− (trimInlinesF . mconcat) <$> try (start >> many1Till inner end)
1549+ (trimInlines . mconcat) <$> try (start >> many1Till inner end)
15441550 where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline)
15451551 innerSpace = try $ whitespace <* notFollowedBy' end
15461552
1547−strikeout :: MarkdownParser (F Inlines)
1548−strikeout = fmap B.strikeout <$>
1553+strikeout :: MarkdownParser Inlines
1554+strikeout = B.strikeout <$>
15491555 (guardEnabled Ext_strikeout >> inlinesBetween strikeStart strikeEnd)
15501556 where strikeStart = string "~~" >> lookAhead nonspaceChar
15511557 >> notFollowedBy (char '~')
15521558 strikeEnd = try $ string "~~"
15531559
1554−superscript :: MarkdownParser (F Inlines)
1555−superscript = fmap B.superscript <$> try (do
1560+superscript :: MarkdownParser Inlines
1561+superscript = B.superscript <$> try (do
15561562 guardEnabled Ext_superscript
15571563 char '^'
15581564 mconcat <$> many1Till (notFollowedBy spaceChar >> inline) (char '^'))
15591565
1560−subscript :: MarkdownParser (F Inlines)
1561−subscript = fmap B.subscript <$> try (do
1566+subscript :: MarkdownParser Inlines
1567+subscript = B.subscript <$> try (do
15621568 guardEnabled Ext_subscript
15631569 char '~'
15641570 mconcat <$> many1Till (notFollowedBy spaceChar >> inline) (char '~'))
15651571
1566−whitespace :: MarkdownParser (F Inlines)
1567−whitespace = spaceChar >> return <$> (lb <|> regsp) <?> "whitespace"
1572+whitespace :: MarkdownParser Inlines
1573+whitespace = spaceChar >> (lb <|> regsp) <?> "whitespace"
15681574 where lb = spaceChar >> skipMany spaceChar >> option B.space (endline >> return B.linebreak)
15691575 regsp = skipMany spaceChar >> return B.space
15701576
1571−nonEndline :: Parser [Char] st Char
1577+nonEndline :: Monad m => ParserT [Char] st m Char
15721578nonEndline = satisfy (/='\n')
15731579
1574−str :: MarkdownParser (F Inlines)
1580+str :: MarkdownParser Inlines
15751581str = do
15761582 result <- many1 alphaNum
15771583 updateLastStrPos
@@ -1579,14 +1585,14 @@ str = do
15791585 isSmart <- getOption readerSmart
15801586 if isSmart
15811587 then case likelyAbbrev result of
1582− [] -> return $ return $ B.str result
1588+ [] -> return $ B.str result
15831589 xs -> choice (map (\x ->
15841590 try (string x >> oneOf " \n" >>
15851591 lookAhead alphaNum >>
1586− return (return $ B.str
1592+ return (B.str
15871593 $ result ++ spacesToNbr x ++ "\160"))) xs)
1588− <|> (return $ return $ B.str result)
1589− else return $ return $ B.str result
1594+ <|> (return $ B.str result)
1595+ else return $ B.str result
15901596
15911597-- | if the string matches the beginning of an abbreviation (before
15921598-- the first period, return strings that would finish the abbreviation.
@@ -1601,7 +1607,7 @@ likelyAbbrev x =
16011607 in map snd $ filter (\(y,_) -> y == x) abbrPairs
16021608
16031609-- an endline character that can be treated as a space, not a structural break
1604−endline :: MarkdownParser (F Inlines)
1610+endline :: MarkdownParser Inlines
16051611endline = try $ do
16061612 newline
16071613 notFollowedBy blankline
@@ -1614,18 +1620,18 @@ endline = try $ do
16141620 notFollowedBy (() <$ (lookAhead (char '`') >> codeBlockFenced))
16151621 notFollowedByHtmlCloser
16161622 (eof >> return mempty)
1617− <|> (guardEnabled Ext_hard_line_breaks >> return (return B.linebreak))
1623+ <|> (guardEnabled Ext_hard_line_breaks >> return B.linebreak)
16181624 <|> (guardEnabled Ext_ignore_line_breaks >> return mempty)
1619− <|> (return $ return B.space)
1625+ <|> (return B.space)
16201626
16211627--
16221628-- links
16231629--
16241630
16251631-- a reference label for a link
1626−reference :: MarkdownParser (F Inlines, String)
1632+reference :: MarkdownParser (Inlines, String)
16271633reference = do notFollowedBy' (string "[^") -- footnote reference
1628− withRaw $ trimInlinesF <$> inlinesInBalancedBrackets
1634+ withRaw $ trimInlines <$> inlinesInBalancedBrackets
16291635
16301636parenthesizedChars :: MarkdownParser [Char]
16311637parenthesizedChars = do
@@ -1653,7 +1659,7 @@ source = do
16531659linkTitle :: MarkdownParser String
16541660linkTitle = quotedTitle '"' <|> quotedTitle '\''
16551661
1656−link :: MarkdownParser (F Inlines)
1662+link :: MarkdownParser Inlines
16571663link = try $ do
16581664 st <- getState
16591665 guard $ stateAllowLinks st
@@ -1663,14 +1669,14 @@ link = try $ do
16631669 regLink B.link lab <|> referenceLink B.link (lab,raw)
16641670
16651671regLink :: (String -> String -> Inlines -> Inlines)
1666− -> F Inlines -> MarkdownParser (F Inlines)
1672+ -> Inlines -> MarkdownParser Inlines
16671673regLink constructor lab = try $ do
16681674 (src, tit) <- source
1669− return $ constructor src tit <$> lab
1675+ return $ constructor src tit lab
16701676
16711677-- a link like [this][ref] or [this][] or [this]
16721678referenceLink :: (String -> String -> Inlines -> Inlines)
1673− -> (F Inlines, String) -> MarkdownParser (F Inlines)
1679+ -> (Inlines, String) -> MarkdownParser Inlines
16741680referenceLink constructor (lab, raw) = do
16751681 sp <- (True <$ lookAhead (char ' ')) <|> return False
16761682 (ref,raw') <- option (mempty, "") $
@@ -1684,24 +1690,22 @@ referenceLink constructor (lab, raw) = do
16841690 fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw
16851691 implicitHeaderRefs <- option False $
16861692 True <$ guardEnabled Ext_implicit_header_references
1687− let makeFallback = do
1688− parsedRaw' <- parsedRaw
1689− fallback' <- fallback
1690− return $ B.str "[" <> fallback' <> B.str "]" <>
1693+ let makeFallback =
1694+ B.str "[" <> fallback <> B.str "]" <>
16911695 (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
1696+ parsedRaw
1697+ keys <- asks stateKeys
1698+ headers <- asks stateHeaders
1699+ return $
1700+ case M.lookup key keys of
1701+ Nothing ->
1702+ let ref' = if labIsRef then lab else ref in
1703+ if implicitHeaderRefs
1704+ then case M.lookup ref' headers of
1705+ Just ident -> constructor ('#':ident) "" lab
1706+ Nothing -> makeFallback
1707+ else makeFallback
1708+ Just (src,tit) -> constructor src tit lab
17051709
17061710dropBrackets :: String -> String
17071711dropBrackets = reverse . dropRB . reverse . dropLB
@@ -1710,14 +1714,14 @@ dropBrackets = reverse . dropRB . reverse . dropLB
17101714 dropLB ('[':xs) = xs
17111715 dropLB xs = xs
17121716
1713−bareURL :: MarkdownParser (F Inlines)
1717+bareURL :: MarkdownParser Inlines
17141718bareURL = try $ do
17151719 guardEnabled Ext_autolink_bare_uris
17161720 (orig, src) <- uri <|> emailAddress
17171721 notFollowedBy $ try $ spaces >> htmlTag (~== TagClose "a")
1718− return $ return $ B.link src "" (B.str orig)
1722+ return $ B.link src "" (B.str orig)
17191723
1720−autoLink :: MarkdownParser (F Inlines)
1724+autoLink :: MarkdownParser Inlines
17211725autoLink = try $ do
17221726 char '<'
17231727 (orig, src) <- uri <|> emailAddress
@@ -1726,9 +1730,9 @@ autoLink = try $ do
17261730 -- final punctuation. for example: in `<http://hi---there>`,
17271731 -- the URI parser will stop before the dashes.
17281732 extra <- fromEntities <$> manyTill nonspaceChar (char '>')
1729− return $ return $ B.link (src ++ escapeURI extra) "" (B.str $ orig ++ extra)
1733+ return $ B.link (src ++ escapeURI extra) "" (B.str $ orig ++ extra)
17301734
1731−image :: MarkdownParser (F Inlines)
1735+image :: MarkdownParser Inlines
17321736image = try $ do
17331737 char '!'
17341738 (lab,raw) <- reference
@@ -1738,38 +1742,33 @@ image = try $ do
17381742 _ -> B.image src
17391743 regLink constructor lab <|> referenceLink constructor (lab,raw)
17401744
1741−note :: MarkdownParser (F Inlines)
1745+note :: MarkdownParser Inlines
17421746note = try $ do
17431747 guardEnabled Ext_footnotes
1748+ (stateInFootnote <$> getState) >>= guard . not
17441749 ref <- noteMarker
1745− return $ do
1746− notes <- asksF stateNotes'
1750+ notes <- asks stateNotes'
1751+ return $
17471752 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)
1753+ Nothing -> B.str $ "[^" ++ ref ++ "]"
1754+ Just contents -> B.note contents
1755+
1756+inlineNote :: MarkdownParser Inlines
17581757inlineNote = try $ do
17591758 guardEnabled Ext_inline_notes
17601759 char '^'
17611760 contents <- inlinesInBalancedBrackets
1762− return $ B.note . B.para <$> contents
1761+ return . B.note . B.para $ contents
17631762
1764−rawLaTeXInline' :: MarkdownParser (F Inlines)
1763+rawLaTeXInline' :: MarkdownParser Inlines
17651764rawLaTeXInline' = try $ do
17661765 guardEnabled Ext_raw_tex
17671766 lookAhead $ char '\\' >> notFollowedBy' (string "start") -- context env
1768− RawInline _ s <- rawLaTeXInline
1769− return $ return $ B.rawInline "tex" s
1767+ RawInline _ s <- generalize rawLaTeXInline
1768+ return $ B.rawInline "tex" s
17701769 -- "tex" because it might be context or latex
17711770
1772−rawConTeXtEnvironment :: Parser [Char] st String
1771+rawConTeXtEnvironment :: Monad m => ParserT [Char] st m String
17731772rawConTeXtEnvironment = try $ do
17741773 string "\\start"
17751774 completion <- inBrackets (letter <|> digit <|> spaceChar)
@@ -1778,14 +1777,14 @@ rawConTeXtEnvironment = try $ do
17781777 (try $ string "\\stop" >> string completion)
17791778 return $ "\\start" ++ completion ++ concat contents ++ "\\stop" ++ completion
17801779
1781−inBrackets :: (Parser [Char] st Char) -> Parser [Char] st String
1780+inBrackets :: Monad m => (ParserT [Char] st m Char) -> ParserT [Char] st m String
17821781inBrackets parser = do
17831782 char '['
17841783 contents <- many parser
17851784 char ']'
17861785 return $ "[" ++ contents ++ "]"
17871786
1788−spanHtml :: MarkdownParser (F Inlines)
1787+spanHtml :: MarkdownParser Inlines
17891788spanHtml = try $ do
17901789 guardEnabled Ext_native_spans
17911790 (TagOpen _ attrs, _) <- htmlTag (~== TagOpen "span" [])
@@ -1797,10 +1796,10 @@ spanHtml = try $ do
17971796 Just s | null ident && null classes &&
17981797 map toLower (filter (`notElem` " \t;") s) ==
17991798 "font-variant:small-caps"
1800− -> return $ B.smallcaps <$> contents
1801− _ -> return $ B.spanWith (ident, classes, keyvals) <$> contents
1799+ -> return $ B.smallcaps contents
1800+ _ -> return $ B.spanWith (ident, classes, keyvals) contents
18021801
1803−divHtml :: MarkdownParser (F Blocks)
1802+divHtml :: MarkdownParser Blocks
18041803divHtml = try $ do
18051804 guardEnabled Ext_native_divs
18061805 (TagOpen _ attrs, rawtag) <- htmlTag (~== TagOpen "div" [])
@@ -1818,11 +1817,11 @@ divHtml = try $ do
18181817 let ident = fromMaybe "" $ lookup "id" attrs
18191818 let classes = maybe [] words $ lookup "class" attrs
18201819 let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]
1821− return $ B.divWith (ident, classes, keyvals) <$> contents
1820+ return $ B.divWith (ident, classes, keyvals) contents
18221821 else -- avoid backtracing
1823− return $ return (B.rawBlock "html" (rawtag <> bls)) <> contents
1822+ return $ (B.rawBlock "html" (rawtag <> bls)) <> contents
18241823
1825−rawHtmlInline :: MarkdownParser (F Inlines)
1824+rawHtmlInline :: MarkdownParser Inlines
18261825rawHtmlInline = do
18271826 guardEnabled Ext_raw_html
18281827 inHtmlBlock <- stateInHtmlBlock <$> getState
@@ -1837,19 +1836,19 @@ rawHtmlInline = do
18371836 then (\x -> isInlineTag x &&
18381837 not (isCloseBlockTag x))
18391838 else not . isTextTag
1840− return $ return $ B.rawInline "html" result
1839+ return $ B.rawInline "html" result
18411840
18421841-- Citations
18431842
1844−cite :: MarkdownParser (F Inlines)
1843+cite :: MarkdownParser Inlines
18451844cite = do
18461845 guardEnabled Ext_citations
18471846 citations <- textualCite
18481847 <|> do (cs, raw) <- withRaw normalCite
1849− return $ (flip B.cite (B.text raw)) <$> cs
1848+ return $ (flip B.cite (B.text raw)) cs
18501849 return citations
18511850
1852−textualCite :: MarkdownParser (F Inlines)
1851+textualCite :: MarkdownParser Inlines
18531852textualCite = try $ do
18541853 (_, key) <- citeKey
18551854 let first = Citation{ citationId = key
@@ -1863,29 +1862,26 @@ textualCite = try $ do
18631862 case mbrest of
18641863 Just (rest, raw) ->
18651864 return $ (flip B.cite (B.text $ '@':key ++ " " ++ raw) . (first:))
1866− <$> rest
1865+ rest
18671866 Nothing ->
18681867 (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)
1868+ return $ (flip B.cite (B.text $ '@':key ++ " " ++ raw)) cs)
1869+ <|> do st <- ask
1870+ return $ case M.lookup key (stateExamples st) of
1871+ Just n -> B.str (show n)
1872+ _ -> B.cite [first] $ B.str $ '@':key
18741873
1875−bareloc :: Citation -> MarkdownParser (F [Citation])
1874+bareloc :: Citation -> MarkdownParser [Citation]
18761875bareloc c = try $ do
18771876 spnl
18781877 char '['
18791878 suff <- suffix
1880− rest <- option (return []) $ try $ char ';' >> citeList
1879+ rest <- option [] $ try $ char ';' >> citeList
18811880 spnl
18821881 char ']'
1883− return $ do
1884− suff' <- suff
1885− rest' <- rest
1886− return $ c{ citationSuffix = B.toList suff' } : rest'
1882+ return $ c{ citationSuffix = B.toList suff } : rest
18871883
1888−normalCite :: MarkdownParser (F [Citation])
1884+normalCite :: MarkdownParser [Citation]
18891885normalCite = try $ do
18901886 char '['
18911887 spnl
@@ -1894,60 +1890,57 @@ normalCite = try $ do
18941890 char ']'
18951891 return citations
18961892
1897−suffix :: MarkdownParser (F Inlines)
1893+suffix :: MarkdownParser Inlines
18981894suffix = try $ do
18991895 hasSpace <- option False (notFollowedBy nonspaceChar >> return True)
19001896 spnl
1901− rest <- trimInlinesF . mconcat <$> many (notFollowedBy (oneOf ";]") >> inline)
1897+ rest <- trimInlines . mconcat <$> many (notFollowedBy (oneOf ";]") >> inline)
19021898 return $ if hasSpace
1903− then (B.space <>) <$> rest
1899+ then B.space <> rest
19041900 else rest
19051901
1906−prefix :: MarkdownParser (F Inlines)
1907−prefix = trimInlinesF . mconcat <$>
1902+prefix :: MarkdownParser Inlines
1903+prefix = trimInlines . mconcat <$>
19081904 manyTill inline (char ']' <|> liftM (const ']') (lookAhead citeKey))
19091905
1910−citeList :: MarkdownParser (F [Citation])
1911−citeList = fmap sequence $ sepBy1 citation (try $ char ';' >> spnl)
1906+citeList :: MarkdownParser [Citation]
1907+citeList = sepBy1 citation (try $ char ';' >> spnl)
19121908
1913−citation :: MarkdownParser (F Citation)
1909+citation :: MarkdownParser (Citation)
19141910citation = try $ do
19151911 pref <- prefix
19161912 (suppress_author, key) <- citeKey
19171913 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)
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+ }
1923+
1924+smart :: MarkdownParser Inlines
19321925smart = do
19331926 getOption readerSmart >>= guard
19341927 doubleQuoted <|> singleQuoted <|>
1935− choice (map (return <$>) [apostrophe, dash, ellipses])
1928+ choice [apostrophe, dash, ellipses]
19361929
1937−singleQuoted :: MarkdownParser (F Inlines)
1930+singleQuoted :: MarkdownParser Inlines
19381931singleQuoted = try $ do
19391932 singleQuoteStart
19401933 withQuoteContext InSingleQuote $
1941− fmap B.singleQuoted . trimInlinesF . mconcat <$>
1934+ B.singleQuoted . trimInlines . mconcat <$>
19421935 many1Till inline singleQuoteEnd
19431936
19441937-- doubleQuoted will handle regular double-quoted sections, as well
19451938-- as dialogues with an open double-quote without a close double-quote
19461939-- in the same paragraph.
1947−doubleQuoted :: MarkdownParser (F Inlines)
1940+doubleQuoted :: MarkdownParser Inlines
19481941doubleQuoted = try $ do
19491942 doubleQuoteStart
19501943 contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)
19511944 (withQuoteContext InDoubleQuote $ doubleQuoteEnd >> return
1952− (fmap B.doubleQuoted . trimInlinesF $ contents))
1953− <|> (return $ return (B.str "\8220") <> contents)
1945+ (B.doubleQuoted . trimInlines $ contents))
1946+ <|> return ((B.str "\8220") <> contents)