@@ -1,5 +1,8 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances,
2− FlexibleInstances#-}
1+{-# LANGUAGE
2+ FlexibleContexts
3+, GeneralizedNewtypeDeriving
4+, TypeSynonymInstances
5+, FlexibleInstances #-}
36{-
47Copyright (C) 2006-2014 John MacFarlane <jgm@berkeley.edu>
58
@@ -29,8 +32,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2932
3033A utility library with parsers used in pandoc readers.
3134-}
32−module Text.Pandoc.Parsing ( (>>~),
33− anyLine,
35+module Text.Pandoc.Parsing ( anyLine,
3436 many1Till,
3537 notFollowedBy',
3638 oneOfStrings,
@@ -98,6 +100,7 @@ module Text.Pandoc.Parsing ( (>>~),
98100 macro,
99101 applyMacros',
100102 Parser,
103+ ParserT,
101104 F(..),
102105 runF,
103106 askF,
@@ -177,12 +180,15 @@ import Text.Pandoc.Asciify (toAsciiChar)
177180import Data.Default
178181import qualified Data.Set as Set
179182import Control.Monad.Reader
180−import Control.Applicative ((*>), (<*), (<$), liftA2, Applicative)
183+import Control.Monad.Identity
184+import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$), Applicative)
181185import Data.Monoid
182186import Data.Maybe (catMaybes)
183187
184188type Parser t s = Parsec t s
185189
190+type ParserT = ParsecT
191+
186192newtype F a = F { unF :: Reader ParserState a } deriving (Monad, Applicative, Functor)
187193
188194runF :: F a -> ParserState -> a
@@ -199,13 +205,8 @@ instance Monoid a => Monoid (F a) where
199205 mappend = liftM2 mappend
200206 mconcat = liftM mconcat . sequence
201207
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−
207208-- | Parse any line of text
208−anyLine :: Parser [Char] st [Char]
209+anyLine :: Stream [Char] m Char => ParserT [Char] st m [Char]
209210anyLine = do
210211 -- This is much faster than:
211212 -- manyTill anyChar newline
@@ -221,9 +222,10 @@ anyLine = do
221222 _ -> mzero
222223
223224-- | Like @manyTill@, but reads at least one item.
224−many1Till :: Parser [tok] st a
225− -> Parser [tok] st end
226− -> Parser [tok] st [a]
225+many1Till :: Stream s m t
226+ => ParserT s st m a
227+ -> ParserT s st m end
228+ -> ParserT s st m [a]
227229many1Till p end = do
228230 first <- p
229231 rest <- manyTill p end
@@ -232,21 +234,21 @@ many1Till p end = do
232234-- | A more general form of @notFollowedBy@. This one allows any
233235-- type of parser to be specified, and succeeds only if that parser fails.
234236-- 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 ()
236238notFollowedBy' p = try $ join $ do a <- try p
237239 return (unexpected (show a))
238240 <|>
239241 return (return ())
240242-- (This version due to Andrew Pimlott on the Haskell mailing list.)
241243
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
243245oneOfStrings' _ [] = fail "no strings"
244246oneOfStrings' matches strs = try $ do
245247 c <- anyChar
246248 let strs' = [xs | (x:xs) <- strs, x `matches` c]
247249 case strs' of
248250 [] -> fail "not found"
249− _ -> (c:) `fmap` oneOfStrings' matches strs'
251+ _ -> (c:) <$> oneOfStrings' matches strs'
250252 <|> if "" `elem` strs'
251253 then return [c]
252254 else fail "not found"
@@ -254,11 +256,11 @@ oneOfStrings' matches strs = try $ do
254256-- | Parses one of a list of strings. If the list contains
255257-- two strings one of which is a prefix of the other, the longer
256258-- 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
258260oneOfStrings = oneOfStrings' (==)
259261
260262-- | 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
262264oneOfStringsCI = oneOfStrings' ciMatch
263265 where ciMatch x y = toLower' x == toLower' y
264266 -- this optimizes toLower by checking common ASCII case
@@ -269,35 +271,35 @@ oneOfStringsCI = oneOfStrings' ciMatch
269271 | otherwise = toLower c
270272
271273-- | Parses a space or tab.
272−spaceChar :: Parser [Char] st Char
274+spaceChar :: Stream s m Char => ParserT s st m Char
273275spaceChar = satisfy $ \c -> c == ' ' || c == '\t'
274276
275277-- | Parses a nonspace, nonnewline character.
276−nonspaceChar :: Parser [Char] st Char
278+nonspaceChar :: Stream s m Char => ParserT s st m Char
277279nonspaceChar = satisfy $ flip notElem ['\t', '\n', ' ', '\r']
278280
279281-- | Skips zero or more spaces or tabs.
280−skipSpaces :: Parser [Char] st ()
282+skipSpaces :: Stream s m Char => ParserT s st m ()
281283skipSpaces = skipMany spaceChar
282284
283285-- | 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
285287blankline = try $ skipSpaces >> newline
286288
287289-- | 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]
289291blanklines = many1 blankline
290292
291293-- | Parses material enclosed between start and end parsers.
292−enclosed :: Parser [Char] st t -- ^ start parser
293− -> Parser [Char] st end -- ^ end parser
294− -> Parser [Char] st a -- ^ content parser (to be used repeatedly)
295− -> Parser [Char] st [a]
294+enclosed :: Stream s m Char => ParserT s st m t -- ^ start parser
295+ -> ParserT s st m end -- ^ end parser
296+ -> ParserT s st m a -- ^ content parser (to be used repeatedly)
297+ -> ParserT s st m [a]
296298enclosed start end parser = try $
297299 start >> notFollowedBy space >> many1Till parser end
298300
299301-- | Parse string, case insensitive.
300−stringAnyCase :: [Char] -> Parser [Char] st String
302+stringAnyCase :: Stream s m Char => [Char] -> ParserT s st m String
301303stringAnyCase [] = string ""
302304stringAnyCase (x:xs) = do
303305 firstChar <- char (toUpper x) <|> char (toLower x)
@@ -305,7 +307,7 @@ stringAnyCase (x:xs) = do
305307 return (firstChar:rest)
306308
307309-- | 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
309311parseFromString parser str = do
310312 oldPos <- getPosition
311313 oldInput <- getInput
@@ -316,7 +318,7 @@ parseFromString parser str = do
316318 return result
317319
318320-- | 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
320322lineClump = blanklines
321323 <|> (many1 (notFollowedBy blankline >> anyLine) >>= return . unlines)
322324
@@ -325,8 +327,8 @@ lineClump = blanklines
325327-- pairs of open and close, which must be different. For example,
326328-- @charsInBalanced '(' ')' anyChar@ will parse "(hello (there))"
327329-- and return "hello (there)".
328−charsInBalanced :: Char -> Char -> Parser [Char] st Char
329− -> Parser [Char] st String
330+charsInBalanced :: Stream s m Char => Char -> Char -> ParserT s st m Char
331+ -> ParserT s st m String
330332charsInBalanced open close parser = try $ do
331333 char open
332334 let isDelim c = c == open || c == close
@@ -350,8 +352,8 @@ uppercaseRomanDigits :: [Char]
350352uppercaseRomanDigits = map toUpper lowercaseRomanDigits
351353
352354-- | Parses a roman numeral (uppercase or lowercase), returns number.
353−romanNumeral :: Bool -- ^ Uppercase if true
354− -> Parser [Char] st Int
355+romanNumeral :: Stream s m Char => Bool -- ^ Uppercase if true
356+ -> ParserT s st m Int
355357romanNumeral upperCase = do
356358 let romanDigits = if upperCase
357359 then uppercaseRomanDigits
@@ -383,12 +385,12 @@ romanNumeral upperCase = do
383385
384386-- | Parses an email address; returns original and corresponding
385387-- escaped mailto: URI.
386−emailAddress :: Parser [Char] st (String, String)
387−emailAddress = try $ liftA2 toResult mailbox (char '@' *> domain)
388+emailAddress :: Stream s m Char => ParserT s st m (String, String)
389+emailAddress = try $ toResult <$> mailbox <*> (char '@' *> domain)
388390 where toResult mbox dom = let full = fromEntities $ mbox ++ '@':dom
389391 in (full, escapeURI $ "mailto:" ++ full)
390− mailbox = intercalate "." `fmap` (emailWord `sepby1` dot)
391− domain = intercalate "." `fmap` (subdomain `sepby1` dot)
392+ mailbox = intercalate "." <$> (emailWord `sepby1` dot)
393+ domain = intercalate "." <$> (subdomain `sepby1` dot)
392394 dot = char '.'
393395 subdomain = many1 $ alphaNum <|> innerPunct
394396 innerPunct = try (satisfy (\c -> isEmailPunct c || c == '@') <*
@@ -398,7 +400,7 @@ emailAddress = try $ liftA2 toResult mailbox (char '@' *> domain)
398400 isEmailPunct c = c `elem` "!\"#$%&'*+-/=?^_{|}~;"
399401 -- note: sepBy1 from parsec consumes input when sep
400402 -- 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))
402404
403405
404406-- 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",
426428 "ventrilo","view-source","webcal","wtai","wyciwyg","xfire","xri",
427429 "ymsgr"]
428430
429−uriScheme :: Parser [Char] st String
431+uriScheme :: Stream s m Char => ParserT s st m String
430432uriScheme = oneOfStringsCI schemes
431433
432434-- | 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)
434436uri = try $ do
435437 scheme <- uriScheme
436438 char ':'
@@ -451,7 +453,7 @@ uri = try $ do
451453 <|> entity
452454 <|> (try $ punct >>
453455 lookAhead (void (satisfy isWordChar) <|> percentEscaped))
454− str <- snd `fmap` withRaw (skipMany1 ( () <$
456+ str <- snd <$> withRaw (skipMany1 ( () <$
455457 (enclosed (char '(') (char ')') uriChunk
456458 <|> enclosed (char '{') (char '}') uriChunk
457459 <|> enclosed (char '[') (char ']') uriChunk)
@@ -460,7 +462,7 @@ uri = try $ do
460462 let uri' = scheme ++ ":" ++ fromEntities str'
461463 return (uri', escapeURI uri')
462464
463−mathInlineWith :: String -> String -> Parser [Char] st String
465+mathInlineWith :: Stream s m Char => String -> String -> ParserT s st m String
464466mathInlineWith op cl = try $ do
465467 string op
466468 notFollowedBy space
@@ -474,12 +476,12 @@ mathInlineWith op cl = try $ do
474476 notFollowedBy digit -- to prevent capture of $5
475477 return $ concat words'
476478
477−mathDisplayWith :: String -> String -> Parser [Char] st String
479+mathDisplayWith :: Stream s m Char => String -> String -> ParserT s st m String
478480mathDisplayWith op cl = try $ do
479481 string op
480− many1Till (noneOf "\n" <|> (newline >>~ notFollowedBy' blankline)) (try $ string cl)
482+ many1Till (noneOf "\n" <|> (newline <* notFollowedBy' blankline)) (try $ string cl)
481483
482−mathDisplay :: Parser [Char] ParserState String
484+mathDisplay :: Stream s m Char => ParserT s ParserState m String
483485mathDisplay =
484486 (guardEnabled Ext_tex_math_dollars >> mathDisplayWith "$$" "$$")
485487 <|> (guardEnabled Ext_tex_math_single_backslash >>
@@ -487,7 +489,7 @@ mathDisplay =
487489 <|> (guardEnabled Ext_tex_math_double_backslash >>
488490 mathDisplayWith "\\\\[" "\\\\]")
489491
490−mathInline :: Parser [Char] ParserState String
492+mathInline :: Stream s m Char => ParserT s ParserState m String
491493mathInline =
492494 (guardEnabled Ext_tex_math_dollars >> mathInlineWith "$" "$")
493495 <|> (guardEnabled Ext_tex_math_single_backslash >>
@@ -499,8 +501,9 @@ mathInline =
499501-- displacement (the difference between the source column at the end
500502-- and the source column at the beginning). Vertical displacement
501503-- (source row) is ignored.
502−withHorizDisplacement :: Parser [Char] st a -- ^ Parser to apply
503− -> Parser [Char] st (a, Int) -- ^ (result, displacement)
504+withHorizDisplacement :: Stream s m Char
505+ => ParserT s st m a -- ^ Parser to apply
506+ -> ParserT s st m (a, Int) -- ^ (result, displacement)
504507withHorizDisplacement parser = do
505508 pos1 <- getPosition
506509 result <- parser
@@ -509,7 +512,7 @@ withHorizDisplacement parser = do
509512
510513-- | Applies a parser and returns the raw string that was parsed,
511514-- 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])
513516withRaw parser = do
514517 pos1 <- getPosition
515518 inp <- getInput
@@ -525,12 +528,13 @@ withRaw parser = do
525528 return (result, raw)
526529
527530-- | Parses backslash, then applies character parser.
528−escaped :: Parser [Char] st Char -- ^ Parser for character to escape
529− -> Parser [Char] st Char
531+escaped :: Stream s m Char
532+ => ParserT s st m Char -- ^ Parser for character to escape
533+ -> ParserT s st m Char
530534escaped parser = try $ char '\\' >> parser
531535
532536-- | Parse character entity.
533−characterReference :: Parser [Char] st Char
537+characterReference :: Stream s m Char => ParserT s st m Char
534538characterReference = try $ do
535539 char '&'
536540 ent <- many1Till nonspaceChar (char ';')
@@ -539,19 +543,19 @@ characterReference = try $ do
539543 Nothing -> fail "entity not found"
540544
541545-- | 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)
543547upperRoman = do
544548 num <- romanNumeral True
545549 return (UpperRoman, num)
546550
547551-- | 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)
549553lowerRoman = do
550554 num <- romanNumeral False
551555 return (LowerRoman, num)
552556
553557-- | 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)
555559decimal = do
556560 num <- many1 digit
557561 return (Decimal, read num)
@@ -560,7 +564,8 @@ decimal = do
560564-- returns (DefaultStyle, [next example number]). The next
561565-- example number is incremented in parser state, and the label
562566-- (if present) is added to the label table.
563−exampleNum :: Parser [Char] ParserState (ListNumberStyle, Int)
567+exampleNum :: Stream s m Char
568+ => ParserT s ParserState m (ListNumberStyle, Int)
564569exampleNum = do
565570 char '@'
566571 lab <- many (alphaNum <|> satisfy (\c -> c == '_' || c == '-'))
@@ -574,38 +579,39 @@ exampleNum = do
574579 return (Example, num)
575580
576581-- | Parses a '#' returns (DefaultStyle, 1).
577−defaultNum :: Parser [Char] st (ListNumberStyle, Int)
582+defaultNum :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
578583defaultNum = do
579584 char '#'
580585 return (DefaultStyle, 1)
581586
582587-- | 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)
584589lowerAlpha = do
585590 ch <- oneOf ['a'..'z']
586591 return (LowerAlpha, ord ch - ord 'a' + 1)
587592
588593-- | 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)
590595upperAlpha = do
591596 ch <- oneOf ['A'..'Z']
592597 return (UpperAlpha, ord ch - ord 'A' + 1)
593598
594599-- | 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)
596601romanOne = (char 'i' >> return (LowerRoman, 1)) <|>
597602 (char 'I' >> return (UpperRoman, 1))
598603
599604-- | 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
601606anyOrderedListMarker = choice $
602607 [delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],
603608 numParser <- [decimal, exampleNum, defaultNum, romanOne,
604609 lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
605610
606611-- | Parses a list number (num) followed by a period, returns list attributes.
607−inPeriod :: Parser [Char] st (ListNumberStyle, Int)
608− -> Parser [Char] st ListAttributes
612+inPeriod :: Stream s m Char
613+ => ParserT s st m (ListNumberStyle, Int)
614+ -> ParserT s st m ListAttributes
609615inPeriod num = try $ do
610616 (style, start) <- num
611617 char '.'
@@ -615,16 +621,18 @@ inPeriod num = try $ do
615621 return (start, style, delim)
616622
617623-- | Parses a list number (num) followed by a paren, returns list attributes.
618−inOneParen :: Parser [Char] st (ListNumberStyle, Int)
619− -> Parser [Char] st ListAttributes
624+inOneParen :: Stream s m Char
625+ => ParserT s st m (ListNumberStyle, Int)
626+ -> ParserT s st m ListAttributes
620627inOneParen num = try $ do
621628 (style, start) <- num
622629 char ')'
623630 return (start, style, OneParen)
624631
625632-- | Parses a list number (num) enclosed in parens, returns list attributes.
626−inTwoParens :: Parser [Char] st (ListNumberStyle, Int)
627− -> Parser [Char] st ListAttributes
633+inTwoParens :: Stream s m Char
634+ => ParserT s st m (ListNumberStyle, Int)
635+ -> ParserT s st m ListAttributes
628636inTwoParens num = try $ do
629637 char '('
630638 (style, start) <- num
@@ -633,9 +641,10 @@ inTwoParens num = try $ do
633641
634642-- | Parses an ordered list marker with a given style and delimiter,
635643-- returns number.
636−orderedListMarker :: ListNumberStyle
644+orderedListMarker :: Stream s m Char
645+ => ListNumberStyle
637646 -> ListNumberDelim
638− -> Parser [Char] ParserState Int
647+ -> ParserT s ParserState m Int
639648orderedListMarker style delim = do
640649 let num = defaultNum <|> -- # can continue any kind of list
641650 case style of
@@ -655,12 +664,12 @@ orderedListMarker style delim = do
655664 return start
656665
657666-- | 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
659668charRef = do
660669 c <- characterReference
661670 return $ Str [c]
662671
663−lineBlockLine :: Parser [Char] st String
672+lineBlockLine :: Stream [Char] m Char => ParserT [Char] st m String
664673lineBlockLine = try $ do
665674 char '|'
666675 char ' '
@@ -671,7 +680,7 @@ lineBlockLine = try $ do
671680 return $ white ++ unwords (line : continuations)
672681
673682-- | 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]
675684lineBlockLines = try $ do
676685 lines' <- many1 lineBlockLine
677686 skipMany1 $ blankline <|> try (char '|' >> blankline)
@@ -679,11 +688,12 @@ lineBlockLines = try $ do
679688
680689-- | Parse a table using 'headerParser', 'rowParser',
681690-- 'lineParser', and 'footerParser'.
682−tableWith :: Parser [Char] ParserState ([[Block]], [Alignment], [Int])
683− -> ([Int] -> Parser [Char] ParserState [[Block]])
684− -> Parser [Char] ParserState sep
685− -> Parser [Char] ParserState end
686− -> Parser [Char] ParserState Block
691+tableWith :: Stream s m Char
692+ => ParserT s ParserState m ([[Block]], [Alignment], [Int])
693+ -> ([Int] -> ParserT s ParserState m [[Block]])
694+ -> ParserT s ParserState m sep
695+ -> ParserT s ParserState m end
696+ -> ParserT s ParserState m Block
687697tableWith headerParser rowParser lineParser footerParser = try $ do
688698 (heads, aligns, indices) <- headerParser
689699 lines' <- rowParser indices `sepEndBy1` lineParser
@@ -725,9 +735,10 @@ widthsFromIndices numColumns' indices =
725735-- (which may be grid), then the rows,
726736-- which may be grid, separated by blank lines, and
727737-- ending with a footer (dashed line followed by blank line).
728−gridTableWith :: Parser [Char] ParserState [Block] -- ^ Block list parser
738+gridTableWith :: Stream [Char] m Char
739+ => ParserT [Char] ParserState m [Block] -- ^ Block list parser
729740 -> Bool -- ^ Headerless table
730− -> Parser [Char] ParserState Block
741+ -> ParserT [Char] ParserState m Block
731742gridTableWith blocks headless =
732743 tableWith (gridTableHeader headless blocks) (gridTableRow blocks)
733744 (gridTableSep '-') gridTableFooter
@@ -736,27 +747,28 @@ gridTableSplitLine :: [Int] -> String -> [String]
736747gridTableSplitLine indices line = map removeFinalBar $ tail $
737748 splitStringByIndices (init indices) $ trimr line
738749
739−gridPart :: Char -> Parser [Char] st (Int, Int)
750+gridPart :: Stream s m Char => Char -> ParserT s st m (Int, Int)
740751gridPart ch = do
741752 dashes <- many1 (char ch)
742753 char '+'
743754 return (length dashes, length dashes + 1)
744755
745−gridDashedLines :: Char -> Parser [Char] st [(Int,Int)]
746−gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) >>~ blankline
756+gridDashedLines :: Stream s m Char => Char -> ParserT s st m [(Int,Int)]
757+gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline
747758
748759removeFinalBar :: String -> String
749760removeFinalBar =
750761 reverse . dropWhile (`elem` " \t") . dropWhile (=='|') . reverse
751762
752763-- | 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
754765gridTableSep ch = try $ gridDashedLines ch >> return '\n'
755766
756767-- | Parse header for a grid table.
757−gridTableHeader :: Bool -- ^ Headerless table
758− -> Parser [Char] ParserState [Block]
759− -> Parser [Char] ParserState ([[Block]], [Alignment], [Int])
768+gridTableHeader :: Stream [Char] m Char
769+ => Bool -- ^ Headerless table
770+ -> ParserT [Char] ParserState m [Block]
771+ -> ParserT [Char] ParserState m ([[Block]], [Alignment], [Int])
760772gridTableHeader headless blocks = try $ do
761773 optional blanklines
762774 dashes <- gridDashedLines '-'
@@ -779,16 +791,17 @@ gridTableHeader headless blocks = try $ do
779791 heads <- mapM (parseFromString blocks) $ map trim rawHeads
780792 return (heads, aligns, indices)
781793
782−gridTableRawLine :: [Int] -> Parser [Char] ParserState [String]
794+gridTableRawLine :: Stream s m Char => [Int] -> ParserT s ParserState m [String]
783795gridTableRawLine indices = do
784796 char '|'
785797 line <- many1Till anyChar newline
786798 return (gridTableSplitLine indices line)
787799
788800-- | Parse row of grid table.
789−gridTableRow :: Parser [Char] ParserState [Block]
801+gridTableRow :: Stream [Char] m Char
802+ => ParserT [Char] ParserState m [Block]
790803 -> [Int]
791− -> Parser [Char] ParserState [[Block]]
804+ -> ParserT [Char] ParserState m [[Block]]
792805gridTableRow blocks indices = do
793806 colLines <- many1 (gridTableRawLine indices)
794807 let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $
@@ -807,15 +820,16 @@ compactifyCell :: [Block] -> [Block]
807820compactifyCell bs = head $ compactify [bs]
808821
809822-- | Parse footer for a grid table.
810−gridTableFooter :: Parser [Char] ParserState [Char]
823+gridTableFooter :: Stream s m Char => ParserT s ParserState m [Char]
811824gridTableFooter = blanklines
812825
813826---
814827
815828-- | 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
817831 -> st -- ^ initial state
818− -> [Char] -- ^ input
832+ -> s -- ^ input
819833 -> a
820834readWith parser state input =
821835 case runParser parser state "source" input of
@@ -823,15 +837,16 @@ readWith parser state input =
823837 let errPos = errorPos err'
824838 errLine = sourceLine errPos
825839 errColumn = sourceColumn errPos
826− theline = (lines input ++ [""]) !! (errLine - 1)
840+ theline = (lines (show input) ++ [""]) !! (errLine - 1)
827841 in error $ "\nError at " ++ show err' ++ "\n" ++
828842 theline ++ "\n" ++ replicate (errColumn - 1) ' ' ++
829843 "^"
830844 Right result -> result
831845
832846-- | Parse a string with @parser@ (for testing).
833−testStringWith :: (Show a) => Parser [Char] ParserState a
834− -> String
847+testStringWith :: (Show s, Show a, Stream s Identity Char)
848+ => ParserT s ParserState Identity a
849+ -> s
835850 -> IO ()
836851testStringWith parser str = UTF8.putStrLn $ show $
837852 readWith parser defaultParserState str
@@ -878,9 +893,9 @@ instance HasMeta ParserState where
878893
879894class HasReaderOptions st where
880895 extractReaderOptions :: st -> ReaderOptions
881− getOption :: (ReaderOptions -> b) -> Parser s st b
896+ getOption :: (Stream s m t) => (ReaderOptions -> b) -> ParserT s st m b
882897 -- default
883− getOption f = (f . extractReaderOptions) `fmap` getState
898+ getOption f = (f . extractReaderOptions) <$> getState
884899
885900instance HasReaderOptions ParserState where
886901 extractReaderOptions = stateOptions
@@ -946,19 +961,19 @@ defaultParserState =
946961 stateWarnings = []}
947962
948963-- | 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 ()
950965guardEnabled ext = getOption readerExtensions >>= guard . Set.member ext
951966
952967-- | 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 ()
954969guardDisabled ext = getOption readerExtensions >>= guard . not . Set.member ext
955970
956971-- | 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 ()
958973updateLastStrPos = getPosition >>= updateState . setLastStrPos
959974
960975-- | 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
962977notAfterString = do
963978 pos <- getPosition
964979 st <- getState
@@ -998,10 +1013,10 @@ type SubstTable = M.Map Key Inlines
9981013-- and the auto_identifers extension is set, generate a new
9991014-- unique identifier, and update the list of identifiers
10001015-- in state.
1001−registerHeader :: (HasReaderOptions st, HasHeaderMap st, HasIdentifierList st)
1002− => Attr -> Inlines -> Parser s st Attr
1016+registerHeader :: (Stream s m a, HasReaderOptions st, HasHeaderMap st, HasIdentifierList st)
1017+ => Attr -> Inlines -> ParserT s st m Attr
10031018registerHeader (ident,classes,kvs) header' = do
1004− ids <- extractIdentifierList `fmap` getState
1019+ ids <- extractIdentifierList <$> getState
10051020 exts <- getOption readerExtensions
10061021 let insert' = M.insertWith (\_new old -> old)
10071022 if null ident && Ext_auto_identifiers `Set.member` exts
@@ -1020,25 +1035,28 @@ registerHeader (ident,classes,kvs) header' = do
10201035 return (ident,classes,kvs)
10211036
10221037-- | 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 ()
10241039failUnlessSmart = getOption readerSmart >>= guard
10251040
1026−smartPunctuation :: Parser [Char] ParserState Inlines
1027− -> Parser [Char] ParserState Inlines
1041+smartPunctuation :: Stream s m Char
1042+ => ParserT s ParserState m Inlines
1043+ -> ParserT s ParserState m Inlines
10281044smartPunctuation inlineParser = do
10291045 failUnlessSmart
10301046 choice [ quoted inlineParser, apostrophe, dash, ellipses ]
10311047
1032−apostrophe :: Parser [Char] ParserState Inlines
1048+apostrophe :: Stream s m Char => ParserT s st m Inlines
10331049apostrophe = (char '\'' <|> char '\8217') >> return (B.str "\x2019")
10341050
1035−quoted :: Parser [Char] ParserState Inlines
1036− -> Parser [Char] ParserState Inlines
1051+quoted :: Stream s m Char
1052+ => ParserT s ParserState m Inlines
1053+ -> ParserT s ParserState m Inlines
10371054quoted inlineParser = doubleQuoted inlineParser <|> singleQuoted inlineParser
10381055
1039−withQuoteContext :: QuoteContext
1040− -> Parser [tok] ParserState a
1041− -> Parser [tok] ParserState a
1056+withQuoteContext :: Stream s m t
1057+ => QuoteContext
1058+ -> ParserT s ParserState m a
1059+ -> ParserT s ParserState m a
10421060withQuoteContext context parser = do
10431061 oldState <- getState
10441062 let oldQuoteContext = stateQuoteContext oldState
@@ -1048,108 +1066,122 @@ withQuoteContext context parser = do
10481066 setState newState { stateQuoteContext = oldQuoteContext }
10491067 return result
10501068
1051−singleQuoted :: Parser [Char] ParserState Inlines
1052− -> Parser [Char] ParserState Inlines
1069+singleQuoted :: Stream s m Char
1070+ => ParserT s ParserState m Inlines
1071+ -> ParserT s ParserState m Inlines
10531072singleQuoted inlineParser = try $ do
10541073 singleQuoteStart
10551074 withQuoteContext InSingleQuote $ many1Till inlineParser singleQuoteEnd >>=
10561075 return . B.singleQuoted . mconcat
10571076
1058−doubleQuoted :: Parser [Char] ParserState Inlines
1059− -> Parser [Char] ParserState Inlines
1077+doubleQuoted :: Stream s m Char
1078+ => ParserT s ParserState m Inlines
1079+ -> ParserT s ParserState m Inlines
10601080doubleQuoted inlineParser = try $ do
10611081 doubleQuoteStart
10621082 withQuoteContext InDoubleQuote $ manyTill inlineParser doubleQuoteEnd >>=
10631083 return . B.doubleQuoted . mconcat
10641084
1065−failIfInQuoteContext :: QuoteContext -> Parser [tok] ParserState ()
1085+failIfInQuoteContext :: Stream s m t
1086+ => QuoteContext
1087+ -> ParserT s ParserState m ()
10661088failIfInQuoteContext context = do
10671089 st <- getState
10681090 if stateQuoteContext st == context
10691091 then fail "already inside quotes"
10701092 else return ()
10711093
1072−charOrRef :: [Char] -> Parser [Char] st Char
1094+charOrRef :: Stream s m Char => String -> ParserT s st m Char
10731095charOrRef cs =
10741096 oneOf cs <|> try (do c <- characterReference
10751097 guard (c `elem` cs)
10761098 return c)
10771099
1078−singleQuoteStart :: Parser [Char] ParserState ()
1100+singleQuoteStart :: Stream s m Char
1101+ => ParserT s ParserState m ()
10791102singleQuoteStart = do
10801103 failIfInQuoteContext InSingleQuote
10811104 -- single quote start can't be right after str
10821105 guard =<< notAfterString
10831106 () <$ charOrRef "'\8216\145"
10841107
1085−singleQuoteEnd :: Parser [Char] st ()
1108+singleQuoteEnd :: Stream s m Char
1109+ => ParserT s st m ()
10861110singleQuoteEnd = try $ do
10871111 charOrRef "'\8217\146"
10881112 notFollowedBy alphaNum
10891113
1090−doubleQuoteStart :: Parser [Char] ParserState ()
1114+doubleQuoteStart :: Stream s m Char
1115+ => ParserT s ParserState m ()
10911116doubleQuoteStart = do
10921117 failIfInQuoteContext InDoubleQuote
10931118 try $ do charOrRef "\"\8220\147"
10941119 notFollowedBy . satisfy $ flip elem [' ', '\t', '\n']
10951120
1096−doubleQuoteEnd :: Parser [Char] st ()
1097−doubleQuoteEnd = do
1098− charOrRef "\"\8221\148"
1099− return ()
1121+doubleQuoteEnd :: Stream s m Char
1122+ => ParserT s st m ()
1123+doubleQuoteEnd = void (charOrRef "\"\8221\148")
11001124
1101−ellipses :: Parser [Char] st Inlines
1125+ellipses :: Stream s m Char
1126+ => ParserT s st m Inlines
11021127ellipses = do
11031128 try (charOrRef "\8230\133") <|> try (string "..." >> return '…')
11041129 return (B.str "\8230")
11051130
1106−dash :: Parser [Char] ParserState Inlines
1131+dash :: Stream s m Char => ParserT s ParserState m Inlines
11071132dash = do
11081133 oldDashes <- getOption readerOldDashes
11091134 if oldDashes
11101135 then emDashOld <|> enDashOld
1111− else B.str `fmap` (hyphenDash <|> emDash <|> enDash)
1136+ else B.str <$> (hyphenDash <|> emDash <|> enDash)
11121137
11131138-- 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
11151141hyphenDash = do
11161142 try $ string "--"
11171143 option "\8211" (char '-' >> return "\8212")
11181144
1119−emDash :: Parser [Char] st String
1145+emDash :: Stream s m Char
1146+ => ParserT s st m String
11201147emDash = do
11211148 try (charOrRef "\8212\151")
11221149 return "\8212"
11231150
1124−enDash :: Parser [Char] st String
1151+enDash :: Stream s m Char
1152+ => ParserT s st m String
11251153enDash = do
11261154 try (charOrRef "\8212\151")
11271155 return "\8211"
11281156
1129−enDashOld :: Parser [Char] st Inlines
1157+enDashOld :: Stream s m Char
1158+ => ParserT s st m Inlines
11301159enDashOld = do
11311160 try (charOrRef "\8211\150") <|>
11321161 try (char '-' >> lookAhead (satisfy isDigit) >> return '–')
11331162 return (B.str "\8211")
11341163
1135−emDashOld :: Parser [Char] st Inlines
1164+emDashOld :: Stream s m Char
1165+ => ParserT s st m Inlines
11361166emDashOld = do
11371167 try (charOrRef "\8212\151") <|> (try $ string "--" >> optional (char '-') >> return '-')
11381168 return (B.str "\8212")
11391169
11401170-- This is used to prevent exponential blowups for things like:
11411171-- a**a*a**a*a**a*a**a*a**a*a**a*a**
1142−nested :: Parser s ParserState a
1143− -> Parser s ParserState a
1172+nested :: Stream s m a
1173+ => ParserT s ParserState m a
1174+ -> ParserT s ParserState m a
11441175nested p = do
1145− nestlevel <- stateMaxNestingLevel `fmap` getState
1176+ nestlevel <- stateMaxNestingLevel <$> getState
11461177 guard $ nestlevel > 0
11471178 updateState $ \st -> st{ stateMaxNestingLevel = stateMaxNestingLevel st - 1 }
11481179 res <- p
11491180 updateState $ \st -> st{ stateMaxNestingLevel = nestlevel }
11501181 return res
11511182
1152−citeKey :: HasLastStrPosition st => Parser [Char] st (Bool, String)
1183+citeKey :: (Stream s m Char, HasLastStrPosition st)
1184+ => ParserT s st m (Bool, String)
11531185citeKey = try $ do
11541186 guard =<< notAfterString
11551187 suppress_author <- option False (char '-' *> return True)
@@ -1166,7 +1198,8 @@ citeKey = try $ do
11661198--
11671199
11681200-- | 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
11701203macro = do
11711204 apply <- getOption readerApplyMacros
11721205 inp <- getInput
@@ -1181,10 +1214,12 @@ macro = do
11811214 else return $ rawBlock "latex" def'
11821215
11831216-- | Apply current macros to string.
1184−applyMacros' :: String -> Parser [Char] ParserState String
1217+applyMacros' :: Stream [Char] m Char
1218+ => String
1219+ -> ParserT [Char] ParserState m String
11851220applyMacros' target = do
11861221 apply <- getOption readerApplyMacros
11871222 if apply
1188− then do macros <- extractMacros `fmap` getState
1223+ then do macros <- extractMacros <$> getState
11891224 return $ applyMacros macros target
11901225 else return target