17b3172 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Remove F Monad from Markdown reader

17b3172Matthew Pickering12 years ago

src/Text/Pandoc/Readers/Markdown.hs+306−313

compare with master

unifiedsplit

@@ -57,6 +57,7 @@ import Text.Pandoc.Readers.HTML ( htmlTag, htmlInBalanced, isInlineTag, isBlockT

57import Data.Monoid (mconcat, mempty)

58import Control.Applicative ((<$>), (<*), (*>), (<$))

59import Control.Monad

60+import Control.Monad.Reader

60import System.FilePath (takeExtension, addExtension)

61import System.FilePath (takeExtension, addExtension)

61import Text.HTML.TagSoup

62import Text.HTML.TagSoup

62import Text.HTML.TagSoup.Match (tagOpen)

63import Text.HTML.TagSoup.Match (tagOpen)

@@ -64,25 +65,36 @@ import qualified Data.Set as Set

64import Text.Printf (printf)

65import Text.Printf (printf)

65import Debug.Trace (trace)

66import Debug.Trace (trace)

67−type MarkdownParser = Parser [Char] ParserState

68+type MarkdownParser a = ParserT [Char] ParserState (Reader ParserState) a

69-- | Read markdown from an input string and return a Pandoc document.

70-- | Read markdown from an input string and return a Pandoc document.

70readMarkdown :: ReaderOptions -- ^ Reader options

71readMarkdown :: ReaderOptions -- ^ Reader options

71 -> String -- ^ String to parse (assuming @'\n'@ line endings)

72 -> String -- ^ String to parse (assuming @'\n'@ line endings)

72 -> Pandoc

73 -> Pandoc

73readMarkdown opts s =

74readMarkdown opts s =

74− (readWith parseMarkdown) def{ stateOptions = opts } (s ++ "\n\n")

75+ (runMarkdown opts s parseMarkdown)

76-- | Read markdown from an input string and return a pair of a Pandoc document

77-- | Read markdown from an input string and return a pair of a Pandoc document

77-- and a list of warnings.

78-- and a list of warnings.

78readMarkdownWithWarnings :: ReaderOptions -- ^ Reader options

79readMarkdownWithWarnings :: ReaderOptions -- ^ Reader options

79 -> String -- ^ String to parse (assuming @'\n'@ line endings)

80 -> String -- ^ String to parse (assuming @'\n'@ line endings)

80 -> (Pandoc, [String])

81 -> (Pandoc, [String])

81−readMarkdownWithWarnings opts s =

82+readMarkdownWithWarnings opts s = runMarkdown opts s (returnWarnings parseMarkdown)

82− (readWithWarnings parseMarkdown) def{ stateOptions = opts } (s ++ "\n\n")

84−trimInlinesF :: F Inlines -> F Inlines

84+

85−trimInlinesF = liftM trimInlines

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

87--

99--

88-- Constants and data structure definitions

100-- Constants and data structure definitions

@@ -119,10 +131,10 @@ inList = do

119 ctx <- stateParserContext <$> getState

131 ctx <- stateParserContext <$> getState

120 guard (ctx == ListItemState)

132 guard (ctx == ListItemState)

121

133

122−isNull :: F Inlines -> Bool

134+isNull :: Inlines -> Bool

123−isNull ils = B.isNull $ runF ils def

135+isNull ils = B.isNull ils

124

136

125−spnl :: Parser [Char] st ()

137+spnl :: Monad m => ParserT [Char] st m ()

126spnl = try $ do

138spnl = try $ do

127 skipSpaces

139 skipSpaces

128 optional newline

140 optional newline

@@ -162,9 +174,9 @@ litChar = escapedChar'

162

174

163-- | Parse a sequence of inline elements between square brackets,

175-- | Parse a sequence of inline elements between square brackets,

164-- including inlines between balanced pairs of square brackets.

176-- including inlines between balanced pairs of square brackets.

165−inlinesInBalancedBrackets :: MarkdownParser (F Inlines)

177+inlinesInBalancedBrackets :: MarkdownParser Inlines

166inlinesInBalancedBrackets = charsInBalancedBrackets >>=

178inlinesInBalancedBrackets = charsInBalancedBrackets >>=

167− parseFromString (trimInlinesF . mconcat <$> many inline)

179+ parseFromString (trimInlines . mconcat <$> many inline)

168

180

169charsInBalancedBrackets :: MarkdownParser [Char]

181charsInBalancedBrackets :: MarkdownParser [Char]

170charsInBalancedBrackets = do

182charsInBalancedBrackets = do

@@ -181,16 +193,16 @@ charsInBalancedBrackets = do

181-- document structure

193-- document structure

182--

194--

183

195

184−titleLine :: MarkdownParser (F Inlines)

196+titleLine :: MarkdownParser Inlines

185titleLine = try $ do

197titleLine = try $ do

186 char '%'

198 char '%'

187 skipSpaces

199 skipSpaces

188 res <- many $ (notFollowedBy newline >> inline)

200 res <- many $ (notFollowedBy newline >> inline)

189 <|> try (endline >> whitespace)

201 <|> try (endline >> whitespace)

190 newline

202 newline

191− return $ trimInlinesF $ mconcat res

203+ return $ trimInlines $ mconcat res

192

204

193−authorsLine :: MarkdownParser (F [Inlines])

205+authorsLine :: MarkdownParser [Inlines]

194authorsLine = try $ do

206authorsLine = try $ do

195 char '%'

207 char '%'

196 skipSpaces

208 skipSpaces

@@ -199,13 +211,13 @@ authorsLine = try $ do

199 (char ';' <|>

211 (char ';' <|>

200 try (newline >> notFollowedBy blankline >> spaceChar))

212 try (newline >> notFollowedBy blankline >> spaceChar))

201 newline

213 newline

202− return $ sequence $ filter (not . isNull) $ map (trimInlinesF . mconcat) authors

214+ return $ filter (not . isNull) $ map (trimInlines . mconcat) authors

203

215

204−dateLine :: MarkdownParser (F Inlines)

216+dateLine :: MarkdownParser Inlines

205dateLine = try $ do

217dateLine = try $ do

206 char '%'

218 char '%'

207 skipSpaces

219 skipSpaces

208− trimInlinesF . mconcat <$> manyTill inline newline

220+ trimInlines . mconcat <$> manyTill inline newline

209

221

210titleBlock :: MarkdownParser ()

222titleBlock :: MarkdownParser ()

211titleBlock = pandocTitleBlock <|> mmdTitleBlock

223titleBlock = pandocTitleBlock <|> mmdTitleBlock

@@ -215,20 +227,16 @@ pandocTitleBlock = try $ do

215 guardEnabled Ext_pandoc_title_block

227 guardEnabled Ext_pandoc_title_block

216 lookAhead (char '%')

228 lookAhead (char '%')

217 title <- option mempty titleLine

229 title <- option mempty titleLine

218− author <- option (return []) authorsLine

230+ author <- option [] authorsLine

219 date <- option mempty dateLine

231 date <- option mempty dateLine

220 optional blanklines

232 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')

233+ let meta' = (if B.isNull title then id else B.setMeta "title" title)

226− . (if null author' then id else B.setMeta "author" author')

234+ . (if null author then id else B.setMeta "author" author)

227− . (if B.isNull date' then id else B.setMeta "date" date')

235+ . (if B.isNull date then id else B.setMeta "date" date)

228− $ nullMeta

236+ $ nullMeta

229− updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }

237+ updateState $ \st -> st{ stateMeta = stateMeta st <> meta' }

230−

238+

231−yamlMetaBlock :: MarkdownParser (F Blocks)

239+yamlMetaBlock :: MarkdownParser (Blocks)

232yamlMetaBlock = try $ do

240yamlMetaBlock = try $ do

233 guardEnabled Ext_yaml_metadata_block

241 guardEnabled Ext_yaml_metadata_block

234 pos <- getPosition

242 pos <- getPosition

@@ -241,17 +249,17 @@ yamlMetaBlock = try $ do

241 optional blanklines

249 optional blanklines

242 opts <- stateOptions <$> getState

250 opts <- stateOptions <$> getState

243 meta' <- case Yaml.decodeEither' $ UTF8.fromString rawYaml of

251 meta' <- case Yaml.decodeEither' $ UTF8.fromString rawYaml of

244− Right (Yaml.Object hashmap) -> return $ return $

252+ Right (Yaml.Object hashmap) -> return $

245 H.foldrWithKey (\k v m ->

253 H.foldrWithKey (\k v m ->

246 if ignorable k

254 if ignorable k

247 then m

255 then m

248 else B.setMeta (T.unpack k)

256 else B.setMeta (T.unpack k)

249 (yamlToMeta opts v) m)

257 (yamlToMeta opts v) m)

250 nullMeta hashmap

258 nullMeta hashmap

251− Right Yaml.Null -> return $ return nullMeta

259+ Right Yaml.Null -> return nullMeta

252 Right _ -> do

260 Right _ -> do

253 addWarning (Just pos) "YAML header is not an object"

261 addWarning (Just pos) "YAML header is not an object"

254− return $ return nullMeta

262+ return nullMeta

255 Left err' -> do

263 Left err' -> do

256 case err' of

264 case err' of

257 InvalidYaml (Just YamlParseException{

265 InvalidYaml (Just YamlParseException{

@@ -270,8 +278,8 @@ yamlMetaBlock = try $ do

270 _ -> addWarning (Just pos)

278 _ -> addWarning (Just pos)

271 $ "Could not parse YAML header: " ++

279 $ "Could not parse YAML header: " ++

272 show err'

280 show err'

273− return $ return nullMeta

281+ return nullMeta

274− updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }

282+ updateState $ \st -> st{ stateMeta = stateMeta st <> meta' }

275 return mempty

283 return mempty

276

284

277-- ignore fields ending with _

285-- ignore fields ending with _

@@ -314,8 +322,8 @@ mmdTitleBlock = try $ do

314 guardEnabled Ext_mmd_title_block

322 guardEnabled Ext_mmd_title_block

315 kvPairs <- many1 kvPair

323 kvPairs <- many1 kvPair

316 blanklines

324 blanklines

317− updateState $ \st -> st{ stateMeta' = stateMeta' st <>

325+ updateState $ \st -> st{ stateMeta = stateMeta st <>

318− return (Meta $ M.fromList kvPairs) }

326+ (Meta $ M.fromList kvPairs) }

319

327

320kvPair :: MarkdownParser (String, MetaValue)

328kvPair :: MarkdownParser (String, MetaValue)

321kvPair = try $ do

329kvPair = try $ do

@@ -335,11 +343,11 @@ parseMarkdown = do

335 optional titleBlock

343 optional titleBlock

336 blocks <- parseBlocks

344 blocks <- parseBlocks

337 st <- getState

345 st <- getState

338− let meta = runF (stateMeta' st) st

346+ let meta = stateMeta st

339− let Pandoc _ bs = B.doc $ runF blocks st

347+ let Pandoc _ bs = B.doc blocks

340 return $ Pandoc meta bs

348 return $ Pandoc meta bs

341

349

342−referenceKey :: MarkdownParser (F Blocks)

350+referenceKey :: MarkdownParser (Blocks)

343referenceKey = try $ do

351referenceKey = try $ do

344 pos <- getPosition

352 pos <- getPosition

345 skipNonindentSpaces

353 skipNonindentSpaces

@@ -366,7 +374,7 @@ referenceKey = try $ do

366 Just _ -> addWarning (Just pos) $ "Duplicate link reference `" ++ raw ++ "'"

374 Just _ -> addWarning (Just pos) $ "Duplicate link reference `" ++ raw ++ "'"

367 Nothing -> return ()

375 Nothing -> return ()

368 updateState $ \s -> s { stateKeys = M.insert key target oldkeys }

376 updateState $ \s -> s { stateKeys = M.insert key target oldkeys }

369− return $ return mempty

377+ return mempty

370

378

371referenceTitle :: MarkdownParser String

379referenceTitle :: MarkdownParser String

372referenceTitle = try $ do

380referenceTitle = try $ do

@@ -386,7 +394,7 @@ quotedTitle c = try $ do

386-- | PHP Markdown Extra style abbreviation key. Currently

394-- | PHP Markdown Extra style abbreviation key. Currently

387-- we just skip them, since Pandoc doesn't have an element for

395-- we just skip them, since Pandoc doesn't have an element for

388-- an abbreviation.

396-- an abbreviation.

389−abbrevKey :: MarkdownParser (F Blocks)

397+abbrevKey :: MarkdownParser (Blocks)

390abbrevKey = do

398abbrevKey = do

391 guardEnabled Ext_abbreviations

399 guardEnabled Ext_abbreviations

392 try $ do

400 try $ do

@@ -395,7 +403,7 @@ abbrevKey = do

395 char ':'

403 char ':'

396 skipMany (satisfy (/= '\n'))

404 skipMany (satisfy (/= '\n'))

397 blanklines

405 blanklines

398− return $ return mempty

406+ return mempty

399

407

400noteMarker :: MarkdownParser String

408noteMarker :: MarkdownParser String

401noteMarker = string "[^" >> many1Till (satisfy $ not . isBlank) (char ']')

409noteMarker = string "[^" >> many1Till (satisfy $ not . isBlank) (char ']')

@@ -413,7 +421,7 @@ rawLines = do

413 rest <- many rawLine

421 rest <- many rawLine

414 return $ unlines (first:rest)

422 return $ unlines (first:rest)

415

423

416−noteBlock :: MarkdownParser (F Blocks)

424+noteBlock :: MarkdownParser (Blocks)

417noteBlock = try $ do

425noteBlock = try $ do

418 pos <- getPosition

426 pos <- getPosition

419 skipNonindentSpaces

427 skipNonindentSpaces

@@ -425,7 +433,7 @@ noteBlock = try $ do

425 rest <- many $ try $ blanklines >> indentSpaces >> rawLines

433 rest <- many $ try $ blanklines >> indentSpaces >> rawLines

426 let raw = unlines (first:rest) ++ "\n"

434 let raw = unlines (first:rest) ++ "\n"

427 optional blanklines

435 optional blanklines

428− parsed <- parseFromString parseBlocks raw

436+ parsed <- parseFromString (inFootnote parseBlocks) raw

429 let newnote = (ref, parsed)

437 let newnote = (ref, parsed)

430 oldnotes <- stateNotes' <$> getState

438 oldnotes <- stateNotes' <$> getState

431 case lookup ref oldnotes of

439 case lookup ref oldnotes of

@@ -434,14 +442,22 @@ noteBlock = try $ do

434 updateState $ \s -> s { stateNotes' = newnote : oldnotes }

442 updateState $ \s -> s { stateNotes' = newnote : oldnotes }

435 return mempty

443 return mempty

436

444

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+

437--

453--

438-- parsing blocks

454-- parsing blocks

439--

455--

440

456

441−parseBlocks :: MarkdownParser (F Blocks)

457+parseBlocks :: MarkdownParser (Blocks)

442parseBlocks = mconcat <$> manyTill block eof

458parseBlocks = mconcat <$> manyTill block eof

443

459

444−block :: MarkdownParser (F Blocks)

460+block :: MarkdownParser (Blocks)

445block = do

461block = do

446 tr <- getOption readerTrace

462 tr <- getOption readerTrace

447 pos <- getPosition

463 pos <- getPosition

@@ -457,7 +473,7 @@ block = do

457 , htmlBlock

473 , htmlBlock

458 , table

474 , table

459 , codeBlockIndented

475 , codeBlockIndented

460− , guardEnabled Ext_latex_macros *> (macro >>= return . return)

476+ , guardEnabled Ext_latex_macros *> macro

461 , rawTeXBlock

477 , rawTeXBlock

462 , lineBlock

478 , lineBlock

463 , blockQuote

479 , blockQuote

@@ -471,28 +487,27 @@ block = do

471 , plain

487 , plain

472 ] <?> "block"

488 ] <?> "block"

473 when tr $ do

489 when tr $ do

474− st <- getState

475 trace (printf "line %d: %s" (sourceLine pos)

490 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 ())

477 return res

492 return res

478

493

479--

494--

480-- header blocks

495-- header blocks

481--

496--

482

497

483−header :: MarkdownParser (F Blocks)

498+header :: MarkdownParser (Blocks)

484header = setextHeader <|> atxHeader <?> "header"

499header = setextHeader <|> atxHeader <?> "header"

485

500

486−atxHeader :: MarkdownParser (F Blocks)

501+atxHeader :: MarkdownParser Blocks

487atxHeader = try $ do

502atxHeader = try $ do

488 level <- many1 (char '#') >>= return . length

503 level <- many1 (char '#') >>= return . length

489 notFollowedBy $ guardEnabled Ext_fancy_lists >>

504 notFollowedBy $ guardEnabled Ext_fancy_lists >>

490 (char '.' <|> char ')') -- this would be a list

505 (char '.' <|> char ')') -- this would be a list

491 skipSpaces

506 skipSpaces

492− text <- trimInlinesF . mconcat <$> many (notFollowedBy atxClosing >> inline)

507+ text <- trimInlines . mconcat <$> many (notFollowedBy atxClosing >> inline)

493 attr <- atxClosing

508 attr <- atxClosing

494− attr' <- registerHeader attr (runF text defaultParserState)

509+ attr' <- registerHeader attr text

495− return $ B.headerWith attr' level <$> text

510+ return $ B.headerWith attr' level text

496

511

497atxClosing :: MarkdownParser Attr

512atxClosing :: MarkdownParser Attr

498atxClosing = try $ do

513atxClosing = try $ do

@@ -519,25 +534,25 @@ mmdHeaderIdentifier = do

519 skipSpaces

534 skipSpaces

520 return (ident,[],[])

535 return (ident,[],[])

521

536

522−setextHeader :: MarkdownParser (F Blocks)

537+setextHeader :: MarkdownParser Blocks

523setextHeader = try $ do

538setextHeader = try $ do

524 -- This lookahead prevents us from wasting time parsing Inlines

539 -- This lookahead prevents us from wasting time parsing Inlines

525 -- unless necessary -- it gives a significant performance boost.

540 -- unless necessary -- it gives a significant performance boost.

526 lookAhead $ anyLine >> many1 (oneOf setextHChars) >> blankline

541 lookAhead $ anyLine >> many1 (oneOf setextHChars) >> blankline

527− text <- trimInlinesF . mconcat <$> many1 (notFollowedBy setextHeaderEnd >> inline)

542+ text <- trimInlines . mconcat <$> many1 (notFollowedBy setextHeaderEnd >> inline)

528 attr <- setextHeaderEnd

543 attr <- setextHeaderEnd

529 underlineChar <- oneOf setextHChars

544 underlineChar <- oneOf setextHChars

530 many (char underlineChar)

545 many (char underlineChar)

531 blanklines

546 blanklines

532 let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1

547 let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1

533− attr' <- registerHeader attr (runF text defaultParserState)

548+ attr' <- registerHeader attr text

534− return $ B.headerWith attr' level <$> text

549+ return $ B.headerWith attr' level text

535

550

536--

551--

537-- hrule block

552-- hrule block

538--

553--

539

554

540−hrule :: Parser [Char] st (F Blocks)

555+hrule :: Monad m => ParserT [Char] st m Blocks

541hrule = try $ do

556hrule = try $ do

542 skipSpaces

557 skipSpaces

543 start <- satisfy isHruleChar

558 start <- satisfy isHruleChar

@@ -545,7 +560,7 @@ hrule = try $ do

545 skipMany (spaceChar <|> char start)

560 skipMany (spaceChar <|> char start)

546 newline

561 newline

547 optional blanklines

562 optional blanklines

548− return $ return B.horizontalRule

563+ return B.horizontalRule

549

564

550--

565--

551-- code blocks

566-- code blocks

@@ -554,9 +569,10 @@ hrule = try $ do

554indentedLine :: MarkdownParser String

569indentedLine :: MarkdownParser String

555indentedLine = indentSpaces >> anyLine >>= return . (++ "\n")

570indentedLine = indentSpaces >> anyLine >>= return . (++ "\n")

556

571

557−blockDelimiter :: (Char -> Bool)

572+blockDelimiter :: Monad m

573+ => (Char -> Bool)

558 -> Maybe Int

574 -> Maybe Int

559− -> Parser [Char] st Int

575+ -> ParserT [Char] st m Int

560blockDelimiter f len = try $ do

576blockDelimiter f len = try $ do

561 c <- lookAhead (satisfy f)

577 c <- lookAhead (satisfy f)

562 case len of

578 case len of

@@ -607,7 +623,7 @@ specialAttr = do

607 char '-'

623 char '-'

608 return $ \(id',cs,kvs) -> (id',cs ++ ["unnumbered"],kvs)

624 return $ \(id',cs,kvs) -> (id',cs ++ ["unnumbered"],kvs)

609

625

610−codeBlockFenced :: MarkdownParser (F Blocks)

626+codeBlockFenced :: MarkdownParser Blocks

611codeBlockFenced = try $ do

627codeBlockFenced = try $ do

612 c <- try (guardEnabled Ext_fenced_code_blocks >> lookAhead (char '~'))

628 c <- try (guardEnabled Ext_fenced_code_blocks >> lookAhead (char '~'))

613 <|> (guardEnabled Ext_backtick_code_blocks >> lookAhead (char '`'))

629 <|> (guardEnabled Ext_backtick_code_blocks >> lookAhead (char '`'))

@@ -619,7 +635,7 @@ codeBlockFenced = try $ do

619 blankline

635 blankline

620 contents <- manyTill anyLine (blockDelimiter (== c) (Just size))

636 contents <- manyTill anyLine (blockDelimiter (== c) (Just size))

621 blanklines

637 blanklines

622− return $ return $ B.codeBlockWith attr $ intercalate "\n" contents

638+ return $ B.codeBlockWith attr $ intercalate "\n" contents

623

639

624-- correctly handle github language identifiers

640-- correctly handle github language identifiers

625toLanguageId :: String -> String

641toLanguageId :: String -> String

@@ -628,7 +644,7 @@ toLanguageId = map toLower . go

628 go "objective-c" = "objectivec"

644 go "objective-c" = "objectivec"

629 go x = x

645 go x = x

630

646

631−codeBlockIndented :: MarkdownParser (F Blocks)

647+codeBlockIndented :: MarkdownParser (Blocks)

632codeBlockIndented = do

648codeBlockIndented = do

633 contents <- many1 (indentedLine <|>

649 contents <- many1 (indentedLine <|>

634 try (do b <- blanklines

650 try (do b <- blanklines

@@ -636,15 +652,15 @@ codeBlockIndented = do

636 return $ b ++ l))

652 return $ b ++ l))

637 optional blanklines

653 optional blanklines

638 classes <- getOption readerIndentedCodeClasses

654 classes <- getOption readerIndentedCodeClasses

639− return $ return $ B.codeBlockWith ("", classes, []) $

655+ return $ B.codeBlockWith ("", classes, []) $

640 stripTrailingNewlines $ concat contents

656 stripTrailingNewlines $ concat contents

641

657

642−lhsCodeBlock :: MarkdownParser (F Blocks)

658+lhsCodeBlock :: MarkdownParser (Blocks)

643lhsCodeBlock = do

659lhsCodeBlock = do

644 guardEnabled Ext_literate_haskell

660 guardEnabled Ext_literate_haskell

645− (return . B.codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>

661+ (B.codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>

646 (lhsCodeBlockBird <|> lhsCodeBlockLaTeX))

662 (lhsCodeBlockBird <|> lhsCodeBlockLaTeX))

647− <|> (return . B.codeBlockWith ("",["sourceCode","haskell"],[]) <$>

663+ <|> (B.codeBlockWith ("",["sourceCode","haskell"],[]) <$>

648 lhsCodeBlockInverseBird)

664 lhsCodeBlockInverseBird)

649

665

650lhsCodeBlockLaTeX :: MarkdownParser String

666lhsCodeBlockLaTeX :: MarkdownParser String

@@ -673,7 +689,7 @@ lhsCodeBlockBirdWith c = try $ do

673 blanklines

689 blanklines

674 return $ intercalate "\n" lns'

690 return $ intercalate "\n" lns'

675

691

676−birdTrackLine :: Char -> Parser [Char] st String

692+birdTrackLine :: Monad m => Char -> ParserT [Char] st m String

677birdTrackLine c = try $ do

693birdTrackLine c = try $ do

678 char c

694 char c

679 -- allow html tags on left margin:

695 -- allow html tags on left margin:

@@ -701,12 +717,12 @@ emailBlockQuote = try $ do

701 optional blanklines

717 optional blanklines

702 return raw

718 return raw

703

719

704−blockQuote :: MarkdownParser (F Blocks)

720+blockQuote :: MarkdownParser (Blocks)

705blockQuote = do

721blockQuote = do

706 raw <- emailBlockQuote

722 raw <- emailBlockQuote

707 -- parse the extracted block, which may contain various block elements:

723 -- parse the extracted block, which may contain various block elements:

708 contents <- parseFromString parseBlocks $ (intercalate "\n" raw) ++ "\n\n"

724 contents <- parseFromString parseBlocks $ (intercalate "\n" raw) ++ "\n\n"

709− return $ B.blockQuote <$> contents

725+ return $ B.blockQuote contents

710

726

711--

727--

712-- list blocks

728-- list blocks

@@ -804,7 +820,7 @@ listContinuationLine = try $ do

804 return $ result ++ "\n"

820 return $ result ++ "\n"

805

821

806listItem :: MarkdownParser a

822listItem :: MarkdownParser a

807− -> MarkdownParser (F Blocks)

823+ -> MarkdownParser (Blocks)

808listItem start = try $ do

824listItem start = try $ do

809 first <- rawListItem start

825 first <- rawListItem start

810 continuations <- many listContinuation

826 continuations <- many listContinuation

@@ -820,14 +836,14 @@ listItem start = try $ do

820 updateState (\st -> st {stateParserContext = oldContext})

836 updateState (\st -> st {stateParserContext = oldContext})

821 return contents

837 return contents

822

838

823−orderedList :: MarkdownParser (F Blocks)

839+orderedList :: MarkdownParser Blocks

824orderedList = try $ do

840orderedList = try $ do

825 (start, style, delim) <- lookAhead anyOrderedListStart

841 (start, style, delim) <- lookAhead anyOrderedListStart

826 unless (style `elem` [DefaultStyle, Decimal, Example] &&

842 unless (style `elem` [DefaultStyle, Decimal, Example] &&

827 delim `elem` [DefaultDelim, Period]) $

843 delim `elem` [DefaultDelim, Period]) $

828 guardEnabled Ext_fancy_lists

844 guardEnabled Ext_fancy_lists

829 when (style == Example) $ guardEnabled Ext_example_lists

845 when (style == Example) $ guardEnabled Ext_example_lists

830− items <- fmap sequence $ many1 $ listItem

846+ items <- many1 $ listItem

831 ( try $ do

847 ( try $ do

832 optional newline -- if preceded by Plain block in a list

848 optional newline -- if preceded by Plain block in a list

833 startpos <- sourceColumn <$> getPosition

849 startpos <- sourceColumn <$> getPosition

@@ -839,12 +855,12 @@ orderedList = try $ do

839 atMostSpaces (tabStop - (endpos - startpos))

855 atMostSpaces (tabStop - (endpos - startpos))

840 return res )

856 return res )

841 start' <- option 1 $ guardEnabled Ext_startnum >> return start

857 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)

843

859

844−bulletList :: MarkdownParser (F Blocks)

860+bulletList :: MarkdownParser (Blocks)

845bulletList = do

861bulletList = do

846− items <- fmap sequence $ many1 $ listItem bulletListStart

862+ items <- many1 $ listItem bulletListStart

847− return $ B.bulletList <$> fmap compactify' items

863+ return $ B.bulletList (compactify' items)

848

864

849-- definition lists

865-- definition lists

850

866

@@ -859,14 +875,14 @@ defListMarker = do

859 else mzero

875 else mzero

860 return ()

876 return ()

861

877

862−definitionListItem :: Bool -> MarkdownParser (F (Inlines, [Blocks]))

878+definitionListItem :: Bool -> MarkdownParser (Inlines, [Blocks])

863definitionListItem compact = try $ do

879definitionListItem compact = try $ do

864 rawLine' <- anyLine

880 rawLine' <- anyLine

865 raw <- many1 $ defRawBlock compact

881 raw <- many1 $ defRawBlock compact

866− term <- parseFromString (trimInlinesF . mconcat <$> many inline) rawLine'

882+ term <- parseFromString (trimInlines . mconcat <$> many inline) rawLine'

867 contents <- mapM (parseFromString parseBlocks) raw

883 contents <- mapM (parseFromString parseBlocks) raw

868 optional blanklines

884 optional blanklines

869− return $ liftM2 (,) term (sequence contents)

885+ return $ (term, contents)

870

886

871defRawBlock :: Bool -> MarkdownParser String

887defRawBlock :: Bool -> MarkdownParser String

872defRawBlock compact = try $ do

888defRawBlock compact = try $ do

@@ -889,32 +905,32 @@ defRawBlock compact = try $ do

889 return $ trimr (firstline ++ "\n" ++ unlines rawlines ++ cont) ++

905 return $ trimr (firstline ++ "\n" ++ unlines rawlines ++ cont) ++

890 if hasBlank || not (null cont) then "\n\n" else ""

906 if hasBlank || not (null cont) then "\n\n" else ""

891

907

892−definitionList :: MarkdownParser (F Blocks)

908+definitionList :: MarkdownParser (Blocks)

893definitionList = try $ do

909definitionList = try $ do

894 lookAhead (anyLine >> optional blankline >> defListMarker)

910 lookAhead (anyLine >> optional blankline >> defListMarker)

895 compactDefinitionList <|> normalDefinitionList

911 compactDefinitionList <|> normalDefinitionList

896

912

897−compactDefinitionList :: MarkdownParser (F Blocks)

913+compactDefinitionList :: MarkdownParser (Blocks)

898compactDefinitionList = do

914compactDefinitionList = do

899 guardEnabled Ext_compact_definition_lists

915 guardEnabled Ext_compact_definition_lists

900− items <- fmap sequence $ many1 $ definitionListItem True

916+ items <- many1 $ definitionListItem True

901− return $ B.definitionList <$> fmap compactify'DL items

917+ return $ B.definitionList (compactify'DL items)

902

918

903−normalDefinitionList :: MarkdownParser (F Blocks)

919+normalDefinitionList :: MarkdownParser (Blocks)

904normalDefinitionList = do

920normalDefinitionList = do

905 guardEnabled Ext_definition_lists

921 guardEnabled Ext_definition_lists

906− items <- fmap sequence $ many1 $ definitionListItem False

922+ items <- many1 $ definitionListItem False

907− return $ B.definitionList <$> items

923+ return $ B.definitionList items

908

924

909--

925--

910-- paragraph block

926-- paragraph block

911--

927--

912

928

913−para :: MarkdownParser (F Blocks)

929+para :: MarkdownParser Blocks

914para = try $ do

930para = try $ do

915 exts <- getOption readerExtensions

931 exts <- getOption readerExtensions

916− result <- trimInlinesF . mconcat <$> many1 inline

932+ result <- trimInlines . mconcat <$> many1 inline

917− option (B.plain <$> result)

933+ option (B.plain result)

918 $ try $ do

934 $ try $ do

919 newline

935 newline

920 (blanklines >> return mempty)

936 (blanklines >> return mempty)

@@ -932,17 +948,16 @@ para = try $ do

932 lookAhead (htmlTag (~== TagClose "div"))

948 lookAhead (htmlTag (~== TagClose "div"))

933 _ -> mzero

949 _ -> mzero

934 return $ do

950 return $ do

935− result' <- result

936− case B.toList result' of

951+ case B.toList result of

937 [Image alt (src,tit)]

952 [Image alt (src,tit)]

938 | Ext_implicit_figures `Set.member` exts ->

953 | Ext_implicit_figures `Set.member` exts ->

939 -- the fig: at beginning of title indicates a figure

954 -- the fig: at beginning of title indicates a figure

940− return $ B.para $ B.singleton

955+ B.para $ B.singleton

941 $ Image alt (src,'f':'i':'g':':':tit)

956 $ Image alt (src,'f':'i':'g':':':tit)

942− _ -> return $ B.para result'

957+ _ -> B.para result

943

958

944−plain :: MarkdownParser (F Blocks)

959+plain :: MarkdownParser (Blocks)

945−plain = fmap B.plain . trimInlinesF . mconcat <$> many1 inline

960+plain = B.plain . trimInlines . mconcat <$> many1 inline

946

961

947--

962--

948-- raw html

963-- raw html

@@ -953,13 +968,13 @@ htmlElement = rawVerbatimBlock

953 <|> strictHtmlBlock

968 <|> strictHtmlBlock

954 <|> liftM snd (htmlTag isBlockTag)

969 <|> liftM snd (htmlTag isBlockTag)

955

970

956−htmlBlock :: MarkdownParser (F Blocks)

971+htmlBlock :: MarkdownParser (Blocks)

957htmlBlock = do

972htmlBlock = do

958 guardEnabled Ext_raw_html

973 guardEnabled Ext_raw_html

959 try (do

974 try (do

960 (TagOpen t attrs) <- lookAhead $ fst <$> htmlTag isBlockTag

975 (TagOpen t attrs) <- lookAhead $ fst <$> htmlTag isBlockTag

961 (guard (t `elem` ["pre","style","script"]) >>

976 (guard (t `elem` ["pre","style","script"]) >>

962− (return . B.rawBlock "html") <$> rawVerbatimBlock)

977+ (B.rawBlock "html") <$> rawVerbatimBlock)

963 <|> (do guardEnabled Ext_markdown_attribute

978 <|> (do guardEnabled Ext_markdown_attribute

964 oldMarkdownAttribute <- stateMarkdownAttribute <$> getState

979 oldMarkdownAttribute <- stateMarkdownAttribute <$> getState

965 markdownAttribute <-

980 markdownAttribute <-

@@ -978,12 +993,12 @@ htmlBlock = do

978 <|> (guardEnabled Ext_markdown_in_html_blocks >> rawHtmlBlocks))

993 <|> (guardEnabled Ext_markdown_in_html_blocks >> rawHtmlBlocks))

979 <|> htmlBlock'

994 <|> htmlBlock'

980

995

981−htmlBlock' :: MarkdownParser (F Blocks)

996+htmlBlock' :: MarkdownParser (Blocks)

982htmlBlock' = try $ do

997htmlBlock' = try $ do

983 first <- htmlElement

998 first <- htmlElement

984 skipMany spaceChar

999 skipMany spaceChar

985 optional blanklines

1000 optional blanklines

986− return $ return $ B.rawBlock "html" first

1001+ return $ B.rawBlock "html" first

987

1002

988strictHtmlBlock :: MarkdownParser String

1003strictHtmlBlock :: MarkdownParser String

989strictHtmlBlock = htmlInBalanced (not . isInlineTag)

1004strictHtmlBlock = htmlInBalanced (not . isInlineTag)

@@ -996,17 +1011,17 @@ rawVerbatimBlock = try $ do

996 contents <- manyTill anyChar (htmlTag (~== TagClose tag))

1011 contents <- manyTill anyChar (htmlTag (~== TagClose tag))

997 return $ open ++ contents ++ renderTags' [TagClose tag]

1012 return $ open ++ contents ++ renderTags' [TagClose tag]

998

1013

999−rawTeXBlock :: MarkdownParser (F Blocks)

1014+rawTeXBlock :: MarkdownParser (Blocks)

1000rawTeXBlock = do

1015rawTeXBlock = do

1001 guardEnabled Ext_raw_tex

1016 guardEnabled Ext_raw_tex

1002 result <- (B.rawBlock "latex" . concat <$>

1017 result <- (B.rawBlock "latex" . concat <$>

1003− rawLaTeXBlock `sepEndBy1` blankline)

1018+ (generalize rawLaTeXBlock) `sepEndBy1` blankline)

1004 <|> (B.rawBlock "context" . concat <$>

1019 <|> (B.rawBlock "context" . concat <$>

1005 rawConTeXtEnvironment `sepEndBy1` blankline)

1020 rawConTeXtEnvironment `sepEndBy1` blankline)

1006 spaces

1021 spaces

1007− return $ return result

1022+ return result

1008

1023

1009−rawHtmlBlocks :: MarkdownParser (F Blocks)

1024+rawHtmlBlocks :: MarkdownParser (Blocks)

1010rawHtmlBlocks = do

1025rawHtmlBlocks = do

1011 (TagOpen tagtype _, raw) <- htmlTag isBlockTag

1026 (TagOpen tagtype _, raw) <- htmlTag isBlockTag

1012 -- try to find closing tag

1027 -- try to find closing tag

@@ -1018,10 +1033,10 @@ rawHtmlBlocks = do

1018 contents <- mconcat <$> many (notFollowedBy' closer >> block)

1033 contents <- mconcat <$> many (notFollowedBy' closer >> block)

1019 result <-

1034 result <-

1020 (closer >>= \(_, rawcloser) -> return (

1035 (closer >>= \(_, rawcloser) -> return (

1021− return (B.rawBlock "html" $ stripMarkdownAttribute raw) <>

1036+ (B.rawBlock "html" $ stripMarkdownAttribute raw) <>

1022 contents <>

1037 contents <>

1023− return (B.rawBlock "html" rawcloser)))

1038+ (B.rawBlock "html" rawcloser)))

1024− <|> return (return (B.rawBlock "html" raw) <> contents)

1039+ <|> return ((B.rawBlock "html" raw) <> contents)

1025 updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock }

1040 updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock }

1026 return result

1041 return result

1027

1042

@@ -1036,12 +1051,12 @@ stripMarkdownAttribute s = renderTags' $ map filterAttrib $ parseTags s

1036-- line block

1051-- line block

1037--

1052--

1038

1053

1039−lineBlock :: MarkdownParser (F Blocks)

1054+lineBlock :: MarkdownParser (Blocks)

1040lineBlock = try $ do

1055lineBlock = try $ do

1041 guardEnabled Ext_line_blocks

1056 guardEnabled Ext_line_blocks

1042 lines' <- lineBlockLines >>=

1057 lines' <- lineBlockLines >>=

1043− mapM (parseFromString (trimInlinesF . mconcat <$> many inline))

1058+ mapM (parseFromString (trimInlines . mconcat <$> many inline))

1044− return $ B.para <$> (mconcat $ intersperse (return B.linebreak) lines')

1059+ return $ B.para (mconcat $ intersperse B.linebreak lines')

1045

1060

1046--

1061--

1047-- Tables

1062-- Tables

@@ -1049,8 +1064,8 @@ lineBlock = try $ do

1049

1064

1050-- Parse a dashed line with optional trailing spaces; return its length

1065-- Parse a dashed line with optional trailing spaces; return its length

1051-- and the length including trailing space.

1066-- and the length including trailing space.

1052−dashedLine :: Char

1067+dashedLine :: Monad m => Char

1053− -> Parser [Char] st (Int, Int)

1068+ -> ParserT [Char] st m (Int, Int)

1054dashedLine ch = do

1069dashedLine ch = do

1055 dashes <- many1 (char ch)

1070 dashes <- many1 (char ch)

1056 sp <- many spaceChar

1071 sp <- many spaceChar

@@ -1059,7 +1074,7 @@ dashedLine ch = do

1059-- Parse a table header with dashed lines of '-' preceded by

1074-- Parse a table header with dashed lines of '-' preceded by

1060-- one (or zero) line of text.

1075-- one (or zero) line of text.

1061simpleTableHeader :: Bool -- ^ Headerless table

1076simpleTableHeader :: Bool -- ^ Headerless table

1062− -> MarkdownParser (F [Blocks], [Alignment], [Int])

1077+ -> MarkdownParser ([Blocks], [Alignment], [Int])

1063simpleTableHeader headless = try $ do

1078simpleTableHeader headless = try $ do

1064 rawContent <- if headless

1079 rawContent <- if headless

1065 then return ""

1080 then return ""

@@ -1078,8 +1093,8 @@ simpleTableHeader headless = try $ do

1078 let rawHeads' = if headless

1093 let rawHeads' = if headless

1079 then replicate (length dashes) ""

1094 then replicate (length dashes) ""

1080 else rawHeads

1095 else rawHeads

1081− heads <- fmap sequence

1096+ heads <-

1082− $ mapM (parseFromString (mconcat <$> many plain))

1097+ mapM (parseFromString (mconcat <$> many plain))

1083 $ map trim rawHeads'

1098 $ map trim rawHeads'

1084 return (heads, aligns, indices)

1099 return (heads, aligns, indices)

1085

1100

@@ -1121,30 +1136,30 @@ rawTableLine indices = do

1121

1136

1122-- Parse a table line and return a list of lists of blocks (columns).

1137-- Parse a table line and return a list of lists of blocks (columns).

1123tableLine :: [Int]

1138tableLine :: [Int]

1124− -> MarkdownParser (F [Blocks])

1139+ -> MarkdownParser [Blocks]

1125tableLine indices = rawTableLine indices >>=

1140tableLine indices = rawTableLine indices >>=

1126− fmap sequence . mapM (parseFromString (mconcat <$> many plain))

1141+ mapM (parseFromString (mconcat <$> many plain))

1127

1142

1128-- Parse a multiline table row and return a list of blocks (columns).

1143-- Parse a multiline table row and return a list of blocks (columns).

1129multilineRow :: [Int]

1144multilineRow :: [Int]

1130− -> MarkdownParser (F [Blocks])

1145+ -> MarkdownParser [Blocks]

1131multilineRow indices = do

1146multilineRow indices = do

1132 colLines <- many1 (rawTableLine indices)

1147 colLines <- many1 (rawTableLine indices)

1133 let cols = map unlines $ transpose colLines

1148 let cols = map unlines $ transpose colLines

1134− fmap sequence $ mapM (parseFromString (mconcat <$> many plain)) cols

1149+ mapM (parseFromString (mconcat <$> many plain)) cols

1135

1150

1136-- Parses a table caption: inlines beginning with 'Table:'

1151-- Parses a table caption: inlines beginning with 'Table:'

1137-- and followed by blank lines.

1152-- and followed by blank lines.

1138−tableCaption :: MarkdownParser (F Inlines)

1153+tableCaption :: MarkdownParser Inlines

1139tableCaption = try $ do

1154tableCaption = try $ do

1140 guardEnabled Ext_table_captions

1155 guardEnabled Ext_table_captions

1141 skipNonindentSpaces

1156 skipNonindentSpaces

1142 string ":" <|> string "Table:"

1157 string ":" <|> string "Table:"

1143− trimInlinesF . mconcat <$> many1 inline <* blanklines

1158+ trimInlines . mconcat <$> many1 inline <* blanklines

1144

1159

1145-- Parse a simple table with '---' header and one line per row.

1160-- Parse a simple table with '---' header and one line per row.

1146simpleTable :: Bool -- ^ Headerless table

1161simpleTable :: Bool -- ^ Headerless table

1147− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])

1162+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])

1148simpleTable headless = do

1163simpleTable headless = do

1149 (aligns, _widths, heads', lines') <-

1164 (aligns, _widths, heads', lines') <-

1150 tableWith (simpleTableHeader headless) tableLine

1165 tableWith (simpleTableHeader headless) tableLine

@@ -1158,12 +1173,12 @@ simpleTable headless = do

1158-- which may be multiline, separated by blank lines, and

1173-- which may be multiline, separated by blank lines, and

1159-- ending with a footer (dashed line followed by blank line).

1174-- ending with a footer (dashed line followed by blank line).

1160multilineTable :: Bool -- ^ Headerless table

1175multilineTable :: Bool -- ^ Headerless table

1161− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])

1176+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])

1162multilineTable headless =

1177multilineTable headless =

1163 tableWith (multilineTableHeader headless) multilineRow blanklines tableFooter

1178 tableWith (multilineTableHeader headless) multilineRow blanklines tableFooter

1164

1179

1165multilineTableHeader :: Bool -- ^ Headerless table

1180multilineTableHeader :: Bool -- ^ Headerless table

1166− -> MarkdownParser (F [Blocks], [Alignment], [Int])

1181+ -> MarkdownParser ([Blocks], [Alignment], [Int])

1167multilineTableHeader headless = try $ do

1182multilineTableHeader headless = try $ do

1168 unless headless $

1183 unless headless $

1169 tableSep >> notFollowedBy blankline

1184 tableSep >> notFollowedBy blankline

@@ -1185,7 +1200,7 @@ multilineTableHeader headless = try $ do

1185 let rawHeads = if headless

1200 let rawHeads = if headless

1186 then replicate (length dashes) ""

1201 then replicate (length dashes) ""

1187 else map (unlines . map trim) rawHeadsList

1202 else map (unlines . map trim) rawHeadsList

1188− heads <- fmap sequence $

1203+ heads <-

1189 mapM (parseFromString (mconcat <$> many plain)) $

1204 mapM (parseFromString (mconcat <$> many plain)) $

1190 map trim rawHeads

1205 map trim rawHeads

1191 return (heads, aligns, indices)

1206 return (heads, aligns, indices)

@@ -1195,7 +1210,7 @@ multilineTableHeader headless = try $ do

1195-- which may be grid, separated by blank lines, and

1210-- which may be grid, separated by blank lines, and

1196-- ending with a footer (dashed line followed by blank line).

1211-- ending with a footer (dashed line followed by blank line).

1197gridTable :: Bool -- ^ Headerless table

1212gridTable :: Bool -- ^ Headerless table

1198− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])

1213+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])

1199gridTable headless =

1214gridTable headless =

1200 tableWith (gridTableHeader headless) gridTableRow

1215 tableWith (gridTableHeader headless) gridTableRow

1201 (gridTableSep '-') gridTableFooter

1216 (gridTableSep '-') gridTableFooter

@@ -1204,13 +1219,13 @@ gridTableSplitLine :: [Int] -> String -> [String]

1204gridTableSplitLine indices line = map removeFinalBar $ tail $

1219gridTableSplitLine indices line = map removeFinalBar $ tail $

1205 splitStringByIndices (init indices) $ trimr line

1220 splitStringByIndices (init indices) $ trimr line

1206

1221

1207−gridPart :: Char -> Parser [Char] st (Int, Int)

1222+gridPart :: Monad m => Char -> ParserT [Char] st m (Int, Int)

1208gridPart ch = do

1223gridPart ch = do

1209 dashes <- many1 (char ch)

1224 dashes <- many1 (char ch)

1210 char '+'

1225 char '+'

1211 return (length dashes, length dashes + 1)

1226 return (length dashes, length dashes + 1)

1212

1227

1213−gridDashedLines :: Char -> Parser [Char] st [(Int,Int)]

1228+gridDashedLines :: Monad m => Char -> ParserT [Char] st m [(Int,Int)]

1214gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline

1229gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline

1215

1230

1216removeFinalBar :: String -> String

1231removeFinalBar :: String -> String

@@ -1223,7 +1238,7 @@ gridTableSep ch = try $ gridDashedLines ch >> return '\n'

1223

1238

1224-- | Parse header for a grid table.

1239-- | Parse header for a grid table.

1225gridTableHeader :: Bool -- ^ Headerless table

1240gridTableHeader :: Bool -- ^ Headerless table

1226− -> MarkdownParser (F [Blocks], [Alignment], [Int])

1241+ -> MarkdownParser ([Blocks], [Alignment], [Int])

1227gridTableHeader headless = try $ do

1242gridTableHeader headless = try $ do

1228 optional blanklines

1243 optional blanklines

1229 dashes <- gridDashedLines '-'

1244 dashes <- gridDashedLines '-'

@@ -1243,7 +1258,7 @@ gridTableHeader headless = try $ do

1243 then replicate (length dashes) ""

1258 then replicate (length dashes) ""

1244 else map (unlines . map trim) $ transpose

1259 else map (unlines . map trim) $ transpose

1245 $ map (gridTableSplitLine indices) rawContent

1260 $ map (gridTableSplitLine indices) rawContent

1246− heads <- fmap sequence $ mapM (parseFromString parseBlocks . trim) rawHeads

1261+ heads <- mapM (parseFromString parseBlocks . trim) rawHeads

1247 return (heads, aligns, indices)

1262 return (heads, aligns, indices)

1248

1263

1249gridTableRawLine :: [Int] -> MarkdownParser [String]

1264gridTableRawLine :: [Int] -> MarkdownParser [String]

@@ -1254,12 +1269,12 @@ gridTableRawLine indices = do

1254

1269

1255-- | Parse row of grid table.

1270-- | Parse row of grid table.

1256gridTableRow :: [Int]

1271gridTableRow :: [Int]

1257− -> MarkdownParser (F [Blocks])

1272+ -> MarkdownParser [Blocks]

1258gridTableRow indices = do

1273gridTableRow indices = do

1259 colLines <- many1 (gridTableRawLine indices)

1274 colLines <- many1 (gridTableRawLine indices)

1260 let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $

1275 let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $

1261 transpose colLines

1276 transpose colLines

1262− fmap compactify' <$> fmap sequence (mapM (parseFromString parseBlocks) cols)

1277+ compactify' <$> (mapM (parseFromString parseBlocks) cols)

1263

1278

1264removeOneLeadingSpace :: [String] -> [String]

1279removeOneLeadingSpace :: [String] -> [String]

1265removeOneLeadingSpace xs =

1280removeOneLeadingSpace xs =

@@ -1285,11 +1300,9 @@ pipeBreak = try $ do

1285 blankline

1300 blankline

1286 return (first:rest)

1301 return (first:rest)

1287

1302

1288−pipeTable :: MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])

1303+pipeTable :: MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])

1289pipeTable = try $ do

1304pipeTable = try $ do

1290− (heads,aligns) <- pipeTableRow >>= \row ->

1305+ (heads,aligns) <- (,) <$> pipeTableRow <*> pipeBreak

1291− pipeBreak >>= \als ->

1292− return (row, als)

1293 lines' <- sequence <$> many1 pipeTableRow

1306 lines' <- sequence <$> many1 pipeTableRow

1294 let widths = replicate (length aligns) 0.0

1307 let widths = replicate (length aligns) 0.0

1295 return $ (aligns, widths, heads, lines')

1308 return $ (aligns, widths, heads, lines')

@@ -1300,7 +1313,7 @@ sepPipe = try $ do

1300 notFollowedBy blankline

1313 notFollowedBy blankline

1301

1314

1302-- parse a row, also returning probable alignments for org-table cells

1315-- parse a row, also returning probable alignments for org-table cells

1303−pipeTableRow :: MarkdownParser (F [Blocks])

1316+pipeTableRow :: MarkdownParser [Blocks]

1304pipeTableRow = do

1317pipeTableRow = do

1305 nonindentSpaces

1318 nonindentSpaces

1306 openPipe <- (True <$ char '|') <|> return False

1319 openPipe <- (True <$ char '|') <|> return False

@@ -1312,16 +1325,14 @@ pipeTableRow = do

1312 guard $ not (null rest && not openPipe)

1325 guard $ not (null rest && not openPipe)

1313 optional (char '|')

1326 optional (char '|')

1314 blankline

1327 blankline

1315− let cells = sequence (first:rest)

1328+ let cells = first:rest

1316− return $ do

1329+ return $

1317− cells' <- cells

1318− return $ map

1319− (\ils ->

1330+ map (\ils ->

1320 case trimInlines ils of

1331 case trimInlines ils of

1321 ils' | B.isNull ils' -> mempty

1332 ils' | B.isNull ils' -> mempty

1322− | otherwise -> B.plain $ ils') cells'

1333+ | otherwise -> B.plain $ ils') cells

1323

1334

1324−pipeTableHeaderPart :: Parser [Char] st Alignment

1335+pipeTableHeaderPart :: Monad m => ParserT [Char] st m Alignment

1325pipeTableHeaderPart = try $ do

1336pipeTableHeaderPart = try $ do

1326 skipMany spaceChar

1337 skipMany spaceChar

1327 left <- optionMaybe (char ':')

1338 left <- optionMaybe (char ':')

@@ -1336,7 +1347,7 @@ pipeTableHeaderPart = try $ do

1336 (Just _,Just _) -> AlignCenter

1347 (Just _,Just _) -> AlignCenter

1337

1348

1338-- Succeed only if current line contains a pipe.

1349-- Succeed only if current line contains a pipe.

1339−scanForPipe :: Parser [Char] st ()

1350+scanForPipe :: Monad m => ParserT [Char] st m ()

1340scanForPipe = do

1351scanForPipe = do

1341 inp <- getInput

1352 inp <- getInput

1342 case break (\c -> c == '\n' || c == '|') inp of

1353 case break (\c -> c == '\n' || c == '|') inp of

@@ -1346,14 +1357,14 @@ scanForPipe = do

1346-- | Parse a table using 'headerParser', 'rowParser',

1357-- | Parse a table using 'headerParser', 'rowParser',

1347-- 'lineParser', and 'footerParser'. Variant of the version in

1358-- 'lineParser', and 'footerParser'. Variant of the version in

1348-- Text.Pandoc.Parsing.

1359-- Text.Pandoc.Parsing.

1349−tableWith :: MarkdownParser (F [Blocks], [Alignment], [Int])

1360+tableWith :: MarkdownParser ([Blocks], [Alignment], [Int])

1350− -> ([Int] -> MarkdownParser (F [Blocks]))

1361+ -> ([Int] -> MarkdownParser [Blocks])

1351 -> MarkdownParser sep

1362 -> MarkdownParser sep

1352 -> MarkdownParser end

1363 -> MarkdownParser end

1353− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])

1364+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])

1354tableWith headerParser rowParser lineParser footerParser = try $ do

1365tableWith headerParser rowParser lineParser footerParser = try $ do

1355 (heads, aligns, indices) <- headerParser

1366 (heads, aligns, indices) <- headerParser

1356− lines' <- fmap sequence $ rowParser indices `sepEndBy1` lineParser

1367+ lines' <- rowParser indices `sepEndBy1` lineParser

1357 footerParser

1368 footerParser

1358 numColumns <- getOption readerColumns

1369 numColumns <- getOption readerColumns

1359 let widths = if (indices == [])

1370 let widths = if (indices == [])

@@ -1361,7 +1372,7 @@ tableWith headerParser rowParser lineParser footerParser = try $ do

1361 else widthsFromIndices numColumns indices

1372 else widthsFromIndices numColumns indices

1362 return $ (aligns, widths, heads, lines')

1373 return $ (aligns, widths, heads, lines')

1363

1374

1364−table :: MarkdownParser (F Blocks)

1375+table :: MarkdownParser Blocks

1365table = try $ do

1376table = try $ do

1366 frontCaption <- option Nothing (Just <$> tableCaption)

1377 frontCaption <- option Nothing (Just <$> tableCaption)

1367 (aligns, widths, heads, lns) <-

1378 (aligns, widths, heads, lns) <-

@@ -1376,19 +1387,15 @@ table = try $ do

1376 (gridTable False <|> gridTable True)) <?> "table"

1387 (gridTable False <|> gridTable True)) <?> "table"

1377 optional blanklines

1388 optional blanklines

1378 caption <- case frontCaption of

1389 caption <- case frontCaption of

1379− Nothing -> option (return mempty) tableCaption

1390+ Nothing -> option mempty tableCaption

1380 Just c -> return c

1391 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

1386

1393

1387--

1394--

1388-- inline

1395-- inline

1389--

1396--

1390

1397

1391−inline :: MarkdownParser (F Inlines)

1398+inline :: MarkdownParser Inlines

1392inline = choice [ whitespace

1399inline = choice [ whitespace

1393 , bareURL

1400 , bareURL

1394 , str

1401 , str

@@ -1411,7 +1418,7 @@ inline = choice [ whitespace

1411 , rawLaTeXInline'

1418 , rawLaTeXInline'

1412 , exampleRef

1419 , exampleRef

1413 , smart

1420 , smart

1414− , return . B.singleton <$> charRef

1421+ , B.singleton <$> charRef

1415 , symbol

1422 , symbol

1416 , ltSign

1423 , ltSign

1417 ] <?> "inline"

1424 ] <?> "inline"

@@ -1422,43 +1429,42 @@ escapedChar' = try $ do

1422 (guardEnabled Ext_all_symbols_escapable >> satisfy (not . isAlphaNum))

1429 (guardEnabled Ext_all_symbols_escapable >> satisfy (not . isAlphaNum))

1423 <|> oneOf "\\`*_{}[]()>#+-.!~\""

1430 <|> oneOf "\\`*_{}[]()>#+-.!~\""

1424

1431

1425−escapedChar :: MarkdownParser (F Inlines)

1432+escapedChar :: MarkdownParser Inlines

1426escapedChar = do

1433escapedChar = do

1427 result <- escapedChar'

1434 result <- escapedChar'

1428 case result of

1435 case result of

1429− ' ' -> return $ return $ B.str "\160" -- "\ " is a nonbreaking space

1436+ ' ' -> return $ B.str "\160" -- "\ " is a nonbreaking space

1430 '\n' -> guardEnabled Ext_escaped_line_breaks >>

1437 '\n' -> guardEnabled Ext_escaped_line_breaks >>

1431− return (return B.linebreak) -- "\[newline]" is a linebreak

1438+ return B.linebreak -- "\[newline]" is a linebreak

1432− _ -> return $ return $ B.str [result]

1439+ _ -> return $ B.str [result]

1433

1440

1434−ltSign :: MarkdownParser (F Inlines)

1441+ltSign :: MarkdownParser Inlines

1435ltSign = do

1442ltSign = do

1436 guardDisabled Ext_raw_html

1443 guardDisabled Ext_raw_html

1437 <|> (notFollowedByHtmlCloser >> notFollowedBy' (htmlTag isBlockTag))

1444 <|> (notFollowedByHtmlCloser >> notFollowedBy' (htmlTag isBlockTag))

1438 char '<'

1445 char '<'

1439− return $ return $ B.str "<"

1446+ return $ B.str "<"

1440

1447

1441−exampleRef :: MarkdownParser (F Inlines)

1448+exampleRef :: MarkdownParser Inlines

1442exampleRef = try $ do

1449exampleRef = try $ do

1443 guardEnabled Ext_example_lists

1450 guardEnabled Ext_example_lists

1444 char '@'

1451 char '@'

1445 lab <- many1 (alphaNum <|> oneOf "-_")

1452 lab <- many1 (alphaNum <|> oneOf "-_")

1446− return $ do

1453+ st <- ask

1447− st <- askF

1448− return $ case M.lookup lab (stateExamples st) of

1454+ return $ case M.lookup lab (stateExamples st) of

1449− Just n -> B.str (show n)

1455+ Just n -> B.str (show n)

1450− Nothing -> B.str ('@':lab)

1456+ Nothing -> B.str ('@':lab)

1451

1457

1452−symbol :: MarkdownParser (F Inlines)

1458+symbol :: MarkdownParser Inlines

1453symbol = do

1459symbol = do

1454 result <- noneOf "<\\\n\t "

1460 result <- noneOf "<\\\n\t "

1455 <|> try (do lookAhead $ char '\\'

1461 <|> try (do lookAhead $ char '\\'

1456 notFollowedBy' (() <$ rawTeXBlock)

1462 notFollowedBy' (() <$ rawTeXBlock)

1457 char '\\')

1463 char '\\')

1458− return $ return $ B.str [result]

1464+ return $ B.str [result]

1459

1465

1460-- parses inline code, between n `s and n `s

1466-- parses inline code, between n `s and n `s

1461−code :: MarkdownParser (F Inlines)

1467+code :: MarkdownParser Inlines

1462code = try $ do

1468code = try $ do

1463 starts <- many1 (char '`')

1469 starts <- many1 (char '`')

1464 skipSpaces

1470 skipSpaces

@@ -1468,16 +1474,16 @@ code = try $ do

1468 notFollowedBy (char '`')))

1474 notFollowedBy (char '`')))

1469 attr <- option ([],[],[]) (try $ guardEnabled Ext_inline_code_attributes >>

1475 attr <- option ([],[],[]) (try $ guardEnabled Ext_inline_code_attributes >>

1470 optional whitespace >> attributes)

1476 optional whitespace >> attributes)

1471− return $ return $ B.codeWith attr $ trim $ concat result

1477+ return $ B.codeWith attr $ trim $ concat result

1472

1478

1473−math :: MarkdownParser (F Inlines)

1479+math :: MarkdownParser Inlines

1474−math = (return . B.displayMath <$> (mathDisplay >>= applyMacros'))

1480+math = (B.displayMath <$> (mathDisplay >>= applyMacros'))

1475− <|> (return . B.math <$> (mathInline >>= applyMacros'))

1481+ <|> (B.math <$> (mathInline >>= applyMacros'))

1476

1482

1477-- Parses material enclosed in *s, **s, _s, or __s.

1483-- Parses material enclosed in *s, **s, _s, or __s.

1478-- Designed to avoid backtracking.

1484-- Designed to avoid backtracking.

1479enclosure :: Char

1485enclosure :: Char

1480− -> MarkdownParser (F Inlines)

1486+ -> MarkdownParser Inlines

1481enclosure c = do

1487enclosure c = do

1482 -- we can't start an enclosure with _ if after a string and

1488 -- we can't start an enclosure with _ if after a string and

1483 -- the intraword_underscores extension is enabled:

1489 -- the intraword_underscores extension is enabled:

@@ -1485,13 +1491,13 @@ enclosure c = do

1485 <|> guard (c == '*')

1491 <|> guard (c == '*')

1486 <|> (guard =<< notAfterString)

1492 <|> (guard =<< notAfterString)

1487 cs <- many1 (char c)

1493 cs <- many1 (char c)

1488− (return (B.str cs) <>) <$> whitespace

1494+ ((B.str cs) <>) <$> whitespace

1489 <|> do

1495 <|> do

1490 case length cs of

1496 case length cs of

1491 3 -> three c

1497 3 -> three c

1492 2 -> two c mempty

1498 2 -> two c mempty

1493 1 -> one c mempty

1499 1 -> one c mempty

1494− _ -> return (return $ B.str cs)

1500+ _ -> return $ B.str cs

1495

1501

1496ender :: Char -> Int -> MarkdownParser ()

1502ender :: Char -> Int -> MarkdownParser ()

1497ender c n = try $ do

1503ender c n = try $ do

@@ -1504,74 +1510,74 @@ ender c n = try $ do

1504-- If one c, emit emph and then parse two.

1510-- If one c, emit emph and then parse two.

1505-- If two cs, emit strong and then parse one.

1511-- If two cs, emit strong and then parse one.

1506-- Otherwise, emit ccc then the results.

1512-- Otherwise, emit ccc then the results.

1507−three :: Char -> MarkdownParser (F Inlines)

1513+three :: Char -> MarkdownParser Inlines

1508three c = do

1514three c = do

1509 contents <- mconcat <$> many (notFollowedBy (ender c 1) >> inline)

1515 contents <- mconcat <$> many (notFollowedBy (ender c 1) >> inline)

1510− (ender c 3 >> return ((B.strong . B.emph) <$> contents))

1516+ (ender c 3 >> return ((B.strong . B.emph) contents))

1511− <|> (ender c 2 >> one c (B.strong <$> contents))

1517+ <|> (ender c 2 >> one c (B.strong contents))

1512− <|> (ender c 1 >> two c (B.emph <$> contents))

1518+ <|> (ender c 1 >> two c (B.emph contents))

1513− <|> return (return (B.str [c,c,c]) <> contents)

1519+ <|> return ((B.str [c,c,c]) <> contents)

1514

1520

1515-- Parse inlines til you hit two c's, and emit strong.

1521-- Parse inlines til you hit two c's, and emit strong.

1516-- If you never do hit two cs, emit ** plus inlines parsed.

1522-- 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

1518two c prefix' = do

1524two c prefix' = do

1519 contents <- mconcat <$> many (try $ notFollowedBy (ender c 2) >> inline)

1525 contents <- mconcat <$> many (try $ notFollowedBy (ender c 2) >> inline)

1520− (ender c 2 >> return (B.strong <$> (prefix' <> contents)))

1526+ (ender c 2 >> return (B.strong (prefix' <> contents)))

1521− <|> return (return (B.str [c,c]) <> (prefix' <> contents))

1527+ <|> return ((B.str [c,c]) <> (prefix' <> contents))

1522

1528

1523-- Parse inlines til you hit a c, and emit emph.

1529-- Parse inlines til you hit a c, and emit emph.

1524-- If you never hit a c, emit * plus inlines parsed.

1530-- If you never hit a c, emit * plus inlines parsed.

1525−one :: Char -> F Inlines -> MarkdownParser (F Inlines)

1531+one :: Char -> Inlines -> MarkdownParser Inlines

1526one c prefix' = do

1532one c prefix' = do

1527 contents <- mconcat <$> many ( (notFollowedBy (ender c 1) >> inline)

1533 contents <- mconcat <$> many ( (notFollowedBy (ender c 1) >> inline)

1528 <|> try (string [c,c] >>

1534 <|> try (string [c,c] >>

1529 notFollowedBy (ender c 1) >>

1535 notFollowedBy (ender c 1) >>

1530 two c mempty) )

1536 two c mempty) )

1531− (ender c 1 >> return (B.emph <$> (prefix' <> contents)))

1537+ (ender c 1 >> return (B.emph (prefix' <> contents)))

1532− <|> return (return (B.str [c]) <> (prefix' <> contents))

1538+ <|> return ((B.str [c]) <> (prefix' <> contents))

1533

1539

1534−strongOrEmph :: MarkdownParser (F Inlines)

1540+strongOrEmph :: MarkdownParser Inlines

1535strongOrEmph = enclosure '*' <|> enclosure '_'

1541strongOrEmph = enclosure '*' <|> enclosure '_'

1536

1542

1537−-- | Parses a list of inlines between start and end delimiters.

1543+-- | Parses a list oInlines between start and end delimiters.

1538inlinesBetween :: (Show b)

1544inlinesBetween :: (Show b)

1539 => MarkdownParser a

1545 => MarkdownParser a

1540 -> MarkdownParser b

1546 -> MarkdownParser b

1541− -> MarkdownParser (F Inlines)

1547+ -> MarkdownParser Inlines

1542inlinesBetween start end =

1548inlinesBetween start end =

1543− (trimInlinesF . mconcat) <$> try (start >> many1Till inner end)

1549+ (trimInlines . mconcat) <$> try (start >> many1Till inner end)

1544 where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline)

1550 where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline)

1545 innerSpace = try $ whitespace <* notFollowedBy' end

1551 innerSpace = try $ whitespace <* notFollowedBy' end

1546

1552

1547−strikeout :: MarkdownParser (F Inlines)

1553+strikeout :: MarkdownParser Inlines

1548−strikeout = fmap B.strikeout <$>

1554+strikeout = B.strikeout <$>

1549 (guardEnabled Ext_strikeout >> inlinesBetween strikeStart strikeEnd)

1555 (guardEnabled Ext_strikeout >> inlinesBetween strikeStart strikeEnd)

1550 where strikeStart = string "~~" >> lookAhead nonspaceChar

1556 where strikeStart = string "~~" >> lookAhead nonspaceChar

1551 >> notFollowedBy (char '~')

1557 >> notFollowedBy (char '~')

1552 strikeEnd = try $ string "~~"

1558 strikeEnd = try $ string "~~"

1553

1559

1554−superscript :: MarkdownParser (F Inlines)

1560+superscript :: MarkdownParser Inlines

1555−superscript = fmap B.superscript <$> try (do

1561+superscript = B.superscript <$> try (do

1556 guardEnabled Ext_superscript

1562 guardEnabled Ext_superscript

1557 char '^'

1563 char '^'

1558 mconcat <$> many1Till (notFollowedBy spaceChar >> inline) (char '^'))

1564 mconcat <$> many1Till (notFollowedBy spaceChar >> inline) (char '^'))

1559

1565

1560−subscript :: MarkdownParser (F Inlines)

1566+subscript :: MarkdownParser Inlines

1561−subscript = fmap B.subscript <$> try (do

1567+subscript = B.subscript <$> try (do

1562 guardEnabled Ext_subscript

1568 guardEnabled Ext_subscript

1563 char '~'

1569 char '~'

1564 mconcat <$> many1Till (notFollowedBy spaceChar >> inline) (char '~'))

1570 mconcat <$> many1Till (notFollowedBy spaceChar >> inline) (char '~'))

1565

1571

1566−whitespace :: MarkdownParser (F Inlines)

1572+whitespace :: MarkdownParser Inlines

1567−whitespace = spaceChar >> return <$> (lb <|> regsp) <?> "whitespace"

1573+whitespace = spaceChar >> (lb <|> regsp) <?> "whitespace"

1568 where lb = spaceChar >> skipMany spaceChar >> option B.space (endline >> return B.linebreak)

1574 where lb = spaceChar >> skipMany spaceChar >> option B.space (endline >> return B.linebreak)

1569 regsp = skipMany spaceChar >> return B.space

1575 regsp = skipMany spaceChar >> return B.space

1570

1576

1571−nonEndline :: Parser [Char] st Char

1577+nonEndline :: Monad m => ParserT [Char] st m Char

1572nonEndline = satisfy (/='\n')

1578nonEndline = satisfy (/='\n')

1573

1579

1574−str :: MarkdownParser (F Inlines)

1580+str :: MarkdownParser Inlines

1575str = do

1581str = do

1576 result <- many1 alphaNum

1582 result <- many1 alphaNum

1577 updateLastStrPos

1583 updateLastStrPos

@@ -1579,14 +1585,14 @@ str = do

1579 isSmart <- getOption readerSmart

1585 isSmart <- getOption readerSmart

1580 if isSmart

1586 if isSmart

1581 then case likelyAbbrev result of

1587 then case likelyAbbrev result of

1582− [] -> return $ return $ B.str result

1588+ [] -> return $ B.str result

1583 xs -> choice (map (\x ->

1589 xs -> choice (map (\x ->

1584 try (string x >> oneOf " \n" >>

1590 try (string x >> oneOf " \n" >>

1585 lookAhead alphaNum >>

1591 lookAhead alphaNum >>

1586− return (return $ B.str

1592+ return (B.str

1587 $ result ++ spacesToNbr x ++ "\160"))) xs)

1593 $ result ++ spacesToNbr x ++ "\160"))) xs)

1588− <|> (return $ return $ B.str result)

1594+ <|> (return $ B.str result)

1589− else return $ return $ B.str result

1595+ else return $ B.str result

1590

1596

1591-- | if the string matches the beginning of an abbreviation (before

1597-- | if the string matches the beginning of an abbreviation (before

1592-- the first period, return strings that would finish the abbreviation.

1598-- the first period, return strings that would finish the abbreviation.

@@ -1601,7 +1607,7 @@ likelyAbbrev x =

1601 in map snd $ filter (\(y,_) -> y == x) abbrPairs

1607 in map snd $ filter (\(y,_) -> y == x) abbrPairs

1602

1608

1603-- an endline character that can be treated as a space, not a structural break

1609-- an endline character that can be treated as a space, not a structural break

1604−endline :: MarkdownParser (F Inlines)

1610+endline :: MarkdownParser Inlines

1605endline = try $ do

1611endline = try $ do

1606 newline

1612 newline

1607 notFollowedBy blankline

1613 notFollowedBy blankline

@@ -1614,18 +1620,18 @@ endline = try $ do

1614 notFollowedBy (() <$ (lookAhead (char '`') >> codeBlockFenced))

1620 notFollowedBy (() <$ (lookAhead (char '`') >> codeBlockFenced))

1615 notFollowedByHtmlCloser

1621 notFollowedByHtmlCloser

1616 (eof >> return mempty)

1622 (eof >> return mempty)

1617− <|> (guardEnabled Ext_hard_line_breaks >> return (return B.linebreak))

1623+ <|> (guardEnabled Ext_hard_line_breaks >> return B.linebreak)

1618 <|> (guardEnabled Ext_ignore_line_breaks >> return mempty)

1624 <|> (guardEnabled Ext_ignore_line_breaks >> return mempty)

1619− <|> (return $ return B.space)

1625+ <|> (return B.space)

1620

1626

1621--

1627--

1622-- links

1628-- links

1623--

1629--

1624

1630

1625-- a reference label for a link

1631-- a reference label for a link

1626−reference :: MarkdownParser (F Inlines, String)

1632+reference :: MarkdownParser (Inlines, String)

1627reference = do notFollowedBy' (string "[^") -- footnote reference

1633reference = do notFollowedBy' (string "[^") -- footnote reference

1628− withRaw $ trimInlinesF <$> inlinesInBalancedBrackets

1634+ withRaw $ trimInlines <$> inlinesInBalancedBrackets

1629

1635

1630parenthesizedChars :: MarkdownParser [Char]

1636parenthesizedChars :: MarkdownParser [Char]

1631parenthesizedChars = do

1637parenthesizedChars = do

@@ -1653,7 +1659,7 @@ source = do

1653linkTitle :: MarkdownParser String

1659linkTitle :: MarkdownParser String

1654linkTitle = quotedTitle '"' <|> quotedTitle '\''

1660linkTitle = quotedTitle '"' <|> quotedTitle '\''

1655

1661

1656−link :: MarkdownParser (F Inlines)

1662+link :: MarkdownParser Inlines

1657link = try $ do

1663link = try $ do

1658 st <- getState

1664 st <- getState

1659 guard $ stateAllowLinks st

1665 guard $ stateAllowLinks st

@@ -1663,14 +1669,14 @@ link = try $ do

1663 regLink B.link lab <|> referenceLink B.link (lab,raw)

1669 regLink B.link lab <|> referenceLink B.link (lab,raw)

1664

1670

1665regLink :: (String -> String -> Inlines -> Inlines)

1671regLink :: (String -> String -> Inlines -> Inlines)

1666− -> F Inlines -> MarkdownParser (F Inlines)

1672+ -> Inlines -> MarkdownParser Inlines

1667regLink constructor lab = try $ do

1673regLink constructor lab = try $ do

1668 (src, tit) <- source

1674 (src, tit) <- source

1669− return $ constructor src tit <$> lab

1675+ return $ constructor src tit lab

1670

1676

1671-- a link like [this][ref] or [this][] or [this]

1677-- a link like [this][ref] or [this][] or [this]

1672referenceLink :: (String -> String -> Inlines -> Inlines)

1678referenceLink :: (String -> String -> Inlines -> Inlines)

1673− -> (F Inlines, String) -> MarkdownParser (F Inlines)

1679+ -> (Inlines, String) -> MarkdownParser Inlines

1674referenceLink constructor (lab, raw) = do

1680referenceLink constructor (lab, raw) = do

1675 sp <- (True <$ lookAhead (char ' ')) <|> return False

1681 sp <- (True <$ lookAhead (char ' ')) <|> return False

1676 (ref,raw') <- option (mempty, "") $

1682 (ref,raw') <- option (mempty, "") $

@@ -1684,24 +1690,22 @@ referenceLink constructor (lab, raw) = do

1684 fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw

1690 fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw

1685 implicitHeaderRefs <- option False $

1691 implicitHeaderRefs <- option False $

1686 True <$ guardEnabled Ext_implicit_header_references

1692 True <$ guardEnabled Ext_implicit_header_references

1687− let makeFallback = do

1693+ let makeFallback =

1688− parsedRaw' <- parsedRaw

1689− fallback' <- fallback

1690− return $ B.str "[" <> fallback' <> B.str "]" <>

1694+ B.str "[" <> fallback <> B.str "]" <>

1691 (if sp && not (null raw) then B.space else mempty) <>

1695 (if sp && not (null raw) then B.space else mempty) <>

1692− parsedRaw'

1696+ parsedRaw

1693− return $ do

1694− keys <- asksF stateKeys

1697+ keys <- asks stateKeys

1698+ headers <- asks stateHeaders

1699+ return $

1695− case M.lookup key keys of

1700+ case M.lookup key keys of

1696− Nothing -> do

1701+ Nothing ->

1697− headers <- asksF stateHeaders

1698− ref' <- if labIsRef then lab else ref

1702+ let ref' = if labIsRef then lab else ref in

1699− if implicitHeaderRefs

1703+ if implicitHeaderRefs

1700− then case M.lookup ref' headers of

1704+ then case M.lookup ref' headers of

1701− Just ident -> constructor ('#':ident) "" <$> lab

1705+ Just ident -> constructor ('#':ident) "" lab

1702− Nothing -> makeFallback

1706+ Nothing -> makeFallback

1703− else makeFallback

1707+ else makeFallback

1704− Just (src,tit) -> constructor src tit <$> lab

1708+ Just (src,tit) -> constructor src tit lab

1705

1709

1706dropBrackets :: String -> String

1710dropBrackets :: String -> String

1707dropBrackets = reverse . dropRB . reverse . dropLB

1711dropBrackets = reverse . dropRB . reverse . dropLB

@@ -1710,14 +1714,14 @@ dropBrackets = reverse . dropRB . reverse . dropLB

1710 dropLB ('[':xs) = xs

1714 dropLB ('[':xs) = xs

1711 dropLB xs = xs

1715 dropLB xs = xs

1712

1716

1713−bareURL :: MarkdownParser (F Inlines)

1717+bareURL :: MarkdownParser Inlines

1714bareURL = try $ do

1718bareURL = try $ do

1715 guardEnabled Ext_autolink_bare_uris

1719 guardEnabled Ext_autolink_bare_uris

1716 (orig, src) <- uri <|> emailAddress

1720 (orig, src) <- uri <|> emailAddress

1717 notFollowedBy $ try $ spaces >> htmlTag (~== TagClose "a")

1721 notFollowedBy $ try $ spaces >> htmlTag (~== TagClose "a")

1718− return $ return $ B.link src "" (B.str orig)

1722+ return $ B.link src "" (B.str orig)

1719

1723

1720−autoLink :: MarkdownParser (F Inlines)

1724+autoLink :: MarkdownParser Inlines

1721autoLink = try $ do

1725autoLink = try $ do

1722 char '<'

1726 char '<'

1723 (orig, src) <- uri <|> emailAddress

1727 (orig, src) <- uri <|> emailAddress

@@ -1726,9 +1730,9 @@ autoLink = try $ do

1726 -- final punctuation. for example: in `<http://hi---there>`,

1730 -- final punctuation. for example: in `<http://hi---there>`,

1727 -- the URI parser will stop before the dashes.

1731 -- the URI parser will stop before the dashes.

1728 extra <- fromEntities <$> manyTill nonspaceChar (char '>')

1732 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)

1730

1734

1731−image :: MarkdownParser (F Inlines)

1735+image :: MarkdownParser Inlines

1732image = try $ do

1736image = try $ do

1733 char '!'

1737 char '!'

1734 (lab,raw) <- reference

1738 (lab,raw) <- reference

@@ -1738,38 +1742,33 @@ image = try $ do

1738 _ -> B.image src

1742 _ -> B.image src

1739 regLink constructor lab <|> referenceLink constructor (lab,raw)

1743 regLink constructor lab <|> referenceLink constructor (lab,raw)

1740

1744

1741−note :: MarkdownParser (F Inlines)

1745+note :: MarkdownParser Inlines

1742note = try $ do

1746note = try $ do

1743 guardEnabled Ext_footnotes

1747 guardEnabled Ext_footnotes

1748+ (stateInFootnote <$> getState) >>= guard . not

1744 ref <- noteMarker

1749 ref <- noteMarker

1745− return $ do

1746− notes <- asksF stateNotes'

1750+ notes <- asks stateNotes'

1751+ return $

1747 case lookup ref notes of

1752 case lookup ref notes of

1748− Nothing -> return $ B.str $ "[^" ++ ref ++ "]"

1753+ Nothing -> B.str $ "[^" ++ ref ++ "]"

1749− Just contents -> do

1754+ Just contents -> B.note contents

1750− st <- askF

1755+

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)

1756+inlineNote :: MarkdownParser Inlines

1758inlineNote = try $ do

1757inlineNote = try $ do

1759 guardEnabled Ext_inline_notes

1758 guardEnabled Ext_inline_notes

1760 char '^'

1759 char '^'

1761 contents <- inlinesInBalancedBrackets

1760 contents <- inlinesInBalancedBrackets

1762− return $ B.note . B.para <$> contents

1761+ return . B.note . B.para $ contents

1763

1762

1764−rawLaTeXInline' :: MarkdownParser (F Inlines)

1763+rawLaTeXInline' :: MarkdownParser Inlines

1765rawLaTeXInline' = try $ do

1764rawLaTeXInline' = try $ do

1766 guardEnabled Ext_raw_tex

1765 guardEnabled Ext_raw_tex

1767 lookAhead $ char '\\' >> notFollowedBy' (string "start") -- context env

1766 lookAhead $ char '\\' >> notFollowedBy' (string "start") -- context env

1768− RawInline _ s <- rawLaTeXInline

1767+ RawInline _ s <- generalize rawLaTeXInline

1769− return $ return $ B.rawInline "tex" s

1768+ return $ B.rawInline "tex" s

1770 -- "tex" because it might be context or latex

1769 -- "tex" because it might be context or latex

1771

1770

1772−rawConTeXtEnvironment :: Parser [Char] st String

1771+rawConTeXtEnvironment :: Monad m => ParserT [Char] st m String

1773rawConTeXtEnvironment = try $ do

1772rawConTeXtEnvironment = try $ do

1774 string "\\start"

1773 string "\\start"

1775 completion <- inBrackets (letter <|> digit <|> spaceChar)

1774 completion <- inBrackets (letter <|> digit <|> spaceChar)

@@ -1778,14 +1777,14 @@ rawConTeXtEnvironment = try $ do

1778 (try $ string "\\stop" >> string completion)

1777 (try $ string "\\stop" >> string completion)

1779 return $ "\\start" ++ completion ++ concat contents ++ "\\stop" ++ completion

1778 return $ "\\start" ++ completion ++ concat contents ++ "\\stop" ++ completion

1780

1779

1781−inBrackets :: (Parser [Char] st Char) -> Parser [Char] st String

1780+inBrackets :: Monad m => (ParserT [Char] st m Char) -> ParserT [Char] st m String

1782inBrackets parser = do

1781inBrackets parser = do

1783 char '['

1782 char '['

1784 contents <- many parser

1783 contents <- many parser

1785 char ']'

1784 char ']'

1786 return $ "[" ++ contents ++ "]"

1785 return $ "[" ++ contents ++ "]"

1787

1786

1788−spanHtml :: MarkdownParser (F Inlines)

1787+spanHtml :: MarkdownParser Inlines

1789spanHtml = try $ do

1788spanHtml = try $ do

1790 guardEnabled Ext_native_spans

1789 guardEnabled Ext_native_spans

1791 (TagOpen _ attrs, _) <- htmlTag (~== TagOpen "span" [])

1790 (TagOpen _ attrs, _) <- htmlTag (~== TagOpen "span" [])

@@ -1797,10 +1796,10 @@ spanHtml = try $ do

1797 Just s | null ident && null classes &&

1796 Just s | null ident && null classes &&

1798 map toLower (filter (`notElem` " \t;") s) ==

1797 map toLower (filter (`notElem` " \t;") s) ==

1799 "font-variant:small-caps"

1798 "font-variant:small-caps"

1800− -> return $ B.smallcaps <$> contents

1799+ -> return $ B.smallcaps contents

1801− _ -> return $ B.spanWith (ident, classes, keyvals) <$> contents

1800+ _ -> return $ B.spanWith (ident, classes, keyvals) contents

1802

1801

1803−divHtml :: MarkdownParser (F Blocks)

1802+divHtml :: MarkdownParser Blocks

1804divHtml = try $ do

1803divHtml = try $ do

1805 guardEnabled Ext_native_divs

1804 guardEnabled Ext_native_divs

1806 (TagOpen _ attrs, rawtag) <- htmlTag (~== TagOpen "div" [])

1805 (TagOpen _ attrs, rawtag) <- htmlTag (~== TagOpen "div" [])

@@ -1818,11 +1817,11 @@ divHtml = try $ do

1818 let ident = fromMaybe "" $ lookup "id" attrs

1817 let ident = fromMaybe "" $ lookup "id" attrs

1819 let classes = maybe [] words $ lookup "class" attrs

1818 let classes = maybe [] words $ lookup "class" attrs

1820 let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]

1819 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

1822 else -- avoid backtracing

1821 else -- avoid backtracing

1823− return $ return (B.rawBlock "html" (rawtag <> bls)) <> contents

1822+ return $ (B.rawBlock "html" (rawtag <> bls)) <> contents

1824

1823

1825−rawHtmlInline :: MarkdownParser (F Inlines)

1824+rawHtmlInline :: MarkdownParser Inlines

1826rawHtmlInline = do

1825rawHtmlInline = do

1827 guardEnabled Ext_raw_html

1826 guardEnabled Ext_raw_html

1828 inHtmlBlock <- stateInHtmlBlock <$> getState

1827 inHtmlBlock <- stateInHtmlBlock <$> getState

@@ -1837,19 +1836,19 @@ rawHtmlInline = do

1837 then (\x -> isInlineTag x &&

1836 then (\x -> isInlineTag x &&

1838 not (isCloseBlockTag x))

1837 not (isCloseBlockTag x))

1839 else not . isTextTag

1838 else not . isTextTag

1840− return $ return $ B.rawInline "html" result

1839+ return $ B.rawInline "html" result

1841

1840

1842-- Citations

1841-- Citations

1843

1842

1844−cite :: MarkdownParser (F Inlines)

1843+cite :: MarkdownParser Inlines

1845cite = do

1844cite = do

1846 guardEnabled Ext_citations

1845 guardEnabled Ext_citations

1847 citations <- textualCite

1846 citations <- textualCite

1848 <|> do (cs, raw) <- withRaw normalCite

1847 <|> do (cs, raw) <- withRaw normalCite

1849− return $ (flip B.cite (B.text raw)) <$> cs

1848+ return $ (flip B.cite (B.text raw)) cs

1850 return citations

1849 return citations

1851

1850

1852−textualCite :: MarkdownParser (F Inlines)

1851+textualCite :: MarkdownParser Inlines

1853textualCite = try $ do

1852textualCite = try $ do

1854 (_, key) <- citeKey

1853 (_, key) <- citeKey

1855 let first = Citation{ citationId = key

1854 let first = Citation{ citationId = key

@@ -1863,29 +1862,26 @@ textualCite = try $ do

1863 case mbrest of

1862 case mbrest of

1864 Just (rest, raw) ->

1863 Just (rest, raw) ->

1865 return $ (flip B.cite (B.text $ '@':key ++ " " ++ raw) . (first:))

1864 return $ (flip B.cite (B.text $ '@':key ++ " " ++ raw) . (first:))

1866− <$> rest

1865+ rest

1867 Nothing ->

1866 Nothing ->

1868 (do (cs, raw) <- withRaw $ bareloc first

1867 (do (cs, raw) <- withRaw $ bareloc first

1869− return $ (flip B.cite (B.text $ '@':key ++ " " ++ raw)) <$> cs)

1868+ return $ (flip B.cite (B.text $ '@':key ++ " " ++ raw)) cs)

1870− <|> return (do st <- askF

1869+ <|> do st <- ask

1871− return $ case M.lookup key (stateExamples st) of

1870+ return $ case M.lookup key (stateExamples st) of

1872− Just n -> B.str (show n)

1871+ Just n -> B.str (show n)

1873− _ -> B.cite [first] $ B.str $ '@':key)

1872+ _ -> B.cite [first] $ B.str $ '@':key

1874

1873

1875−bareloc :: Citation -> MarkdownParser (F [Citation])

1874+bareloc :: Citation -> MarkdownParser [Citation]

1876bareloc c = try $ do

1875bareloc c = try $ do

1877 spnl

1876 spnl

1878 char '['

1877 char '['

1879 suff <- suffix

1878 suff <- suffix

1880− rest <- option (return []) $ try $ char ';' >> citeList

1879+ rest <- option [] $ try $ char ';' >> citeList

1881 spnl

1880 spnl

1882 char ']'

1881 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

1887

1883

1888−normalCite :: MarkdownParser (F [Citation])

1884+normalCite :: MarkdownParser [Citation]

1889normalCite = try $ do

1885normalCite = try $ do

1890 char '['

1886 char '['

1891 spnl

1887 spnl

@@ -1894,60 +1890,57 @@ normalCite = try $ do

1894 char ']'

1890 char ']'

1895 return citations

1891 return citations

1896

1892

1897−suffix :: MarkdownParser (F Inlines)

1893+suffix :: MarkdownParser Inlines

1898suffix = try $ do

1894suffix = try $ do

1899 hasSpace <- option False (notFollowedBy nonspaceChar >> return True)

1895 hasSpace <- option False (notFollowedBy nonspaceChar >> return True)

1900 spnl

1896 spnl

1901− rest <- trimInlinesF . mconcat <$> many (notFollowedBy (oneOf ";]") >> inline)

1897+ rest <- trimInlines . mconcat <$> many (notFollowedBy (oneOf ";]") >> inline)

1902 return $ if hasSpace

1898 return $ if hasSpace

1903− then (B.space <>) <$> rest

1899+ then B.space <> rest

1904 else rest

1900 else rest

1905

1901

1906−prefix :: MarkdownParser (F Inlines)

1902+prefix :: MarkdownParser Inlines

1907−prefix = trimInlinesF . mconcat <$>

1903+prefix = trimInlines . mconcat <$>

1908 manyTill inline (char ']' <|> liftM (const ']') (lookAhead citeKey))

1904 manyTill inline (char ']' <|> liftM (const ']') (lookAhead citeKey))

1909

1905

1910−citeList :: MarkdownParser (F [Citation])

1906+citeList :: MarkdownParser [Citation]

1911−citeList = fmap sequence $ sepBy1 citation (try $ char ';' >> spnl)

1907+citeList = sepBy1 citation (try $ char ';' >> spnl)

1912

1908

1913−citation :: MarkdownParser (F Citation)

1909+citation :: MarkdownParser (Citation)

1914citation = try $ do

1910citation = try $ do

1915 pref <- prefix

1911 pref <- prefix

1916 (suppress_author, key) <- citeKey

1912 (suppress_author, key) <- citeKey

1917 suff <- suffix

1913 suff <- suffix

1918− return $ do

1919− x <- pref

1920− y <- suff

1921− return $ Citation{ citationId = key

1914+ return $ Citation{ citationId = key

1922− , citationPrefix = B.toList x

1915+ , citationPrefix = B.toList pref

1923− , citationSuffix = B.toList y

1916+ , citationSuffix = B.toList suff

1924− , citationMode = if suppress_author

1917+ , citationMode = if suppress_author

1925− then SuppressAuthor

1918+ then SuppressAuthor

1926− else NormalCitation

1919+ else NormalCitation

1927− , citationNoteNum = 0

1920+ , citationNoteNum = 0

1928− , citationHash = 0

1921+ , citationHash = 0

1929− }

1922+ }

1930−

1923+

1931−smart :: MarkdownParser (F Inlines)

1924+smart :: MarkdownParser Inlines

1932smart = do

1925smart = do

1933 getOption readerSmart >>= guard

1926 getOption readerSmart >>= guard

1934 doubleQuoted <|> singleQuoted <|>

1927 doubleQuoted <|> singleQuoted <|>

1935− choice (map (return <$>) [apostrophe, dash, ellipses])

1928+ choice [apostrophe, dash, ellipses]

1936

1929

1937−singleQuoted :: MarkdownParser (F Inlines)

1930+singleQuoted :: MarkdownParser Inlines

1938singleQuoted = try $ do

1931singleQuoted = try $ do

1939 singleQuoteStart

1932 singleQuoteStart

1940 withQuoteContext InSingleQuote $

1933 withQuoteContext InSingleQuote $

1941− fmap B.singleQuoted . trimInlinesF . mconcat <$>

1934+ B.singleQuoted . trimInlines . mconcat <$>

1942 many1Till inline singleQuoteEnd

1935 many1Till inline singleQuoteEnd

1943

1936

1944-- doubleQuoted will handle regular double-quoted sections, as well

1937-- doubleQuoted will handle regular double-quoted sections, as well

1945-- as dialogues with an open double-quote without a close double-quote

1938-- as dialogues with an open double-quote without a close double-quote

1946-- in the same paragraph.

1939-- in the same paragraph.

1947−doubleQuoted :: MarkdownParser (F Inlines)

1940+doubleQuoted :: MarkdownParser Inlines

1948doubleQuoted = try $ do

1941doubleQuoted = try $ do

1949 doubleQuoteStart

1942 doubleQuoteStart

1950 contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)

1943 contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)

1951 (withQuoteContext InDoubleQuote $ doubleQuoteEnd >> return

1944 (withQuoteContext InDoubleQuote $ doubleQuoteEnd >> return

1952− (fmap B.doubleQuoted . trimInlinesF $ contents))

1945+ (B.doubleQuoted . trimInlines $ contents))

1953− <|> (return $ return (B.str "\8220") <> contents)

1946+ <|> return ((B.str "\8220") <> contents)