8bbcff0 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Merge pull request #1414 from mpickering/general

8bbcff0John MacFarlane12 years ago

src/Text/Pandoc/Parsing.hs+178−143

compare with master

unifiedsplit

@@ -1,5 +1,8 @@

1+{-# LANGUAGE

2+ FlexibleContexts

1−{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances,

3+, GeneralizedNewtypeDeriving

4+, TypeSynonymInstances

2− FlexibleInstances#-}

5+, FlexibleInstances #-}

3{-

6{-

@@ -29,8 +32,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

30A utility library with parsers used in pandoc readers.

33A utility library with parsers used in pandoc readers.

31-}

34-}

32−module Text.Pandoc.Parsing ( (>>~),

35+module Text.Pandoc.Parsing ( anyLine,

33− anyLine,

34 many1Till,

36 many1Till,

35 notFollowedBy',

37 notFollowedBy',

36 oneOfStrings,

38 oneOfStrings,

@@ -98,6 +100,7 @@ module Text.Pandoc.Parsing ( (>>~),

98 macro,

100 macro,

99 applyMacros',

101 applyMacros',

100 Parser,

102 Parser,

103+ ParserT,

101 F(..),

104 F(..),

102 runF,

105 runF,

103 askF,

106 askF,

@@ -177,12 +180,15 @@ import Text.Pandoc.Asciify (toAsciiChar)

177import Data.Default

180import Data.Default

178import qualified Data.Set as Set

181import qualified Data.Set as Set

179import Control.Monad.Reader

182import Control.Monad.Reader

183+import Control.Monad.Identity

180−import Control.Applicative ((*>), (<*), (<$), liftA2, Applicative)

184+import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$), Applicative)

181import Data.Monoid

185import Data.Monoid

182import Data.Maybe (catMaybes)

186import Data.Maybe (catMaybes)

183

187

184type Parser t s = Parsec t s

188type Parser t s = Parsec t s

185

189

190+type ParserT = ParsecT

191+

186newtype F a = F { unF :: Reader ParserState a } deriving (Monad, Applicative, Functor)

192newtype F a = F { unF :: Reader ParserState a } deriving (Monad, Applicative, Functor)

187

193

188runF :: F a -> ParserState -> a

194runF :: F a -> ParserState -> a

@@ -199,13 +205,8 @@ instance Monoid a => Monoid (F a) where

199 mappend = liftM2 mappend

205 mappend = liftM2 mappend

200 mconcat = liftM mconcat . sequence

206 mconcat = liftM mconcat . sequence

201

207

202−-- | Like >>, but returns the operation on the left.

203−-- (Suggested by Tillmann Rendel on Haskell-cafe list.)

204−(>>~) :: (Monad m) => m a -> m b -> m a

205−a >>~ b = a >>= \x -> b >> return x

206−

207-- | Parse any line of text

208-- | Parse any line of text

208−anyLine :: Parser [Char] st [Char]

209+anyLine :: Stream [Char] m Char => ParserT [Char] st m [Char]

209anyLine = do

210anyLine = do

210 -- This is much faster than:

211 -- This is much faster than:

211 -- manyTill anyChar newline

212 -- manyTill anyChar newline

@@ -221,9 +222,10 @@ anyLine = do

221 _ -> mzero

222 _ -> mzero

222

223

223-- | Like @manyTill@, but reads at least one item.

224-- | Like @manyTill@, but reads at least one item.

224−many1Till :: Parser [tok] st a

225+many1Till :: Stream s m t

225− -> Parser [tok] st end

226+ => ParserT s st m a

226− -> Parser [tok] st [a]

227+ -> ParserT s st m end

228+ -> ParserT s st m [a]

227many1Till p end = do

229many1Till p end = do

228 first <- p

230 first <- p

229 rest <- manyTill p end

231 rest <- manyTill p end

@@ -232,21 +234,21 @@ many1Till p end = do

232-- | A more general form of @notFollowedBy@. This one allows any

234-- | A more general form of @notFollowedBy@. This one allows any

233-- type of parser to be specified, and succeeds only if that parser fails.

235-- type of parser to be specified, and succeeds only if that parser fails.

234-- It does not consume any input.

236-- It does not consume any input.

235−notFollowedBy' :: Show b => Parser [a] st b -> Parser [a] st ()

237+notFollowedBy' :: (Show b, Stream s m a) => ParserT s st m b -> ParserT s st m ()

236notFollowedBy' p = try $ join $ do a <- try p

238notFollowedBy' p = try $ join $ do a <- try p

237 return (unexpected (show a))

239 return (unexpected (show a))

238 <|>

240 <|>

239 return (return ())

241 return (return ())

240-- (This version due to Andrew Pimlott on the Haskell mailing list.)

242-- (This version due to Andrew Pimlott on the Haskell mailing list.)

241

243

242−oneOfStrings' :: (Char -> Char -> Bool) -> [String] -> Parser [Char] st String

244+oneOfStrings' :: Stream s m Char => (Char -> Char -> Bool) -> [String] -> ParserT s st m String

243oneOfStrings' _ [] = fail "no strings"

245oneOfStrings' _ [] = fail "no strings"

244oneOfStrings' matches strs = try $ do

246oneOfStrings' matches strs = try $ do

245 c <- anyChar

247 c <- anyChar

246 let strs' = [xs | (x:xs) <- strs, x `matches` c]

248 let strs' = [xs | (x:xs) <- strs, x `matches` c]

247 case strs' of

249 case strs' of

248 [] -> fail "not found"

250 [] -> fail "not found"

249− _ -> (c:) `fmap` oneOfStrings' matches strs'

251+ _ -> (c:) <$> oneOfStrings' matches strs'

250 <|> if "" `elem` strs'

252 <|> if "" `elem` strs'

251 then return [c]

253 then return [c]

252 else fail "not found"

254 else fail "not found"

@@ -254,11 +256,11 @@ oneOfStrings' matches strs = try $ do

254-- | Parses one of a list of strings. If the list contains

256-- | Parses one of a list of strings. If the list contains

255-- two strings one of which is a prefix of the other, the longer

257-- two strings one of which is a prefix of the other, the longer

256-- string will be matched if possible.

258-- string will be matched if possible.

257−oneOfStrings :: [String] -> Parser [Char] st String

259+oneOfStrings :: Stream s m Char => [String] -> ParserT s st m String

258oneOfStrings = oneOfStrings' (==)

260oneOfStrings = oneOfStrings' (==)

259

261

260-- | Parses one of a list of strings (tried in order), case insensitive.

262-- | Parses one of a list of strings (tried in order), case insensitive.

261−oneOfStringsCI :: [String] -> Parser [Char] st String

263+oneOfStringsCI :: Stream s m Char => [String] -> ParserT s st m String

262oneOfStringsCI = oneOfStrings' ciMatch

264oneOfStringsCI = oneOfStrings' ciMatch

263 where ciMatch x y = toLower' x == toLower' y

265 where ciMatch x y = toLower' x == toLower' y

264 -- this optimizes toLower by checking common ASCII case

266 -- this optimizes toLower by checking common ASCII case

@@ -269,35 +271,35 @@ oneOfStringsCI = oneOfStrings' ciMatch

269 | otherwise = toLower c

271 | otherwise = toLower c

270

272

271-- | Parses a space or tab.

273-- | Parses a space or tab.

272−spaceChar :: Parser [Char] st Char

274+spaceChar :: Stream s m Char => ParserT s st m Char

273spaceChar = satisfy $ \c -> c == ' ' || c == '\t'

275spaceChar = satisfy $ \c -> c == ' ' || c == '\t'

274

276

275-- | Parses a nonspace, nonnewline character.

277-- | Parses a nonspace, nonnewline character.

276−nonspaceChar :: Parser [Char] st Char

278+nonspaceChar :: Stream s m Char => ParserT s st m Char

277nonspaceChar = satisfy $ flip notElem ['\t', '\n', ' ', '\r']

279nonspaceChar = satisfy $ flip notElem ['\t', '\n', ' ', '\r']

278

280

279-- | Skips zero or more spaces or tabs.

281-- | Skips zero or more spaces or tabs.

280−skipSpaces :: Parser [Char] st ()

282+skipSpaces :: Stream s m Char => ParserT s st m ()

281skipSpaces = skipMany spaceChar

283skipSpaces = skipMany spaceChar

282

284

283-- | Skips zero or more spaces or tabs, then reads a newline.

285-- | Skips zero or more spaces or tabs, then reads a newline.

284−blankline :: Parser [Char] st Char

286+blankline :: Stream s m Char => ParserT s st m Char

285blankline = try $ skipSpaces >> newline

287blankline = try $ skipSpaces >> newline

286

288

287-- | Parses one or more blank lines and returns a string of newlines.

289-- | Parses one or more blank lines and returns a string of newlines.

288−blanklines :: Parser [Char] st [Char]

290+blanklines :: Stream s m Char => ParserT s st m [Char]

289blanklines = many1 blankline

291blanklines = many1 blankline

290

292

291-- | Parses material enclosed between start and end parsers.

293-- | Parses material enclosed between start and end parsers.

292−enclosed :: Parser [Char] st t -- ^ start parser

294+enclosed :: Stream s m Char => ParserT s st m t -- ^ start parser

293− -> Parser [Char] st end -- ^ end parser

295+ -> ParserT s st m end -- ^ end parser

294− -> Parser [Char] st a -- ^ content parser (to be used repeatedly)

296+ -> ParserT s st m a -- ^ content parser (to be used repeatedly)

295− -> Parser [Char] st [a]

297+ -> ParserT s st m [a]

296enclosed start end parser = try $

298enclosed start end parser = try $

297 start >> notFollowedBy space >> many1Till parser end

299 start >> notFollowedBy space >> many1Till parser end

298

300

299-- | Parse string, case insensitive.

301-- | Parse string, case insensitive.

300−stringAnyCase :: [Char] -> Parser [Char] st String

302+stringAnyCase :: Stream s m Char => [Char] -> ParserT s st m String

301stringAnyCase [] = string ""

303stringAnyCase [] = string ""

302stringAnyCase (x:xs) = do

304stringAnyCase (x:xs) = do

303 firstChar <- char (toUpper x) <|> char (toLower x)

305 firstChar <- char (toUpper x) <|> char (toLower x)

@@ -305,7 +307,7 @@ stringAnyCase (x:xs) = do

305 return (firstChar:rest)

307 return (firstChar:rest)

306

308

307-- | Parse contents of 'str' using 'parser' and return result.

309-- | Parse contents of 'str' using 'parser' and return result.

308−parseFromString :: Parser [tok] st a -> [tok] -> Parser [tok] st a

310+parseFromString :: Stream s m t => ParserT s st m a -> s -> ParserT s st m a

309parseFromString parser str = do

311parseFromString parser str = do

310 oldPos <- getPosition

312 oldPos <- getPosition

311 oldInput <- getInput

313 oldInput <- getInput

@@ -316,7 +318,7 @@ parseFromString parser str = do

316 return result

318 return result

317

319

318-- | Parse raw line block up to and including blank lines.

320-- | Parse raw line block up to and including blank lines.

319−lineClump :: Parser [Char] st String

321+lineClump :: Stream [Char] m Char => ParserT [Char] st m String

320lineClump = blanklines

322lineClump = blanklines

321 <|> (many1 (notFollowedBy blankline >> anyLine) >>= return . unlines)

323 <|> (many1 (notFollowedBy blankline >> anyLine) >>= return . unlines)

322

324

@@ -325,8 +327,8 @@ lineClump = blanklines

325-- pairs of open and close, which must be different. For example,

327-- pairs of open and close, which must be different. For example,

326-- @charsInBalanced '(' ')' anyChar@ will parse "(hello (there))"

328-- @charsInBalanced '(' ')' anyChar@ will parse "(hello (there))"

327-- and return "hello (there)".

329-- and return "hello (there)".

328−charsInBalanced :: Char -> Char -> Parser [Char] st Char

330+charsInBalanced :: Stream s m Char => Char -> Char -> ParserT s st m Char

329− -> Parser [Char] st String

331+ -> ParserT s st m String

330charsInBalanced open close parser = try $ do

332charsInBalanced open close parser = try $ do

331 char open

333 char open

332 let isDelim c = c == open || c == close

334 let isDelim c = c == open || c == close

@@ -350,8 +352,8 @@ uppercaseRomanDigits :: [Char]

350uppercaseRomanDigits = map toUpper lowercaseRomanDigits

352uppercaseRomanDigits = map toUpper lowercaseRomanDigits

351

353

352-- | Parses a roman numeral (uppercase or lowercase), returns number.

354-- | Parses a roman numeral (uppercase or lowercase), returns number.

353−romanNumeral :: Bool -- ^ Uppercase if true

355+romanNumeral :: Stream s m Char => Bool -- ^ Uppercase if true

354− -> Parser [Char] st Int

356+ -> ParserT s st m Int

355romanNumeral upperCase = do

357romanNumeral upperCase = do

356 let romanDigits = if upperCase

358 let romanDigits = if upperCase

357 then uppercaseRomanDigits

359 then uppercaseRomanDigits

@@ -383,12 +385,12 @@ romanNumeral upperCase = do

383

385

384-- | Parses an email address; returns original and corresponding

386-- | Parses an email address; returns original and corresponding

385-- escaped mailto: URI.

387-- escaped mailto: URI.

386−emailAddress :: Parser [Char] st (String, String)

388+emailAddress :: Stream s m Char => ParserT s st m (String, String)

387−emailAddress = try $ liftA2 toResult mailbox (char '@' *> domain)

389+emailAddress = try $ toResult <$> mailbox <*> (char '@' *> domain)

388 where toResult mbox dom = let full = fromEntities $ mbox ++ '@':dom

390 where toResult mbox dom = let full = fromEntities $ mbox ++ '@':dom

389 in (full, escapeURI $ "mailto:" ++ full)

391 in (full, escapeURI $ "mailto:" ++ full)

390− mailbox = intercalate "." `fmap` (emailWord `sepby1` dot)

392+ mailbox = intercalate "." <$> (emailWord `sepby1` dot)

391− domain = intercalate "." `fmap` (subdomain `sepby1` dot)

393+ domain = intercalate "." <$> (subdomain `sepby1` dot)

392 dot = char '.'

394 dot = char '.'

393 subdomain = many1 $ alphaNum <|> innerPunct

395 subdomain = many1 $ alphaNum <|> innerPunct

394 innerPunct = try (satisfy (\c -> isEmailPunct c || c == '@') <*

396 innerPunct = try (satisfy (\c -> isEmailPunct c || c == '@') <*

@@ -398,7 +400,7 @@ emailAddress = try $ liftA2 toResult mailbox (char '@' *> domain)

398 isEmailPunct c = c `elem` "!\"#$%&'*+-/=?^_{|}~;"

400 isEmailPunct c = c `elem` "!\"#$%&'*+-/=?^_{|}~;"

399 -- note: sepBy1 from parsec consumes input when sep

401 -- note: sepBy1 from parsec consumes input when sep

400 -- succeeds and p fails, so we use this variant here.

402 -- succeeds and p fails, so we use this variant here.

401− sepby1 p sep = liftA2 (:) p (many (try $ sep >> p))

403+ sepby1 p sep = (:) <$> p <*> (many (try $ sep >> p))

402

404

403

405

404-- Schemes from http://www.iana.org/assignments/uri-schemes.html plus

406-- Schemes from http://www.iana.org/assignments/uri-schemes.html plus

@@ -426,11 +428,11 @@ schemes = ["coap","doi","javascript","aaa","aaas","about","acap","cap","cid",

426 "ventrilo","view-source","webcal","wtai","wyciwyg","xfire","xri",

428 "ventrilo","view-source","webcal","wtai","wyciwyg","xfire","xri",

427 "ymsgr"]

429 "ymsgr"]

428

430

429−uriScheme :: Parser [Char] st String

431+uriScheme :: Stream s m Char => ParserT s st m String

430uriScheme = oneOfStringsCI schemes

432uriScheme = oneOfStringsCI schemes

431

433

432-- | Parses a URI. Returns pair of original and URI-escaped version.

434-- | Parses a URI. Returns pair of original and URI-escaped version.

433−uri :: Parser [Char] st (String, String)

435+uri :: Stream [Char] m Char => ParserT [Char] st m (String, String)

434uri = try $ do

436uri = try $ do

435 scheme <- uriScheme

437 scheme <- uriScheme

436 char ':'

438 char ':'

@@ -451,7 +453,7 @@ uri = try $ do

451 <|> entity

453 <|> entity

452 <|> (try $ punct >>

454 <|> (try $ punct >>

453 lookAhead (void (satisfy isWordChar) <|> percentEscaped))

455 lookAhead (void (satisfy isWordChar) <|> percentEscaped))

454− str <- snd `fmap` withRaw (skipMany1 ( () <$

456+ str <- snd <$> withRaw (skipMany1 ( () <$

455 (enclosed (char '(') (char ')') uriChunk

457 (enclosed (char '(') (char ')') uriChunk

456 <|> enclosed (char '{') (char '}') uriChunk

458 <|> enclosed (char '{') (char '}') uriChunk

457 <|> enclosed (char '[') (char ']') uriChunk)

459 <|> enclosed (char '[') (char ']') uriChunk)

@@ -460,7 +462,7 @@ uri = try $ do

460 let uri' = scheme ++ ":" ++ fromEntities str'

462 let uri' = scheme ++ ":" ++ fromEntities str'

461 return (uri', escapeURI uri')

463 return (uri', escapeURI uri')

462

464

463−mathInlineWith :: String -> String -> Parser [Char] st String

465+mathInlineWith :: Stream s m Char => String -> String -> ParserT s st m String

464mathInlineWith op cl = try $ do

466mathInlineWith op cl = try $ do

465 string op

467 string op

466 notFollowedBy space

468 notFollowedBy space

@@ -474,12 +476,12 @@ mathInlineWith op cl = try $ do

474 notFollowedBy digit -- to prevent capture of $5

476 notFollowedBy digit -- to prevent capture of $5

475 return $ concat words'

477 return $ concat words'

476

478

477−mathDisplayWith :: String -> String -> Parser [Char] st String

479+mathDisplayWith :: Stream s m Char => String -> String -> ParserT s st m String

478mathDisplayWith op cl = try $ do

480mathDisplayWith op cl = try $ do

479 string op

481 string op

480− many1Till (noneOf "\n" <|> (newline >>~ notFollowedBy' blankline)) (try $ string cl)

482+ many1Till (noneOf "\n" <|> (newline <* notFollowedBy' blankline)) (try $ string cl)

481

483

482−mathDisplay :: Parser [Char] ParserState String

484+mathDisplay :: Stream s m Char => ParserT s ParserState m String

483mathDisplay =

485mathDisplay =

484 (guardEnabled Ext_tex_math_dollars >> mathDisplayWith "$$" "$$")

486 (guardEnabled Ext_tex_math_dollars >> mathDisplayWith "$$" "$$")

485 <|> (guardEnabled Ext_tex_math_single_backslash >>

487 <|> (guardEnabled Ext_tex_math_single_backslash >>

@@ -487,7 +489,7 @@ mathDisplay =

487 <|> (guardEnabled Ext_tex_math_double_backslash >>

489 <|> (guardEnabled Ext_tex_math_double_backslash >>

488 mathDisplayWith "\\\\[" "\\\\]")

490 mathDisplayWith "\\\\[" "\\\\]")

489

491

490−mathInline :: Parser [Char] ParserState String

492+mathInline :: Stream s m Char => ParserT s ParserState m String

491mathInline =

493mathInline =

492 (guardEnabled Ext_tex_math_dollars >> mathInlineWith "$" "$")

494 (guardEnabled Ext_tex_math_dollars >> mathInlineWith "$" "$")

493 <|> (guardEnabled Ext_tex_math_single_backslash >>

495 <|> (guardEnabled Ext_tex_math_single_backslash >>

@@ -499,8 +501,9 @@ mathInline =

499-- displacement (the difference between the source column at the end

501-- displacement (the difference between the source column at the end

500-- and the source column at the beginning). Vertical displacement

502-- and the source column at the beginning). Vertical displacement

501-- (source row) is ignored.

503-- (source row) is ignored.

502−withHorizDisplacement :: Parser [Char] st a -- ^ Parser to apply

504+withHorizDisplacement :: Stream s m Char

505+ => ParserT s st m a -- ^ Parser to apply

503− -> Parser [Char] st (a, Int) -- ^ (result, displacement)

506+ -> ParserT s st m (a, Int) -- ^ (result, displacement)

504withHorizDisplacement parser = do

507withHorizDisplacement parser = do

505 pos1 <- getPosition

508 pos1 <- getPosition

506 result <- parser

509 result <- parser

@@ -509,7 +512,7 @@ withHorizDisplacement parser = do

509

512

510-- | Applies a parser and returns the raw string that was parsed,

513-- | Applies a parser and returns the raw string that was parsed,

511-- along with the value produced by the parser.

514-- along with the value produced by the parser.

512−withRaw :: Monad m => ParsecT [Char] st m a -> ParsecT [Char] st m (a, [Char])

515+withRaw :: Stream [Char] m Char => ParsecT [Char] st m a -> ParsecT [Char] st m (a, [Char])

513withRaw parser = do

516withRaw parser = do

514 pos1 <- getPosition

517 pos1 <- getPosition

515 inp <- getInput

518 inp <- getInput

@@ -525,12 +528,13 @@ withRaw parser = do

525 return (result, raw)

528 return (result, raw)

526

529

527-- | Parses backslash, then applies character parser.

530-- | Parses backslash, then applies character parser.

531+escaped :: Stream s m Char

528−escaped :: Parser [Char] st Char -- ^ Parser for character to escape

532+ => ParserT s st m Char -- ^ Parser for character to escape

529− -> Parser [Char] st Char

533+ -> ParserT s st m Char

530escaped parser = try $ char '\\' >> parser

534escaped parser = try $ char '\\' >> parser

531

535

532-- | Parse character entity.

536-- | Parse character entity.

533−characterReference :: Parser [Char] st Char

537+characterReference :: Stream s m Char => ParserT s st m Char

534characterReference = try $ do

538characterReference = try $ do

535 char '&'

539 char '&'

536 ent <- many1Till nonspaceChar (char ';')

540 ent <- many1Till nonspaceChar (char ';')

@@ -539,19 +543,19 @@ characterReference = try $ do

539 Nothing -> fail "entity not found"

543 Nothing -> fail "entity not found"

540

544

541-- | Parses an uppercase roman numeral and returns (UpperRoman, number).

545-- | Parses an uppercase roman numeral and returns (UpperRoman, number).

542−upperRoman :: Parser [Char] st (ListNumberStyle, Int)

546+upperRoman :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)

543upperRoman = do

547upperRoman = do

544 num <- romanNumeral True

548 num <- romanNumeral True

545 return (UpperRoman, num)

549 return (UpperRoman, num)

546

550

547-- | Parses a lowercase roman numeral and returns (LowerRoman, number).

551-- | Parses a lowercase roman numeral and returns (LowerRoman, number).

548−lowerRoman :: Parser [Char] st (ListNumberStyle, Int)

552+lowerRoman :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)

549lowerRoman = do

553lowerRoman = do

550 num <- romanNumeral False

554 num <- romanNumeral False

551 return (LowerRoman, num)

555 return (LowerRoman, num)

552

556

553-- | Parses a decimal numeral and returns (Decimal, number).

557-- | Parses a decimal numeral and returns (Decimal, number).

554−decimal :: Parser [Char] st (ListNumberStyle, Int)

558+decimal :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)

555decimal = do

559decimal = do

556 num <- many1 digit

560 num <- many1 digit

557 return (Decimal, read num)

561 return (Decimal, read num)

@@ -560,7 +564,8 @@ decimal = do

560-- returns (DefaultStyle, [next example number]). The next

564-- returns (DefaultStyle, [next example number]). The next

561-- example number is incremented in parser state, and the label

565-- example number is incremented in parser state, and the label

562-- (if present) is added to the label table.

566-- (if present) is added to the label table.

567+exampleNum :: Stream s m Char

563−exampleNum :: Parser [Char] ParserState (ListNumberStyle, Int)

568+ => ParserT s ParserState m (ListNumberStyle, Int)

564exampleNum = do

569exampleNum = do

565 char '@'

570 char '@'

566 lab <- many (alphaNum <|> satisfy (\c -> c == '_' || c == '-'))

571 lab <- many (alphaNum <|> satisfy (\c -> c == '_' || c == '-'))

@@ -574,38 +579,39 @@ exampleNum = do

574 return (Example, num)

579 return (Example, num)

575

580

576-- | Parses a '#' returns (DefaultStyle, 1).

581-- | Parses a '#' returns (DefaultStyle, 1).

577−defaultNum :: Parser [Char] st (ListNumberStyle, Int)

582+defaultNum :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)

578defaultNum = do

583defaultNum = do

579 char '#'

584 char '#'

580 return (DefaultStyle, 1)

585 return (DefaultStyle, 1)

581

586

582-- | Parses a lowercase letter and returns (LowerAlpha, number).

587-- | Parses a lowercase letter and returns (LowerAlpha, number).

583−lowerAlpha :: Parser [Char] st (ListNumberStyle, Int)

588+lowerAlpha :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)

584lowerAlpha = do

589lowerAlpha = do

585 ch <- oneOf ['a'..'z']

590 ch <- oneOf ['a'..'z']

586 return (LowerAlpha, ord ch - ord 'a' + 1)

591 return (LowerAlpha, ord ch - ord 'a' + 1)

587

592

588-- | Parses an uppercase letter and returns (UpperAlpha, number).

593-- | Parses an uppercase letter and returns (UpperAlpha, number).

589−upperAlpha :: Parser [Char] st (ListNumberStyle, Int)

594+upperAlpha :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)

590upperAlpha = do

595upperAlpha = do

591 ch <- oneOf ['A'..'Z']

596 ch <- oneOf ['A'..'Z']

592 return (UpperAlpha, ord ch - ord 'A' + 1)

597 return (UpperAlpha, ord ch - ord 'A' + 1)

593

598

594-- | Parses a roman numeral i or I

599-- | Parses a roman numeral i or I

595−romanOne :: Parser [Char] st (ListNumberStyle, Int)

600+romanOne :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)

596romanOne = (char 'i' >> return (LowerRoman, 1)) <|>

601romanOne = (char 'i' >> return (LowerRoman, 1)) <|>

597 (char 'I' >> return (UpperRoman, 1))

602 (char 'I' >> return (UpperRoman, 1))

598

603

599-- | Parses an ordered list marker and returns list attributes.

604-- | Parses an ordered list marker and returns list attributes.

600−anyOrderedListMarker :: Parser [Char] ParserState ListAttributes

605+anyOrderedListMarker :: Stream s m Char => ParserT s ParserState m ListAttributes

601anyOrderedListMarker = choice $

606anyOrderedListMarker = choice $

602 [delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],

607 [delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],

603 numParser <- [decimal, exampleNum, defaultNum, romanOne,

608 numParser <- [decimal, exampleNum, defaultNum, romanOne,

604 lowerAlpha, lowerRoman, upperAlpha, upperRoman]]

609 lowerAlpha, lowerRoman, upperAlpha, upperRoman]]

605

610

606-- | Parses a list number (num) followed by a period, returns list attributes.

611-- | Parses a list number (num) followed by a period, returns list attributes.

612+inPeriod :: Stream s m Char

607−inPeriod :: Parser [Char] st (ListNumberStyle, Int)

613+ => ParserT s st m (ListNumberStyle, Int)

608− -> Parser [Char] st ListAttributes

614+ -> ParserT s st m ListAttributes

609inPeriod num = try $ do

615inPeriod num = try $ do

610 (style, start) <- num

616 (style, start) <- num

611 char '.'

617 char '.'

@@ -615,16 +621,18 @@ inPeriod num = try $ do

615 return (start, style, delim)

621 return (start, style, delim)

616

622

617-- | Parses a list number (num) followed by a paren, returns list attributes.

623-- | Parses a list number (num) followed by a paren, returns list attributes.

624+inOneParen :: Stream s m Char

618−inOneParen :: Parser [Char] st (ListNumberStyle, Int)

625+ => ParserT s st m (ListNumberStyle, Int)

619− -> Parser [Char] st ListAttributes

626+ -> ParserT s st m ListAttributes

620inOneParen num = try $ do

627inOneParen num = try $ do

621 (style, start) <- num

628 (style, start) <- num

622 char ')'

629 char ')'

623 return (start, style, OneParen)

630 return (start, style, OneParen)

624

631

625-- | Parses a list number (num) enclosed in parens, returns list attributes.

632-- | Parses a list number (num) enclosed in parens, returns list attributes.

633+inTwoParens :: Stream s m Char

626−inTwoParens :: Parser [Char] st (ListNumberStyle, Int)

634+ => ParserT s st m (ListNumberStyle, Int)

627− -> Parser [Char] st ListAttributes

635+ -> ParserT s st m ListAttributes

628inTwoParens num = try $ do

636inTwoParens num = try $ do

629 char '('

637 char '('

630 (style, start) <- num

638 (style, start) <- num

@@ -633,9 +641,10 @@ inTwoParens num = try $ do

633

641

634-- | Parses an ordered list marker with a given style and delimiter,

642-- | Parses an ordered list marker with a given style and delimiter,

635-- returns number.

643-- returns number.

644+orderedListMarker :: Stream s m Char

636−orderedListMarker :: ListNumberStyle

645+ => ListNumberStyle

637 -> ListNumberDelim

646 -> ListNumberDelim

638− -> Parser [Char] ParserState Int

647+ -> ParserT s ParserState m Int

639orderedListMarker style delim = do

648orderedListMarker style delim = do

640 let num = defaultNum <|> -- # can continue any kind of list

649 let num = defaultNum <|> -- # can continue any kind of list

641 case style of

650 case style of

@@ -655,12 +664,12 @@ orderedListMarker style delim = do

655 return start

664 return start

656

665

657-- | Parses a character reference and returns a Str element.

666-- | Parses a character reference and returns a Str element.

658−charRef :: Parser [Char] st Inline

667+charRef :: Stream s m Char => ParserT s st m Inline

659charRef = do

668charRef = do

660 c <- characterReference

669 c <- characterReference

661 return $ Str [c]

670 return $ Str [c]

662

671

663−lineBlockLine :: Parser [Char] st String

672+lineBlockLine :: Stream [Char] m Char => ParserT [Char] st m String

664lineBlockLine = try $ do

673lineBlockLine = try $ do

665 char '|'

674 char '|'

666 char ' '

675 char ' '

@@ -671,7 +680,7 @@ lineBlockLine = try $ do

671 return $ white ++ unwords (line : continuations)

680 return $ white ++ unwords (line : continuations)

672

681

673-- | Parses an RST-style line block and returns a list of strings.

682-- | Parses an RST-style line block and returns a list of strings.

674−lineBlockLines :: Parser [Char] st [String]

683+lineBlockLines :: Stream [Char] m Char => ParserT [Char] st m [String]

675lineBlockLines = try $ do

684lineBlockLines = try $ do

676 lines' <- many1 lineBlockLine

685 lines' <- many1 lineBlockLine

677 skipMany1 $ blankline <|> try (char '|' >> blankline)

686 skipMany1 $ blankline <|> try (char '|' >> blankline)

@@ -679,11 +688,12 @@ lineBlockLines = try $ do

679

688

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

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

681-- 'lineParser', and 'footerParser'.

690-- 'lineParser', and 'footerParser'.

691+tableWith :: Stream s m Char

682−tableWith :: Parser [Char] ParserState ([[Block]], [Alignment], [Int])

692+ => ParserT s ParserState m ([[Block]], [Alignment], [Int])

683− -> ([Int] -> Parser [Char] ParserState [[Block]])

693+ -> ([Int] -> ParserT s ParserState m [[Block]])

684− -> Parser [Char] ParserState sep

694+ -> ParserT s ParserState m sep

685− -> Parser [Char] ParserState end

695+ -> ParserT s ParserState m end

686− -> Parser [Char] ParserState Block

696+ -> ParserT s ParserState m Block

687tableWith headerParser rowParser lineParser footerParser = try $ do

697tableWith headerParser rowParser lineParser footerParser = try $ do

688 (heads, aligns, indices) <- headerParser

698 (heads, aligns, indices) <- headerParser

689 lines' <- rowParser indices `sepEndBy1` lineParser

699 lines' <- rowParser indices `sepEndBy1` lineParser

@@ -725,9 +735,10 @@ widthsFromIndices numColumns' indices =

725-- (which may be grid), then the rows,

735-- (which may be grid), then the rows,

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

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

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

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

738+gridTableWith :: Stream [Char] m Char

728−gridTableWith :: Parser [Char] ParserState [Block] -- ^ Block list parser

739+ => ParserT [Char] ParserState m [Block] -- ^ Block list parser

729 -> Bool -- ^ Headerless table

740 -> Bool -- ^ Headerless table

730− -> Parser [Char] ParserState Block

741+ -> ParserT [Char] ParserState m Block

731gridTableWith blocks headless =

742gridTableWith blocks headless =

732 tableWith (gridTableHeader headless blocks) (gridTableRow blocks)

743 tableWith (gridTableHeader headless blocks) (gridTableRow blocks)

733 (gridTableSep '-') gridTableFooter

744 (gridTableSep '-') gridTableFooter

@@ -736,27 +747,28 @@ gridTableSplitLine :: [Int] -> String -> [String]

736gridTableSplitLine indices line = map removeFinalBar $ tail $

747gridTableSplitLine indices line = map removeFinalBar $ tail $

737 splitStringByIndices (init indices) $ trimr line

748 splitStringByIndices (init indices) $ trimr line

738

749

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

750+gridPart :: Stream s m Char => Char -> ParserT s st m (Int, Int)

740gridPart ch = do

751gridPart ch = do

741 dashes <- many1 (char ch)

752 dashes <- many1 (char ch)

742 char '+'

753 char '+'

743 return (length dashes, length dashes + 1)

754 return (length dashes, length dashes + 1)

744

755

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

756+gridDashedLines :: Stream s m Char => Char -> ParserT s st m [(Int,Int)]

746−gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) >>~ blankline

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

747

758

748removeFinalBar :: String -> String

759removeFinalBar :: String -> String

749removeFinalBar =

760removeFinalBar =

750 reverse . dropWhile (`elem` " \t") . dropWhile (=='|') . reverse

761 reverse . dropWhile (`elem` " \t") . dropWhile (=='|') . reverse

751

762

752-- | Separator between rows of grid table.

763-- | Separator between rows of grid table.

753−gridTableSep :: Char -> Parser [Char] ParserState Char

764+gridTableSep :: Stream s m Char => Char -> ParserT s ParserState m Char

754gridTableSep ch = try $ gridDashedLines ch >> return '\n'

765gridTableSep ch = try $ gridDashedLines ch >> return '\n'

755

766

756-- | Parse header for a grid table.

767-- | Parse header for a grid table.

768+gridTableHeader :: Stream [Char] m Char

757−gridTableHeader :: Bool -- ^ Headerless table

769+ => Bool -- ^ Headerless table

758− -> Parser [Char] ParserState [Block]

770+ -> ParserT [Char] ParserState m [Block]

759− -> Parser [Char] ParserState ([[Block]], [Alignment], [Int])

771+ -> ParserT [Char] ParserState m ([[Block]], [Alignment], [Int])

760gridTableHeader headless blocks = try $ do

772gridTableHeader headless blocks = try $ do

761 optional blanklines

773 optional blanklines

762 dashes <- gridDashedLines '-'

774 dashes <- gridDashedLines '-'

@@ -779,16 +791,17 @@ gridTableHeader headless blocks = try $ do

779 heads <- mapM (parseFromString blocks) $ map trim rawHeads

791 heads <- mapM (parseFromString blocks) $ map trim rawHeads

780 return (heads, aligns, indices)

792 return (heads, aligns, indices)

781

793

782−gridTableRawLine :: [Int] -> Parser [Char] ParserState [String]

794+gridTableRawLine :: Stream s m Char => [Int] -> ParserT s ParserState m [String]

783gridTableRawLine indices = do

795gridTableRawLine indices = do

784 char '|'

796 char '|'

785 line <- many1Till anyChar newline

797 line <- many1Till anyChar newline

786 return (gridTableSplitLine indices line)

798 return (gridTableSplitLine indices line)

787

799

788-- | Parse row of grid table.

800-- | Parse row of grid table.

801+gridTableRow :: Stream [Char] m Char

789−gridTableRow :: Parser [Char] ParserState [Block]

802+ => ParserT [Char] ParserState m [Block]

790 -> [Int]

803 -> [Int]

791− -> Parser [Char] ParserState [[Block]]

804+ -> ParserT [Char] ParserState m [[Block]]

792gridTableRow blocks indices = do

805gridTableRow blocks indices = do

793 colLines <- many1 (gridTableRawLine indices)

806 colLines <- many1 (gridTableRawLine indices)

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

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

@@ -807,15 +820,16 @@ compactifyCell :: [Block] -> [Block]

807compactifyCell bs = head $ compactify [bs]

820compactifyCell bs = head $ compactify [bs]

808

821

809-- | Parse footer for a grid table.

822-- | Parse footer for a grid table.

810−gridTableFooter :: Parser [Char] ParserState [Char]

823+gridTableFooter :: Stream s m Char => ParserT s ParserState m [Char]

811gridTableFooter = blanklines

824gridTableFooter = blanklines

812

825

813---

826---

814

827

815-- | Parse a string with a given parser and state.

828-- | Parse a string with a given parser and state.

816−readWith :: Parser [Char] st a -- ^ parser

829+readWith :: (Show s, Stream s Identity Char)

830+ => ParserT s st Identity a -- ^ parser

817 -> st -- ^ initial state

831 -> st -- ^ initial state

818− -> [Char] -- ^ input

832+ -> s -- ^ input

819 -> a

833 -> a

820readWith parser state input =

834readWith parser state input =

821 case runParser parser state "source" input of

835 case runParser parser state "source" input of

@@ -823,15 +837,16 @@ readWith parser state input =

823 let errPos = errorPos err'

837 let errPos = errorPos err'

824 errLine = sourceLine errPos

838 errLine = sourceLine errPos

825 errColumn = sourceColumn errPos

839 errColumn = sourceColumn errPos

826− theline = (lines input ++ [""]) !! (errLine - 1)

840+ theline = (lines (show input) ++ [""]) !! (errLine - 1)

827 in error $ "\nError at " ++ show err' ++ "\n" ++

841 in error $ "\nError at " ++ show err' ++ "\n" ++

828 theline ++ "\n" ++ replicate (errColumn - 1) ' ' ++

842 theline ++ "\n" ++ replicate (errColumn - 1) ' ' ++

829 "^"

843 "^"

830 Right result -> result

844 Right result -> result

831

845

832-- | Parse a string with @parser@ (for testing).

846-- | Parse a string with @parser@ (for testing).

833−testStringWith :: (Show a) => Parser [Char] ParserState a

847+testStringWith :: (Show s, Show a, Stream s Identity Char)

834− -> String

848+ => ParserT s ParserState Identity a

849+ -> s

835 -> IO ()

850 -> IO ()

836testStringWith parser str = UTF8.putStrLn $ show $

851testStringWith parser str = UTF8.putStrLn $ show $

837 readWith parser defaultParserState str

852 readWith parser defaultParserState str

@@ -878,9 +893,9 @@ instance HasMeta ParserState where

878

893

879class HasReaderOptions st where

894class HasReaderOptions st where

880 extractReaderOptions :: st -> ReaderOptions

895 extractReaderOptions :: st -> ReaderOptions

881− getOption :: (ReaderOptions -> b) -> Parser s st b

896+ getOption :: (Stream s m t) => (ReaderOptions -> b) -> ParserT s st m b

882 -- default

897 -- default

883− getOption f = (f . extractReaderOptions) `fmap` getState

898+ getOption f = (f . extractReaderOptions) <$> getState

884

899

885instance HasReaderOptions ParserState where

900instance HasReaderOptions ParserState where

886 extractReaderOptions = stateOptions

901 extractReaderOptions = stateOptions

@@ -946,19 +961,19 @@ defaultParserState =

946 stateWarnings = []}

961 stateWarnings = []}

947

962

948-- | Succeed only if the extension is enabled.

963-- | Succeed only if the extension is enabled.

949−guardEnabled :: HasReaderOptions st => Extension -> Parser s st ()

964+guardEnabled :: (Stream s m a, HasReaderOptions st) => Extension -> ParserT s st m ()

950guardEnabled ext = getOption readerExtensions >>= guard . Set.member ext

965guardEnabled ext = getOption readerExtensions >>= guard . Set.member ext

951

966

952-- | Succeed only if the extension is disabled.

967-- | Succeed only if the extension is disabled.

953−guardDisabled :: HasReaderOptions st => Extension -> Parser s st ()

968+guardDisabled :: (Stream s m a, HasReaderOptions st) => Extension -> ParserT s st m ()

954guardDisabled ext = getOption readerExtensions >>= guard . not . Set.member ext

969guardDisabled ext = getOption readerExtensions >>= guard . not . Set.member ext

955

970

956-- | Update the position on which the last string ended.

971-- | Update the position on which the last string ended.

957−updateLastStrPos :: HasLastStrPosition st => Parser s st ()

972+updateLastStrPos :: (Stream s m a, HasLastStrPosition st) => ParserT s st m ()

958updateLastStrPos = getPosition >>= updateState . setLastStrPos

973updateLastStrPos = getPosition >>= updateState . setLastStrPos

959

974

960-- | Whether we are right after the end of a string.

975-- | Whether we are right after the end of a string.

961−notAfterString :: HasLastStrPosition st => Parser s st Bool

976+notAfterString :: (Stream s m a, HasLastStrPosition st) => ParserT s st m Bool

962notAfterString = do

977notAfterString = do

963 pos <- getPosition

978 pos <- getPosition

964 st <- getState

979 st <- getState

@@ -998,10 +1013,10 @@ type SubstTable = M.Map Key Inlines

998-- and the auto_identifers extension is set, generate a new

1013-- and the auto_identifers extension is set, generate a new

999-- unique identifier, and update the list of identifiers

1014-- unique identifier, and update the list of identifiers

1000-- in state.

1015-- in state.

1001−registerHeader :: (HasReaderOptions st, HasHeaderMap st, HasIdentifierList st)

1016+registerHeader :: (Stream s m a, HasReaderOptions st, HasHeaderMap st, HasIdentifierList st)

1002− => Attr -> Inlines -> Parser s st Attr

1017+ => Attr -> Inlines -> ParserT s st m Attr

1003registerHeader (ident,classes,kvs) header' = do

1018registerHeader (ident,classes,kvs) header' = do

1004− ids <- extractIdentifierList `fmap` getState

1019+ ids <- extractIdentifierList <$> getState

1005 exts <- getOption readerExtensions

1020 exts <- getOption readerExtensions

1006 let insert' = M.insertWith (\_new old -> old)

1021 let insert' = M.insertWith (\_new old -> old)

1007 if null ident && Ext_auto_identifiers `Set.member` exts

1022 if null ident && Ext_auto_identifiers `Set.member` exts

@@ -1020,25 +1035,28 @@ registerHeader (ident,classes,kvs) header' = do

1020 return (ident,classes,kvs)

1035 return (ident,classes,kvs)

1021

1036

1022-- | Fail unless we're in "smart typography" mode.

1037-- | Fail unless we're in "smart typography" mode.

1023−failUnlessSmart :: HasReaderOptions st => Parser s st ()

1038+failUnlessSmart :: (Stream s m a, HasReaderOptions st) => ParserT s st m ()

1024failUnlessSmart = getOption readerSmart >>= guard

1039failUnlessSmart = getOption readerSmart >>= guard

1025

1040

1026−smartPunctuation :: Parser [Char] ParserState Inlines

1041+smartPunctuation :: Stream s m Char

1042+ => ParserT s ParserState m Inlines

1027− -> Parser [Char] ParserState Inlines

1043+ -> ParserT s ParserState m Inlines

1028smartPunctuation inlineParser = do

1044smartPunctuation inlineParser = do

1029 failUnlessSmart

1045 failUnlessSmart

1030 choice [ quoted inlineParser, apostrophe, dash, ellipses ]

1046 choice [ quoted inlineParser, apostrophe, dash, ellipses ]

1031

1047

1032−apostrophe :: Parser [Char] ParserState Inlines

1048+apostrophe :: Stream s m Char => ParserT s st m Inlines

1033apostrophe = (char '\'' <|> char '\8217') >> return (B.str "\x2019")

1049apostrophe = (char '\'' <|> char '\8217') >> return (B.str "\x2019")

1034

1050

1051+quoted :: Stream s m Char

1035−quoted :: Parser [Char] ParserState Inlines

1052+ => ParserT s ParserState m Inlines

1036− -> Parser [Char] ParserState Inlines

1053+ -> ParserT s ParserState m Inlines

1037quoted inlineParser = doubleQuoted inlineParser <|> singleQuoted inlineParser

1054quoted inlineParser = doubleQuoted inlineParser <|> singleQuoted inlineParser

1038

1055

1039−withQuoteContext :: QuoteContext

1056+withQuoteContext :: Stream s m t

1057+ => QuoteContext

1040− -> Parser [tok] ParserState a

1058+ -> ParserT s ParserState m a

1041− -> Parser [tok] ParserState a

1059+ -> ParserT s ParserState m a

1042withQuoteContext context parser = do

1060withQuoteContext context parser = do

1043 oldState <- getState

1061 oldState <- getState

1044 let oldQuoteContext = stateQuoteContext oldState

1062 let oldQuoteContext = stateQuoteContext oldState

@@ -1048,108 +1066,122 @@ withQuoteContext context parser = do

1048 setState newState { stateQuoteContext = oldQuoteContext }

1066 setState newState { stateQuoteContext = oldQuoteContext }

1049 return result

1067 return result

1050

1068

1069+singleQuoted :: Stream s m Char

1051−singleQuoted :: Parser [Char] ParserState Inlines

1070+ => ParserT s ParserState m Inlines

1052− -> Parser [Char] ParserState Inlines

1071+ -> ParserT s ParserState m Inlines

1053singleQuoted inlineParser = try $ do

1072singleQuoted inlineParser = try $ do

1054 singleQuoteStart

1073 singleQuoteStart

1055 withQuoteContext InSingleQuote $ many1Till inlineParser singleQuoteEnd >>=

1074 withQuoteContext InSingleQuote $ many1Till inlineParser singleQuoteEnd >>=

1056 return . B.singleQuoted . mconcat

1075 return . B.singleQuoted . mconcat

1057

1076

1077+doubleQuoted :: Stream s m Char

1058−doubleQuoted :: Parser [Char] ParserState Inlines

1078+ => ParserT s ParserState m Inlines

1059− -> Parser [Char] ParserState Inlines

1079+ -> ParserT s ParserState m Inlines

1060doubleQuoted inlineParser = try $ do

1080doubleQuoted inlineParser = try $ do

1061 doubleQuoteStart

1081 doubleQuoteStart

1062 withQuoteContext InDoubleQuote $ manyTill inlineParser doubleQuoteEnd >>=

1082 withQuoteContext InDoubleQuote $ manyTill inlineParser doubleQuoteEnd >>=

1063 return . B.doubleQuoted . mconcat

1083 return . B.doubleQuoted . mconcat

1064

1084

1065−failIfInQuoteContext :: QuoteContext -> Parser [tok] ParserState ()

1085+failIfInQuoteContext :: Stream s m t

1086+ => QuoteContext

1087+ -> ParserT s ParserState m ()

1066failIfInQuoteContext context = do

1088failIfInQuoteContext context = do

1067 st <- getState

1089 st <- getState

1068 if stateQuoteContext st == context

1090 if stateQuoteContext st == context

1069 then fail "already inside quotes"

1091 then fail "already inside quotes"

1070 else return ()

1092 else return ()

1071

1093

1072−charOrRef :: [Char] -> Parser [Char] st Char

1094+charOrRef :: Stream s m Char => String -> ParserT s st m Char

1073charOrRef cs =

1095charOrRef cs =

1074 oneOf cs <|> try (do c <- characterReference

1096 oneOf cs <|> try (do c <- characterReference

1075 guard (c `elem` cs)

1097 guard (c `elem` cs)

1076 return c)

1098 return c)

1077

1099

1078−singleQuoteStart :: Parser [Char] ParserState ()

1100+singleQuoteStart :: Stream s m Char

1101+ => ParserT s ParserState m ()

1079singleQuoteStart = do

1102singleQuoteStart = do

1080 failIfInQuoteContext InSingleQuote

1103 failIfInQuoteContext InSingleQuote

1081 -- single quote start can't be right after str

1104 -- single quote start can't be right after str

1082 guard =<< notAfterString

1105 guard =<< notAfterString

1083 () <$ charOrRef "'\8216\145"

1106 () <$ charOrRef "'\8216\145"

1084

1107

1085−singleQuoteEnd :: Parser [Char] st ()

1108+singleQuoteEnd :: Stream s m Char

1109+ => ParserT s st m ()

1086singleQuoteEnd = try $ do

1110singleQuoteEnd = try $ do

1087 charOrRef "'\8217\146"

1111 charOrRef "'\8217\146"

1088 notFollowedBy alphaNum

1112 notFollowedBy alphaNum

1089

1113

1090−doubleQuoteStart :: Parser [Char] ParserState ()

1114+doubleQuoteStart :: Stream s m Char

1115+ => ParserT s ParserState m ()

1091doubleQuoteStart = do

1116doubleQuoteStart = do

1092 failIfInQuoteContext InDoubleQuote

1117 failIfInQuoteContext InDoubleQuote

1093 try $ do charOrRef "\"\8220\147"

1118 try $ do charOrRef "\"\8220\147"

1094 notFollowedBy . satisfy $ flip elem [' ', '\t', '\n']

1119 notFollowedBy . satisfy $ flip elem [' ', '\t', '\n']

1095

1120

1096−doubleQuoteEnd :: Parser [Char] st ()

1121+doubleQuoteEnd :: Stream s m Char

1097−doubleQuoteEnd = do

1122+ => ParserT s st m ()

1098− charOrRef "\"\8221\148"

1123+doubleQuoteEnd = void (charOrRef "\"\8221\148")

1099− return ()

1100

1124

1101−ellipses :: Parser [Char] st Inlines

1125+ellipses :: Stream s m Char

1126+ => ParserT s st m Inlines

1102ellipses = do

1127ellipses = do

1103 try (charOrRef "\8230\133") <|> try (string "..." >> return '…')

1128 try (charOrRef "\8230\133") <|> try (string "..." >> return '…')

1104 return (B.str "\8230")

1129 return (B.str "\8230")

1105

1130

1106−dash :: Parser [Char] ParserState Inlines

1131+dash :: Stream s m Char => ParserT s ParserState m Inlines

1107dash = do

1132dash = do

1108 oldDashes <- getOption readerOldDashes

1133 oldDashes <- getOption readerOldDashes

1109 if oldDashes

1134 if oldDashes

1110 then emDashOld <|> enDashOld

1135 then emDashOld <|> enDashOld

1111− else B.str `fmap` (hyphenDash <|> emDash <|> enDash)

1136+ else B.str <$> (hyphenDash <|> emDash <|> enDash)

1112

1137

1113-- Two hyphens = en-dash, three = em-dash

1138-- Two hyphens = en-dash, three = em-dash

1114−hyphenDash :: Parser [Char] st String

1139+hyphenDash :: Stream s m Char

1140+ => ParserT s st m String

1115hyphenDash = do

1141hyphenDash = do

1116 try $ string "--"

1142 try $ string "--"

1117 option "\8211" (char '-' >> return "\8212")

1143 option "\8211" (char '-' >> return "\8212")

1118

1144

1119−emDash :: Parser [Char] st String

1145+emDash :: Stream s m Char

1146+ => ParserT s st m String

1120emDash = do

1147emDash = do

1121 try (charOrRef "\8212\151")

1148 try (charOrRef "\8212\151")

1122 return "\8212"

1149 return "\8212"

1123

1150

1124−enDash :: Parser [Char] st String

1151+enDash :: Stream s m Char

1152+ => ParserT s st m String

1125enDash = do

1153enDash = do

1126 try (charOrRef "\8212\151")

1154 try (charOrRef "\8212\151")

1127 return "\8211"

1155 return "\8211"

1128

1156

1129−enDashOld :: Parser [Char] st Inlines

1157+enDashOld :: Stream s m Char

1158+ => ParserT s st m Inlines

1130enDashOld = do

1159enDashOld = do

1131 try (charOrRef "\8211\150") <|>

1160 try (charOrRef "\8211\150") <|>

1132 try (char '-' >> lookAhead (satisfy isDigit) >> return '–')

1161 try (char '-' >> lookAhead (satisfy isDigit) >> return '–')

1133 return (B.str "\8211")

1162 return (B.str "\8211")

1134

1163

1135−emDashOld :: Parser [Char] st Inlines

1164+emDashOld :: Stream s m Char

1165+ => ParserT s st m Inlines

1136emDashOld = do

1166emDashOld = do

1137 try (charOrRef "\8212\151") <|> (try $ string "--" >> optional (char '-') >> return '-')

1167 try (charOrRef "\8212\151") <|> (try $ string "--" >> optional (char '-') >> return '-')

1138 return (B.str "\8212")

1168 return (B.str "\8212")

1139

1169

1140-- This is used to prevent exponential blowups for things like:

1170-- This is used to prevent exponential blowups for things like:

1141-- a**a*a**a*a**a*a**a*a**a*a**a*a**

1171-- a**a*a**a*a**a*a**a*a**a*a**a*a**

1172+nested :: Stream s m a

1142−nested :: Parser s ParserState a

1173+ => ParserT s ParserState m a

1143− -> Parser s ParserState a

1174+ -> ParserT s ParserState m a

1144nested p = do

1175nested p = do

1145− nestlevel <- stateMaxNestingLevel `fmap` getState

1176+ nestlevel <- stateMaxNestingLevel <$> getState

1146 guard $ nestlevel > 0

1177 guard $ nestlevel > 0

1147 updateState $ \st -> st{ stateMaxNestingLevel = stateMaxNestingLevel st - 1 }

1178 updateState $ \st -> st{ stateMaxNestingLevel = stateMaxNestingLevel st - 1 }

1148 res <- p

1179 res <- p

1149 updateState $ \st -> st{ stateMaxNestingLevel = nestlevel }

1180 updateState $ \st -> st{ stateMaxNestingLevel = nestlevel }

1150 return res

1181 return res

1151

1182

1152−citeKey :: HasLastStrPosition st => Parser [Char] st (Bool, String)

1183+citeKey :: (Stream s m Char, HasLastStrPosition st)

1184+ => ParserT s st m (Bool, String)

1153citeKey = try $ do

1185citeKey = try $ do

1154 guard =<< notAfterString

1186 guard =<< notAfterString

1155 suppress_author <- option False (char '-' *> return True)

1187 suppress_author <- option False (char '-' *> return True)

@@ -1166,7 +1198,8 @@ citeKey = try $ do

1166--

1198--

1167

1199

1168-- | Parse a \newcommand or \renewcommand macro definition.

1200-- | Parse a \newcommand or \renewcommand macro definition.

1169−macro :: (HasMacros st, HasReaderOptions st) => Parser [Char] st Blocks

1201+macro :: (Stream [Char] m Char, HasMacros st, HasReaderOptions st)

1202+ => ParserT [Char] st m Blocks

1170macro = do

1203macro = do

1171 apply <- getOption readerApplyMacros

1204 apply <- getOption readerApplyMacros

1172 inp <- getInput

1205 inp <- getInput

@@ -1181,10 +1214,12 @@ macro = do

1181 else return $ rawBlock "latex" def'

1214 else return $ rawBlock "latex" def'

1182

1215

1183-- | Apply current macros to string.

1216-- | Apply current macros to string.

1217+applyMacros' :: Stream [Char] m Char

1218+ => String

1184−applyMacros' :: String -> Parser [Char] ParserState String

1219+ -> ParserT [Char] ParserState m String

1185applyMacros' target = do

1220applyMacros' target = do

1186 apply <- getOption readerApplyMacros

1221 apply <- getOption readerApplyMacros

1187 if apply

1222 if apply

1188− then do macros <- extractMacros `fmap` getState

1223+ then do macros <- extractMacros <$> getState

1189 return $ applyMacros macros target

1224 return $ applyMacros macros target

1190 else return target

1225 else return target

src/Text/Pandoc/Readers/HTML.hs+3−3

@@ -128,7 +128,7 @@ pBulletList = try $ do

128 -- note: if they have an <ol> or <ul> not in scope of a <li>,

129 -- treat it as a list item, though it's not valid xhtml...

130 skipMany nonItem

131− items <- manyTill (pInTags "li" block >>~ skipMany nonItem) (pCloses "ul")

131+ items <- manyTill (pInTags "li" block <* skipMany nonItem) (pCloses "ul")

132 return $ B.bulletList $ map (fixPlains True) items

133

134pOrderedList :: TagParser Blocks

@@ -156,7 +156,7 @@ pOrderedList = try $ do

156 -- note: if they have an <ol> or <ul> not in scope of a <li>,

157 -- treat it as a list item, though it's not valid xhtml...

158 skipMany nonItem

159− items <- manyTill (pInTags "li" block >>~ skipMany nonItem) (pCloses "ol")

159+ items <- manyTill (pInTags "li" block <* skipMany nonItem) (pCloses "ol")

160 return $ B.orderedListWith (start, style, DefaultDelim) $ map (fixPlains True) items

161

162pDefinitionList :: TagParser Blocks

@@ -244,7 +244,7 @@ pTable :: TagParser Blocks

244pTable = try $ do

245 TagOpen _ _ <- pSatisfy (~== TagOpen "table" [])

246 skipMany pBlank

247− caption <- option mempty $ pInTags "caption" inline >>~ skipMany pBlank

247+ caption <- option mempty $ pInTags "caption" inline <* skipMany pBlank

248 -- TODO actually read these and take width information from them

249 widths' <- pColgroup <|> many pCol

250 head' <- option [] $ pOptInTag "thead" $ pInTags "tr" (pCell "th")

src/Text/Pandoc/Readers/LaTeX.hs+1−1

@@ -104,7 +104,7 @@ dimenarg = try $ do

104

105sp :: LP ()

106sp = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t')

107− <|> (try $ newline >>~ lookAhead anyChar >>~ notFollowedBy blankline)

107+ <|> (try $ newline <* lookAhead anyChar <* notFollowedBy blankline)

108

109isLowerHex :: Char -> Bool

110isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'

src/Text/Pandoc/Readers/Markdown.hs+4−4

@@ -571,7 +571,7 @@ attributes :: MarkdownParser Attr

571attributes = try $ do

572 char '{'

573 spnl

574− attrs <- many (attribute >>~ spnl)

574+ attrs <- many (attribute <* spnl)

575 char '}'

576 return $ foldl (\x f -> f x) nullAttr attrs

577

@@ -688,7 +688,7 @@ birdTrackLine c = try $ do

688--

689

690emailBlockQuoteStart :: MarkdownParser Char

691−emailBlockQuoteStart = try $ skipNonindentSpaces >> char '>' >>~ optional (char ' ')

691+emailBlockQuoteStart = try $ skipNonindentSpaces >> char '>' <* optional (char ' ')

692

693emailBlockQuote :: MarkdownParser [String]

694emailBlockQuote = try $ do

@@ -1165,7 +1165,7 @@ gridPart ch = do

1165 return (length dashes, length dashes + 1)

1166

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

1168−gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) >>~ blankline

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

1169

1170removeFinalBar :: String -> String

1171removeFinalBar =

@@ -1499,7 +1499,7 @@ inlinesBetween :: (Show b)

1499inlinesBetween start end =

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

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

1502− innerSpace = try $ whitespace >>~ notFollowedBy' end

1502+ innerSpace = try $ whitespace <* notFollowedBy' end

1503

1504strikeout :: MarkdownParser (F Inlines)

1505strikeout = fmap B.strikeout <$>

src/Text/Pandoc/Readers/MediaWiki.hs+1−1

@@ -634,7 +634,7 @@ inlinesBetween :: (Show b) => MWParser a -> MWParser b -> MWParser Inlines

634inlinesBetween start end =

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

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

637− innerSpace = try $ whitespace >>~ notFollowedBy' end

637+ innerSpace = try $ whitespace <* notFollowedBy' end

638

639emph :: MWParser Inlines

640emph = B.emph <$> nested (inlinesBetween start end)

src/Text/Pandoc/Readers/RST.hs+4−4

@@ -460,7 +460,7 @@ listItem :: RSTParser Int

460listItem start = try $ do

461 (markerLength, first) <- rawListItem start

462 rest <- many (listContinuation markerLength)

463− blanks <- choice [ try (many blankline >>~ lookAhead start),

463+ blanks <- choice [ try (many blankline <* lookAhead start),

464 many1 blankline ] -- whole list must end with blank.

465 -- parsing with ListItemState forces markers at beginning of lines to

466 -- count as list item markers, even if not separated by blank space.

@@ -480,7 +480,7 @@ listItem start = try $ do

480

481orderedList :: RSTParser Blocks

482orderedList = try $ do

483− (start, style, delim) <- lookAhead (anyOrderedListMarker >>~ spaceChar)

483+ (start, style, delim) <- lookAhead (anyOrderedListMarker <* spaceChar)

484 items <- many1 (listItem (orderedListStart style delim))

485 let items' = compactify' items

486 return $ B.orderedListWith (start, style, delim) items'

@@ -747,7 +747,7 @@ simpleReferenceName = do

747

748referenceName :: RSTParser Inlines

749referenceName = quotedReferenceName <|>

750− (try $ simpleReferenceName >>~ lookAhead (char ':')) <|>

750+ (try $ simpleReferenceName <* lookAhead (char ':')) <|>

751 unquotedReferenceName

752

753referenceKey :: RSTParser [Char]

@@ -1076,7 +1076,7 @@ explicitLink = try $ do

1076

1077referenceLink :: RSTParser Inlines

1078referenceLink = try $ do

1079− (label',ref) <- withRaw (quotedReferenceName <|> simpleReferenceName) >>~

1079+ (label',ref) <- withRaw (quotedReferenceName <|> simpleReferenceName) <*

1080 char '_'

1081 state <- getState

1082 let keyTable = stateKeys state