Generalised all functions in Parsing.hs

Before it wasn't possible to use these general combinators with the ParsecT
transformer but with the more general types this is now possible.

src/Text/Pandoc/Parsing.hs

@@ -1,5 +1,8 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances,
+{-# LANGUAGE 
-    FlexibleInstances#-}
+  FlexibleContexts
+, GeneralizedNewtypeDeriving
+, TypeSynonymInstances
+, FlexibleInstances #-}
 {-
 Copyright (C) 2006-2014 John MacFarlane <jgm@berkeley.edu>
 
@@ -177,12 +180,15 @@ import Text.Pandoc.Asciify (toAsciiChar)
 import Data.Default
 import qualified Data.Set as Set
 import Control.Monad.Reader
-import Control.Applicative ((*>), (<*), (<$), liftA2, Applicative)
+import Control.Monad.Identity
+import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$), Applicative)
 import Data.Monoid
 import Data.Maybe (catMaybes)
 
 type Parser t s = Parsec t s
 
+type ParserT = ParsecT
+
 newtype F a = F { unF :: Reader ParserState a } deriving (Monad, Applicative, Functor)
 
 runF :: F a -> ParserState -> a
@@ -201,11 +207,11 @@ instance Monoid a => Monoid (F a) where
 
 -- | Like >>, but returns the operation on the left.
 -- (Suggested by Tillmann Rendel on Haskell-cafe list.)
-(>>~) :: (Monad m) => m a -> m b -> m a
+(>>~) :: (Applicative m) => m a -> m b -> m a
-a >>~ b = a >>= \x -> b >> return x
+a >>~ b = a <* b 
 
 -- | Parse any line of text
-anyLine :: Parser [Char] st [Char]
+anyLine :: Stream [Char] m Char => ParserT [Char] st m [Char]
 anyLine = do
   -- This is much faster than:
   -- manyTill anyChar newline
@@ -221,9 +227,10 @@ anyLine = do
        _ -> mzero
 
 -- | Like @manyTill@, but reads at least one item.
-many1Till :: Parser [tok] st a
+many1Till :: Stream s m t 
-          -> Parser [tok] st end
+          => ParserT s st m a
-          -> Parser [tok] st [a]
+          -> ParserT s st m end
+          -> ParserT s st m [a]
 many1Till p end = do
          first <- p
          rest <- manyTill p end
@@ -232,14 +239,14 @@ many1Till p end = do
 -- | A more general form of @notFollowedBy@.  This one allows any
 -- type of parser to be specified, and succeeds only if that parser fails.
 -- It does not consume any input.
-notFollowedBy' :: Show b => Parser [a] st b -> Parser [a] st ()
+notFollowedBy' :: (Show b, Stream s m a) => ParserT s st m b -> ParserT s st m ()
 notFollowedBy' p  = try $ join $  do  a <- try p
                                       return (unexpected (show a))
                                   <|>
                                   return (return ())
 -- (This version due to Andrew Pimlott on the Haskell mailing list.)
 
-oneOfStrings' :: (Char -> Char -> Bool) -> [String] -> Parser [Char] st String
+oneOfStrings' :: Stream s m Char => (Char -> Char -> Bool) -> [String] -> ParserT s st m String
 oneOfStrings' _ []   = fail "no strings"
 oneOfStrings' matches strs = try $ do
   c <- anyChar
@@ -254,11 +261,11 @@ oneOfStrings' matches strs = try $ do
 -- | Parses one of a list of strings.  If the list contains
 -- two strings one of which is a prefix of the other, the longer
 -- string will be matched if possible.
-oneOfStrings :: [String] -> Parser [Char] st String
+oneOfStrings :: Stream s m Char => [String] -> ParserT s st m String
 oneOfStrings = oneOfStrings' (==)
 
 -- | Parses one of a list of strings (tried in order), case insensitive.
-oneOfStringsCI :: [String] -> Parser [Char] st String
+oneOfStringsCI :: Stream s m Char => [String] -> ParserT s st m String
 oneOfStringsCI = oneOfStrings' ciMatch
   where ciMatch x y = toLower' x == toLower' y
         -- this optimizes toLower by checking common ASCII case
@@ -269,35 +276,35 @@ oneOfStringsCI = oneOfStrings' ciMatch
                    | otherwise = toLower c
 
 -- | Parses a space or tab.
-spaceChar :: Parser [Char] st Char
+spaceChar :: Stream s m Char => ParserT s st m Char
 spaceChar = satisfy $ \c -> c == ' ' || c == '\t'
 
 -- | Parses a nonspace, nonnewline character.
-nonspaceChar :: Parser [Char] st Char
+nonspaceChar :: Stream s m Char => ParserT s st m Char
 nonspaceChar = satisfy $ flip notElem ['\t', '\n', ' ', '\r']
 
 -- | Skips zero or more spaces or tabs.
-skipSpaces :: Parser [Char] st ()
+skipSpaces :: Stream s m Char => ParserT s st m ()
 skipSpaces = skipMany spaceChar
 
 -- | Skips zero or more spaces or tabs, then reads a newline.
-blankline :: Parser [Char] st Char
+blankline :: Stream s m Char => ParserT s st m Char
 blankline = try $ skipSpaces >> newline
 
 -- | Parses one or more blank lines and returns a string of newlines.
-blanklines :: Parser [Char] st [Char]
+blanklines :: Stream s m Char => ParserT s st m [Char]
 blanklines = many1 blankline
 
 -- | Parses material enclosed between start and end parsers.
-enclosed :: Parser [Char] st t   -- ^ start parser
+enclosed :: Stream s  m Char => ParserT s st m t   -- ^ start parser
-         -> Parser [Char] st end  -- ^ end parser
+         -> ParserT s st m end  -- ^ end parser
-         -> Parser [Char] st a    -- ^ content parser (to be used repeatedly)
+         -> ParserT s st m a    -- ^ content parser (to be used repeatedly)
-         -> Parser [Char] st [a]
+         -> ParserT s st m [a]
 enclosed start end parser = try $
   start >> notFollowedBy space >> many1Till parser end
 
 -- | Parse string, case insensitive.
-stringAnyCase :: [Char] -> Parser [Char] st String
+stringAnyCase :: Stream s m Char => [Char] -> ParserT s st m String
 stringAnyCase [] = string ""
 stringAnyCase (x:xs) = do
   firstChar <- char (toUpper x) <|> char (toLower x)
@@ -305,7 +312,7 @@ stringAnyCase (x:xs) = do
   return (firstChar:rest)
 
 -- | Parse contents of 'str' using 'parser' and return result.
-parseFromString :: Parser [tok] st a -> [tok] -> Parser [tok] st a
+parseFromString :: Stream s m t => ParserT s st m a -> s -> ParserT s st m a
 parseFromString parser str = do
   oldPos <- getPosition
   oldInput <- getInput
@@ -316,7 +323,7 @@ parseFromString parser str = do
   return result
 
 -- | Parse raw line block up to and including blank lines.
-lineClump :: Parser [Char] st String
+lineClump :: Stream [Char] m Char => ParserT [Char] st m String
 lineClump = blanklines
           <|> (many1 (notFollowedBy blankline >> anyLine) >>= return . unlines)
 
@@ -325,8 +332,8 @@ lineClump = blanklines
 -- pairs of open and close, which must be different. For example,
 -- @charsInBalanced '(' ')' anyChar@ will parse "(hello (there))"
 -- and return "hello (there)".
-charsInBalanced :: Char -> Char -> Parser [Char] st Char
+charsInBalanced :: Stream s m Char => Char -> Char -> ParserT s st m Char
-                -> Parser [Char] st String
+                -> ParserT s st m String
 charsInBalanced open close parser = try $ do
   char open
   let isDelim c = c == open || c == close
@@ -350,8 +357,8 @@ uppercaseRomanDigits :: [Char]
 uppercaseRomanDigits = map toUpper lowercaseRomanDigits
 
 -- | Parses a roman numeral (uppercase or lowercase), returns number.
-romanNumeral :: Bool                  -- ^ Uppercase if true
+romanNumeral :: Stream s m Char => Bool                  -- ^ Uppercase if true
-             -> Parser [Char] st Int
+             -> ParserT s st m Int
 romanNumeral upperCase = do
     let romanDigits = if upperCase
                          then uppercaseRomanDigits
@@ -383,8 +390,8 @@ romanNumeral upperCase = do
 
 -- | Parses an email address; returns original and corresponding
 -- escaped mailto: URI.
-emailAddress :: Parser [Char] st (String, String)
+emailAddress :: Stream s m Char => ParserT s st m (String, String)
-emailAddress = try $ liftA2 toResult mailbox (char '@' *> domain)
+emailAddress = try $ toResult <$> mailbox <*> (char '@' *> domain)
  where toResult mbox dom = let full = fromEntities $ mbox ++ '@':dom
                            in  (full, escapeURI $ "mailto:" ++ full)
        mailbox           = intercalate "." `fmap` (emailWord `sepby1` dot)
@@ -398,7 +405,7 @@ emailAddress = try $ liftA2 toResult mailbox (char '@' *> domain)
        isEmailPunct c    = c `elem` "!\"#$%&'*+-/=?^_{|}~;"
        -- note: sepBy1 from parsec consumes input when sep
        -- succeeds and p fails, so we use this variant here.
-       sepby1 p sep      = liftA2 (:) p (many (try $ sep >> p))
+       sepby1 p sep      = (:) <$> p <*> (many (try $ sep >> p))
 
 
 -- Schemes from http://www.iana.org/assignments/uri-schemes.html plus
@@ -426,11 +433,11 @@ schemes = ["coap","doi","javascript","aaa","aaas","about","acap","cap","cid",
            "ventrilo","view-source","webcal","wtai","wyciwyg","xfire","xri",
            "ymsgr"]
 
-uriScheme :: Parser [Char] st String
+uriScheme :: Stream s m Char => ParserT s st m String
 uriScheme = oneOfStringsCI schemes
 
 -- | Parses a URI. Returns pair of original and URI-escaped version.
-uri :: Parser [Char] st (String, String)
+uri :: Stream [Char] m Char => ParserT [Char] st m (String, String)
 uri = try $ do
   scheme <- uriScheme
   char ':'
@@ -460,7 +467,7 @@ uri = try $ do
   let uri' = scheme ++ ":" ++ fromEntities str'
   return (uri', escapeURI uri')
 
-mathInlineWith :: String -> String -> Parser [Char] st String
+mathInlineWith :: Stream s m Char  => String -> String -> ParserT s st m String
 mathInlineWith op cl = try $ do
   string op
   notFollowedBy space
@@ -474,12 +481,12 @@ mathInlineWith op cl = try $ do
   notFollowedBy digit  -- to prevent capture of $5
   return $ concat words'
 
-mathDisplayWith :: String -> String -> Parser [Char] st String
+mathDisplayWith :: Stream s m Char => String -> String -> ParserT s st m String
 mathDisplayWith op cl = try $ do
   string op
   many1Till (noneOf "\n" <|> (newline >>~ notFollowedBy' blankline)) (try $ string cl)
 
-mathDisplay :: Parser [Char] ParserState String
+mathDisplay :: Stream s m Char => ParserT s ParserState m String
 mathDisplay =
       (guardEnabled Ext_tex_math_dollars >> mathDisplayWith "$$" "$$")
   <|> (guardEnabled Ext_tex_math_single_backslash >>
@@ -487,7 +494,7 @@ mathDisplay =
   <|> (guardEnabled Ext_tex_math_double_backslash >>
        mathDisplayWith "\\\\[" "\\\\]")
 
-mathInline :: Parser [Char] ParserState String
+mathInline :: Stream s m Char => ParserT s ParserState m String
 mathInline =
       (guardEnabled Ext_tex_math_dollars >> mathInlineWith "$" "$")
   <|> (guardEnabled Ext_tex_math_single_backslash >>
@@ -499,8 +506,9 @@ mathInline =
 -- displacement (the difference between the source column at the end
 -- and the source column at the beginning). Vertical displacement
 -- (source row) is ignored.
-withHorizDisplacement :: Parser [Char] st a  -- ^ Parser to apply
+withHorizDisplacement :: Stream s m Char 
-                      -> Parser [Char] st (a, Int) -- ^ (result, displacement)
+                      => ParserT s st m a  -- ^ Parser to apply
+                      -> ParserT s st m (a, Int) -- ^ (result, displacement)
 withHorizDisplacement parser = do
   pos1 <- getPosition
   result <- parser
@@ -509,7 +517,7 @@ withHorizDisplacement parser = do
 
 -- | Applies a parser and returns the raw string that was parsed,
 -- along with the value produced by the parser.
-withRaw :: Monad m => ParsecT [Char] st m a -> ParsecT [Char] st m (a, [Char])
+withRaw :: Stream [Char] m Char => ParsecT [Char] st m a -> ParsecT [Char] st m (a, [Char])
 withRaw parser = do
   pos1 <- getPosition
   inp <- getInput
@@ -525,12 +533,13 @@ withRaw parser = do
   return (result, raw)
 
 -- | Parses backslash, then applies character parser.
-escaped :: Parser [Char] st Char  -- ^ Parser for character to escape
+escaped :: Stream s m Char 
-        -> Parser [Char] st Char
+        => ParserT s st m Char  -- ^ Parser for character to escape
+        -> ParserT s st m Char
 escaped parser = try $ char '\\' >> parser
 
 -- | Parse character entity.
-characterReference :: Parser [Char] st Char
+characterReference :: Stream s m Char => ParserT s st m Char
 characterReference = try $ do
   char '&'
   ent <- many1Till nonspaceChar (char ';')
@@ -539,19 +548,19 @@ characterReference = try $ do
        Nothing -> fail "entity not found"
 
 -- | Parses an uppercase roman numeral and returns (UpperRoman, number).
-upperRoman :: Parser [Char] st (ListNumberStyle, Int)
+upperRoman :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
 upperRoman = do
   num <- romanNumeral True
   return (UpperRoman, num)
 
 -- | Parses a lowercase roman numeral and returns (LowerRoman, number).
-lowerRoman :: Parser [Char] st (ListNumberStyle, Int)
+lowerRoman :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
 lowerRoman = do
   num <- romanNumeral False
   return (LowerRoman, num)
 
 -- | Parses a decimal numeral and returns (Decimal, number).
-decimal :: Parser [Char] st (ListNumberStyle, Int)
+decimal :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
 decimal = do
   num <- many1 digit
   return (Decimal, read num)
@@ -560,7 +569,8 @@ decimal = do
 -- returns (DefaultStyle, [next example number]).  The next
 -- example number is incremented in parser state, and the label
 -- (if present) is added to the label table.
-exampleNum :: Parser [Char] ParserState (ListNumberStyle, Int)
+exampleNum :: Stream s m Char 
+           => ParserT s ParserState m (ListNumberStyle, Int)
 exampleNum = do
   char '@'
   lab <- many (alphaNum <|> satisfy (\c -> c == '_' || c == '-'))
@@ -574,38 +584,39 @@ exampleNum = do
   return (Example, num)
 
 -- | Parses a '#' returns (DefaultStyle, 1).
-defaultNum :: Parser [Char] st (ListNumberStyle, Int)
+defaultNum :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
 defaultNum = do
   char '#'
   return (DefaultStyle, 1)
 
 -- | Parses a lowercase letter and returns (LowerAlpha, number).
-lowerAlpha :: Parser [Char] st (ListNumberStyle, Int)
+lowerAlpha :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
 lowerAlpha = do
   ch <- oneOf ['a'..'z']
   return (LowerAlpha, ord ch - ord 'a' + 1)
 
 -- | Parses an uppercase letter and returns (UpperAlpha, number).
-upperAlpha :: Parser [Char] st (ListNumberStyle, Int)
+upperAlpha :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
 upperAlpha = do
   ch <- oneOf ['A'..'Z']
   return (UpperAlpha, ord ch - ord 'A' + 1)
 
 -- | Parses a roman numeral i or I
-romanOne :: Parser [Char] st (ListNumberStyle, Int)
+romanOne :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
 romanOne = (char 'i' >> return (LowerRoman, 1)) <|>
            (char 'I' >> return (UpperRoman, 1))
 
 -- | Parses an ordered list marker and returns list attributes.
-anyOrderedListMarker :: Parser [Char] ParserState ListAttributes
+anyOrderedListMarker :: Stream s m Char => ParserT s ParserState m ListAttributes
 anyOrderedListMarker = choice $
   [delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],
                            numParser <- [decimal, exampleNum, defaultNum, romanOne,
                            lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
 
 -- | Parses a list number (num) followed by a period, returns list attributes.
-inPeriod :: Parser [Char] st (ListNumberStyle, Int)
+inPeriod :: Stream s m Char 
-         -> Parser [Char] st ListAttributes
+         => ParserT s st m (ListNumberStyle, Int)
+         -> ParserT s st m ListAttributes
 inPeriod num = try $ do
   (style, start) <- num
   char '.'
@@ -615,16 +626,18 @@ inPeriod num = try $ do
   return (start, style, delim)
 
 -- | Parses a list number (num) followed by a paren, returns list attributes.
-inOneParen :: Parser [Char] st (ListNumberStyle, Int)
+inOneParen :: Stream s m Char 
-           -> Parser [Char] st ListAttributes
+           => ParserT s st m (ListNumberStyle, Int)
+           -> ParserT s st m ListAttributes
 inOneParen num = try $ do
   (style, start) <- num
   char ')'
   return (start, style, OneParen)
 
 -- | Parses a list number (num) enclosed in parens, returns list attributes.
-inTwoParens :: Parser [Char] st (ListNumberStyle, Int)
+inTwoParens :: Stream s m Char 
-            -> Parser [Char] st ListAttributes
+            => ParserT s st m (ListNumberStyle, Int)
+            -> ParserT s st m ListAttributes
 inTwoParens num = try $ do
   char '('
   (style, start) <- num
@@ -633,9 +646,10 @@ inTwoParens num = try $ do
 
 -- | Parses an ordered list marker with a given style and delimiter,
 -- returns number.
-orderedListMarker :: ListNumberStyle
+orderedListMarker :: Stream s m Char 
+                  => ListNumberStyle
                   -> ListNumberDelim
-                  -> Parser [Char] ParserState Int
+                  -> ParserT s ParserState m Int
 orderedListMarker style delim = do
   let num = defaultNum <|>  -- # can continue any kind of list
             case style of
@@ -655,12 +669,12 @@ orderedListMarker style delim = do
   return start
 
 -- | Parses a character reference and returns a Str element.
-charRef :: Parser [Char] st Inline
+charRef :: Stream s m Char => ParserT s st m Inline
 charRef = do
   c <- characterReference
   return $ Str [c]
 
-lineBlockLine :: Parser [Char] st String
+lineBlockLine :: Stream [Char] m Char => ParserT [Char] st m String
 lineBlockLine = try $ do
   char '|'
   char ' '
@@ -671,7 +685,7 @@ lineBlockLine = try $ do
   return $ white ++ unwords (line : continuations)
 
 -- | Parses an RST-style line block and returns a list of strings.
-lineBlockLines :: Parser [Char] st [String]
+lineBlockLines :: Stream [Char] m Char => ParserT [Char] st m [String]
 lineBlockLines = try $ do
   lines' <- many1 lineBlockLine
   skipMany1 $ blankline <|> try (char '|' >> blankline)
@@ -679,11 +693,12 @@ lineBlockLines = try $ do
 
 -- | Parse a table using 'headerParser', 'rowParser',
 -- 'lineParser', and 'footerParser'.
-tableWith :: Parser [Char] ParserState ([[Block]], [Alignment], [Int])
+tableWith :: Stream s m Char 
-          -> ([Int] -> Parser [Char] ParserState [[Block]])
+          => ParserT s ParserState m ([[Block]], [Alignment], [Int])
-          -> Parser [Char] ParserState sep
+          -> ([Int] -> ParserT s ParserState m [[Block]])
-          -> Parser [Char] ParserState end
+          -> ParserT s ParserState m sep
-          -> Parser [Char] ParserState Block
+          -> ParserT s ParserState m end
+          -> ParserT s ParserState m Block
 tableWith headerParser rowParser lineParser footerParser = try $ do
     (heads, aligns, indices) <- headerParser
     lines' <- rowParser indices `sepEndBy1` lineParser
@@ -725,9 +740,10 @@ widthsFromIndices numColumns' indices =
 -- (which may be grid), then the rows,
 -- which may be grid, separated by blank lines, and
 -- ending with a footer (dashed line followed by blank line).
-gridTableWith :: Parser [Char] ParserState [Block]   -- ^ Block list parser
+gridTableWith :: Stream [Char] m Char 
+              => ParserT [Char] ParserState m [Block]   -- ^ Block list parser
               -> Bool                                -- ^ Headerless table
-              -> Parser [Char] ParserState Block
+              -> ParserT [Char] ParserState m Block
 gridTableWith blocks headless =
   tableWith (gridTableHeader headless blocks) (gridTableRow blocks)
             (gridTableSep '-') gridTableFooter
@@ -736,13 +752,13 @@ gridTableSplitLine :: [Int] -> String -> [String]
 gridTableSplitLine indices line = map removeFinalBar $ tail $
   splitStringByIndices (init indices) $ trimr line
 
-gridPart :: Char -> Parser [Char] st (Int, Int)
+gridPart :: Stream s m Char => Char -> ParserT s st m (Int, Int)
 gridPart ch = do
   dashes <- many1 (char ch)
   char '+'
   return (length dashes, length dashes + 1)
 
-gridDashedLines :: Char -> Parser [Char] st [(Int,Int)]
+gridDashedLines :: Stream s m Char => Char -> ParserT s st m [(Int,Int)]
 gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) >>~ blankline
 
 removeFinalBar :: String -> String
@@ -750,13 +766,14 @@ removeFinalBar =
   reverse . dropWhile (`elem` " \t") . dropWhile (=='|') . reverse
 
 -- | Separator between rows of grid table.
-gridTableSep :: Char -> Parser [Char] ParserState Char
+gridTableSep :: Stream s m Char => Char -> ParserT s ParserState m Char
 gridTableSep ch = try $ gridDashedLines ch >> return '\n'
 
 -- | Parse header for a grid table.
-gridTableHeader :: Bool -- ^ Headerless table
+gridTableHeader :: Stream [Char] m Char 
-                -> Parser [Char] ParserState [Block]
+                => Bool -- ^ Headerless table
-                -> Parser [Char] ParserState ([[Block]], [Alignment], [Int])
+                -> ParserT [Char] ParserState m [Block]
+                -> ParserT [Char] ParserState m ([[Block]], [Alignment], [Int])
 gridTableHeader headless blocks = try $ do
   optional blanklines
   dashes <- gridDashedLines '-'
@@ -779,16 +796,17 @@ gridTableHeader headless blocks = try $ do
   heads <- mapM (parseFromString blocks) $ map trim rawHeads
   return (heads, aligns, indices)
 
-gridTableRawLine :: [Int] -> Parser [Char] ParserState [String]
+gridTableRawLine :: Stream s m Char => [Int] -> ParserT s ParserState m [String]
 gridTableRawLine indices = do
   char '|'
   line <- many1Till anyChar newline
   return (gridTableSplitLine indices line)
 
 -- | Parse row of grid table.
-gridTableRow :: Parser [Char] ParserState [Block]
+gridTableRow :: Stream [Char]  m Char 
+             => ParserT [Char] ParserState m [Block]
              -> [Int]
-             -> Parser [Char] ParserState [[Block]]
+             -> ParserT [Char] ParserState m [[Block]]
 gridTableRow blocks indices = do
   colLines <- many1 (gridTableRawLine indices)
   let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $
@@ -807,15 +825,16 @@ compactifyCell :: [Block] -> [Block]
 compactifyCell bs = head $ compactify [bs]
 
 -- | Parse footer for a grid table.
-gridTableFooter :: Parser [Char] ParserState [Char]
+gridTableFooter :: Stream s m Char => ParserT s ParserState m [Char]
 gridTableFooter = blanklines
 
 ---
 
 -- | Parse a string with a given parser and state.
-readWith :: Parser [Char] st a       -- ^ parser
+readWith :: (Show s, Stream s Identity Char) 
+         => ParserT s st Identity a       -- ^ parser
          -> st                       -- ^ initial state
-         -> [Char]                   -- ^ input
+         -> s                   -- ^ input
          -> a
 readWith parser state input =
     case runParser parser state "source" input of
@@ -823,15 +842,16 @@ readWith parser state input =
         let errPos = errorPos err'
             errLine = sourceLine errPos
             errColumn = sourceColumn errPos
-            theline = (lines input ++ [""]) !! (errLine - 1)
+            theline = (lines (show input) ++ [""]) !! (errLine - 1)
         in  error $ "\nError at " ++ show  err' ++ "\n" ++
                 theline ++ "\n" ++ replicate (errColumn - 1) ' ' ++
                 "^"
       Right result -> result
 
 -- | Parse a string with @parser@ (for testing).
-testStringWith :: (Show a) => Parser [Char] ParserState a
+testStringWith :: (Show s, Show a, Stream s Identity Char) 
-               -> String
+               => ParserT s ParserState Identity a
+               -> s
                -> IO ()
 testStringWith parser str = UTF8.putStrLn $ show $
                             readWith parser defaultParserState str
@@ -878,7 +898,7 @@ instance HasMeta ParserState where
 
 class HasReaderOptions st where
   extractReaderOptions :: st -> ReaderOptions
-  getOption            :: (ReaderOptions -> b) -> Parser s st b
+  getOption            :: (Stream s m t) => (ReaderOptions -> b) -> ParserT s st m b
   -- default
   getOption  f         = (f . extractReaderOptions) `fmap` getState
 
@@ -946,19 +966,19 @@ defaultParserState =
                   stateWarnings        = []}
 
 -- | Succeed only if the extension is enabled.
-guardEnabled :: HasReaderOptions st => Extension -> Parser s st ()
+guardEnabled :: (Stream s m a,  HasReaderOptions st) => Extension -> ParserT s st m ()
 guardEnabled ext = getOption readerExtensions >>= guard . Set.member ext
 
 -- | Succeed only if the extension is disabled.
-guardDisabled :: HasReaderOptions st => Extension -> Parser s st ()
+guardDisabled :: (Stream s m a, HasReaderOptions st) => Extension -> ParserT s st m ()
 guardDisabled ext = getOption readerExtensions >>= guard . not . Set.member ext
 
 -- | Update the position on which the last string ended.
-updateLastStrPos :: HasLastStrPosition st => Parser s st ()
+updateLastStrPos :: (Stream s m a, HasLastStrPosition st) => ParserT s st m ()
 updateLastStrPos = getPosition >>= updateState . setLastStrPos
 
 -- | Whether we are right after the end of a string.
-notAfterString :: HasLastStrPosition st => Parser s st Bool
+notAfterString :: (Stream s m a, HasLastStrPosition st) => ParserT s st m Bool
 notAfterString = do
   pos <- getPosition
   st  <- getState
@@ -998,8 +1018,8 @@ type SubstTable = M.Map Key Inlines
 --  and the auto_identifers extension is set, generate a new
 --  unique identifier, and update the list of identifiers
 --  in state.
-registerHeader :: (HasReaderOptions st, HasHeaderMap st, HasIdentifierList st)
+registerHeader :: (Stream s m a, HasReaderOptions st, HasHeaderMap st, HasIdentifierList st)
-               => Attr -> Inlines -> Parser s st Attr
+               => Attr -> Inlines -> ParserT s st m Attr
 registerHeader (ident,classes,kvs) header' = do
   ids <- extractIdentifierList `fmap` getState
   exts <- getOption readerExtensions
@@ -1020,25 +1040,28 @@ registerHeader (ident,classes,kvs) header' = do
         return (ident,classes,kvs)
 
 -- | Fail unless we're in "smart typography" mode.
-failUnlessSmart :: HasReaderOptions st => Parser s st ()
+failUnlessSmart :: (Stream s m a, HasReaderOptions st) => ParserT s st m ()
 failUnlessSmart = getOption readerSmart >>= guard
 
-smartPunctuation :: Parser [Char] ParserState Inlines
+smartPunctuation :: Stream s m Char 
-                 -> Parser [Char] ParserState Inlines
+                 => ParserT s ParserState m Inlines
+                 -> ParserT s ParserState m Inlines
 smartPunctuation inlineParser = do
   failUnlessSmart
   choice [ quoted inlineParser, apostrophe, dash, ellipses ]
 
-apostrophe :: Parser [Char] ParserState Inlines
+apostrophe :: Stream s m Char => ParserT s st m Inlines
 apostrophe = (char '\'' <|> char '\8217') >> return (B.str "\x2019")
 
-quoted :: Parser [Char] ParserState Inlines
+quoted :: Stream s m Char 
-       -> Parser [Char] ParserState Inlines
+       => ParserT s  ParserState m Inlines
+       -> ParserT s  ParserState m Inlines
 quoted inlineParser = doubleQuoted inlineParser <|> singleQuoted inlineParser
 
-withQuoteContext :: QuoteContext
+withQuoteContext :: Stream s m t 
-                 -> Parser [tok] ParserState a
+                 => QuoteContext
-                 -> Parser [tok] ParserState a
+                 -> ParserT s ParserState m a
+                 -> ParserT s ParserState m a
 withQuoteContext context parser = do
   oldState <- getState
   let oldQuoteContext = stateQuoteContext oldState
@@ -1048,99 +1071,112 @@ withQuoteContext context parser = do
   setState newState { stateQuoteContext = oldQuoteContext }
   return result
 
-singleQuoted :: Parser [Char] ParserState Inlines
+singleQuoted :: Stream s m Char 
-             -> Parser [Char] ParserState Inlines
+             => ParserT s ParserState m Inlines
+             -> ParserT s ParserState m Inlines
 singleQuoted inlineParser = try $ do
   singleQuoteStart
   withQuoteContext InSingleQuote $ many1Till inlineParser singleQuoteEnd >>=
     return . B.singleQuoted . mconcat
 
-doubleQuoted :: Parser [Char] ParserState Inlines
+doubleQuoted :: Stream s m Char 
-             -> Parser [Char] ParserState Inlines
+             => ParserT s ParserState m Inlines
+             -> ParserT s ParserState m Inlines
 doubleQuoted inlineParser = try $ do
   doubleQuoteStart
   withQuoteContext InDoubleQuote $ manyTill inlineParser doubleQuoteEnd >>=
     return . B.doubleQuoted . mconcat
 
-failIfInQuoteContext :: QuoteContext -> Parser [tok] ParserState ()
+failIfInQuoteContext :: Stream s m t 
+                     => QuoteContext 
+                     -> ParserT s ParserState m ()
 failIfInQuoteContext context = do
   st <- getState
   if stateQuoteContext st == context
      then fail "already inside quotes"
      else return ()
 
-charOrRef :: [Char] -> Parser [Char] st Char
+charOrRef :: Stream s m Char => String -> ParserT s st m Char
 charOrRef cs =
   oneOf cs <|> try (do c <- characterReference
                        guard (c `elem` cs)
                        return c)
 
-singleQuoteStart :: Parser [Char] ParserState ()
+singleQuoteStart :: Stream s m Char 
+                 => ParserT s ParserState m ()
 singleQuoteStart = do
   failIfInQuoteContext InSingleQuote
   -- single quote start can't be right after str
   guard =<< notAfterString
   () <$ charOrRef "'\8216\145"
 
-singleQuoteEnd :: Parser [Char] st ()
+singleQuoteEnd :: Stream s m Char 
+               => ParserT s st m ()
 singleQuoteEnd = try $ do
   charOrRef "'\8217\146"
   notFollowedBy alphaNum
 
-doubleQuoteStart :: Parser [Char] ParserState ()
+doubleQuoteStart :: Stream s m Char 
+                 => ParserT s ParserState m ()
 doubleQuoteStart = do
   failIfInQuoteContext InDoubleQuote
   try $ do charOrRef "\"\8220\147"
            notFollowedBy . satisfy $ flip elem [' ', '\t', '\n']
 
-doubleQuoteEnd :: Parser [Char] st ()
+doubleQuoteEnd :: Stream s m Char 
-doubleQuoteEnd = do
+               => ParserT s st m ()
-  charOrRef "\"\8221\148"
+doubleQuoteEnd = void (charOrRef "\"\8221\148")
-  return ()
 
-ellipses :: Parser [Char] st Inlines
+ellipses :: Stream s m Char 
+         => ParserT s st m Inlines
 ellipses = do
   try (charOrRef "\8230\133") <|> try (string "..." >> return '…')
   return (B.str "\8230")
 
-dash :: Parser [Char] ParserState Inlines
+dash :: Stream s m Char => ParserT s ParserState m Inlines
 dash = do
   oldDashes <- getOption readerOldDashes
   if oldDashes
      then emDashOld <|> enDashOld
-     else B.str `fmap` (hyphenDash <|> emDash <|> enDash)
+     else B.str <$> (hyphenDash <|> emDash <|> enDash)
 
 -- Two hyphens = en-dash, three = em-dash
-hyphenDash :: Parser [Char] st String
+hyphenDash :: Stream s m Char 
+           => ParserT s st m String
 hyphenDash = do
   try $ string "--"
   option "\8211" (char '-' >> return "\8212")
 
-emDash :: Parser [Char] st String
+emDash :: Stream s m Char 
+       => ParserT s st m String
 emDash = do
   try (charOrRef "\8212\151")
   return "\8212"
 
-enDash :: Parser [Char] st String
+enDash :: Stream s m Char 
+       => ParserT s st m String
 enDash = do
   try (charOrRef "\8212\151")
   return "\8211"
 
-enDashOld :: Parser [Char] st Inlines
+enDashOld :: Stream s m Char 
+          => ParserT s st m Inlines
 enDashOld = do
   try (charOrRef "\8211\150") <|>
     try (char '-' >> lookAhead (satisfy isDigit) >> return '–')
   return (B.str "\8211")
 
-emDashOld :: Parser [Char] st Inlines
+emDashOld :: Stream s m Char 
+          => ParserT s st m Inlines
 emDashOld = do
   try (charOrRef "\8212\151") <|> (try $ string "--" >> optional (char '-') >> return '-')
   return (B.str "\8212")
 
 -- This is used to prevent exponential blowups for things like:
 -- a**a*a**a*a**a*a**a*a**a*a**a*a**
-nested :: Parser s ParserState a
+nested :: Stream s m a 
-       -> Parser s ParserState a
+       => ParserT s ParserState m a
+       -> ParserT s ParserState m a
 nested p = do
   nestlevel <- stateMaxNestingLevel `fmap` getState
   guard $ nestlevel > 0
@@ -1149,7 +1185,8 @@ nested p = do
   updateState $ \st -> st{ stateMaxNestingLevel = nestlevel }
   return res
 
-citeKey :: HasLastStrPosition st => Parser [Char] st (Bool, String)
+citeKey :: (Stream s m Char, HasLastStrPosition st)
+        => ParserT s st m (Bool, String)
 citeKey = try $ do
   guard =<< notAfterString
   suppress_author <- option False (char '-' *> return True)
@@ -1166,7 +1203,8 @@ citeKey = try $ do
 --
 
 -- | Parse a \newcommand or \renewcommand macro definition.
-macro :: (HasMacros st, HasReaderOptions st) => Parser [Char] st Blocks
+macro :: (Stream [Char] m Char, HasMacros st, HasReaderOptions st) 
+      => ParserT [Char] st m Blocks
 macro = do
   apply <- getOption readerApplyMacros
   inp <- getInput
@@ -1181,7 +1219,9 @@ macro = do
                            else return $ rawBlock "latex" def'
 
 -- | Apply current macros to string.
-applyMacros' :: String -> Parser [Char] ParserState String
+applyMacros' :: Stream [Char] m Char 
+             => String 
+             -> ParserT [Char] ParserState m String
 applyMacros' target = do
   apply <- getOption readerApplyMacros
   if apply