module Text.Parse
  ( -- * The Parse class is a replacement for the standard Read class. 
    -- $parser
    TextParser	-- synonym for Parser Char, i.e. string input, no state
  , Parse(..)	-- instances: (), (a,b), (a,b,c), Maybe a, Either a, [a],
		--            Int, Integer, Float, Double, Char, Bool
  , parseByRead	-- :: Read a => String -> TextParser a
  , readByParse -- :: TextParser a -> ReadS a
  , readsPrecByParsePrec -- :: (Int->TextParser a) -> Int -> ReadS a
    -- ** Combinators specific to string input, lexed haskell-style
  , word	-- :: TextParser String
  , isWord	-- :: String -> TextParser ()
  , literal	-- :: String -> TextParser ()
  , optionalParens	-- :: TextParser a -> TextParser a
  , parens	-- :: Bool -> TextParser a -> TextParser a
  , field	-- :: Parse a => String -> TextParser a
  , constructors-- :: [(String,TextParser a)] -> TextParser a
  , enumeration -- :: Show a => String -> [a] -> TextParser a
    -- ** Parsers for literal numerics and characters
  , parseSigned
  , parseInt
  , parseDec
  , parseOct
  , parseHex
  , parseFloat
  , parseLitChar
  , parseLitChar'
    -- ** Re-export all the more general combinators from Poly too
  , module Text.ParserCombinators.Poly
    -- ** Strings as whole entities
  , allAsString
  ) where

import Data.Char as Char (isSpace,toLower,isUpper,isDigit,isOctDigit
                         ,isHexDigit,digitToInt,isAlpha,isAlphaNum,ord,chr)
import Data.List (intersperse)
import Data.Ratio
import Text.ParserCombinators.Poly

------------------------------------------------------------------------
-- $parser
-- The Parse class is a replacement for the standard Read class.  It is a
-- specialisation of the (poly) Parser monad for String input.
-- There are instances defined for all Prelude types.
-- For user-defined types, you can write your own instance, or use
-- DrIFT to generate them automatically, e.g. {-! derive : Parse !-}

-- | A synonym for Parser Char, i.e. string input (no state)
type TextParser a = Parser Char a

-- | The class @Parse@ is a replacement for @Read@, operating over String input.
--   Essentially, it permits better error messages for why something failed to
--   parse.  It is rather important that @parse@ can read back exactly what
--   is generated by the corresponding instance of @show@.  To apply a parser
--   to some text, use @runParser@.
class Parse a where
    -- | A straightforward parser for an item.  (A minimal definition of
    --   a class instance requires either |parse| or |parsePrec|.)
    parse     :: TextParser a
    parse       = forall a. Parse a => Int -> TextParser a
parsePrec Int
0
    -- | A straightforward parser for an item, given the precedence of
    --   any surrounding expression.  (Precedence determines whether
    --   parentheses are mandatory or optional.)
    parsePrec :: Int -> TextParser a
    parsePrec Int
_ = forall a. TextParser a -> TextParser a
optionalParens forall a. Parse a => TextParser a
parse
    -- | Parsing a list of items by default accepts the [] and comma syntax,
    --   except when the list is really a character string using \"\".
    parseList :: TextParser [a]	-- only to distinguish [] and ""
    parseList  = do { String -> TextParser String
isWord String
"[]"; forall (m :: * -> *) a. Monad m => a -> m a
return [] }
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                 do { String -> TextParser String
isWord String
"["; String -> TextParser String
isWord String
"]"; forall (m :: * -> *) a. Monad m => a -> m a
return [] }
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                 forall (p :: * -> *) bra sep ket a.
PolyParse p =>
p bra -> p sep -> p ket -> p a -> p [a]
bracketSep (String -> TextParser String
isWord String
"[") (String -> TextParser String
isWord String
",") (String -> TextParser String
isWord String
"]")
                            (forall a. TextParser a -> TextParser a
optionalParens forall a. Parse a => TextParser a
parse)
                   forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"Expected a list, but\n"forall a. [a] -> [a] -> [a]
++)

-- | If there already exists a Read instance for a type, then we can make
--   a Parser for it, but with only poor error-reporting.  The string argument
--   is the expected type or value (for error-reporting only).
parseByRead :: Read a => String -> TextParser a
parseByRead :: forall a. Read a => String -> TextParser a
parseByRead String
name =
    forall t a. ([t] -> Result [t] a) -> Parser t a
P (\String
s-> case forall a. Read a => ReadS a
reads String
s of
                []       -> forall z a. z -> String -> Result z a
Failure String
s (String
"no parse, expected a "forall a. [a] -> [a] -> [a]
++String
name)
                [(a
a,String
s')] -> forall z a. z -> a -> Result z a
Success String
s' a
a
                [(a, String)]
_        -> forall z a. z -> String -> Result z a
Failure String
s (String
"ambiguous parse, expected a "forall a. [a] -> [a] -> [a]
++String
name)
      )

-- | If you have a TextParser for a type, you can easily make it into
--   a Read instance, by throwing away any error messages.
readByParse :: TextParser a -> ReadS a
readByParse :: forall a. TextParser a -> ReadS a
readByParse TextParser a
p = \String
inp->
    case forall t a. Parser t a -> [t] -> (Either String a, [t])
runParser TextParser a
p String
inp of
        (Left String
err,  String
rest) -> []
        (Right a
val, String
rest) -> [(a
val,String
rest)]

-- | If you have a TextParser for a type, you can easily make it into
--   a Read instance, by throwing away any error messages.
readsPrecByParsePrec :: (Int -> TextParser a) -> Int -> ReadS a
readsPrecByParsePrec :: forall a. (Int -> TextParser a) -> Int -> ReadS a
readsPrecByParsePrec Int -> TextParser a
p = \Int
prec String
inp->
    case forall t a. Parser t a -> [t] -> (Either String a, [t])
runParser (Int -> TextParser a
p Int
prec) String
inp of
        (Left String
err,  String
rest) -> []
        (Right a
val, String
rest) -> [(a
val,String
rest)]

-- | One lexical chunk.  This is Haskell'98-style lexing - the result
--   should match Prelude.lex apart from better error-reporting.
word :: TextParser String
word :: TextParser String
word = forall t a. ([t] -> Result [t] a) -> Parser t a
P String -> Result String String
p
  where
    p :: String -> Result String String
p String
""       = forall z a. z -> String -> Result z a
Failure String
"" String
"end of input"
    p (Char
c:String
s)    | Char -> Bool
isSpace Char
c = String -> Result String String
p (forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
s)
    p (Char
'\'':String
s) = let (P String -> Result String Char
lit) = Parser Char Char
parseLitChar' in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> String
show (String -> Result String Char
lit (Char
'\''forall a. a -> [a] -> [a]
:String
s))
    p (Char
'"':String
s)  = String -> String -> Result String String
lexString String
"\"" String
s
             where lexString :: String -> String -> Result String String
lexString String
acc (Char
'"':String
s)      = forall z a. z -> a -> Result z a
Success String
s (forall a. [a] -> [a]
reverse (Char
'"'forall a. a -> [a] -> [a]
:String
acc))
                   lexString String
acc []           = forall z a. z -> String -> Result z a
Failure [] (String
"end of input in "
                                                           forall a. [a] -> [a] -> [a]
++String
"string literal "
                                                           forall a. [a] -> [a] -> [a]
++String
acc)
                   lexString String
acc String
s = let (P String -> Result String Char
lit) = Parser Char Char
parseLitChar
                                     in case String -> Result String Char
lit String
s of
                                          Failure String
a String
b -> forall z a. z -> String -> Result z a
Failure String
a String
b
                                          Success String
t Char
c -> String -> String -> Result String String
lexString (Char
cforall a. a -> [a] -> [a]
:String
acc) String
t
    p (Char
'0':Char
'x':String
s) = forall z a. z -> a -> Result z a
Success String
t (Char
'0'forall a. a -> [a] -> [a]
:Char
'x'forall a. a -> [a] -> [a]
:String
ds) where (String
ds,String
t) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isHexDigit String
s
    p (Char
'0':Char
'X':String
s) = forall z a. z -> a -> Result z a
Success String
t (Char
'0'forall a. a -> [a] -> [a]
:Char
'X'forall a. a -> [a] -> [a]
:String
ds) where (String
ds,String
t) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isHexDigit String
s
    p (Char
'0':Char
'o':String
s) = forall z a. z -> a -> Result z a
Success String
t (Char
'0'forall a. a -> [a] -> [a]
:Char
'o'forall a. a -> [a] -> [a]
:String
ds) where (String
ds,String
t) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isOctDigit String
s
    p (Char
'0':Char
'O':String
s) = forall z a. z -> a -> Result z a
Success String
t (Char
'0'forall a. a -> [a] -> [a]
:Char
'O'forall a. a -> [a] -> [a]
:String
ds) where (String
ds,String
t) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isOctDigit String
s
    p (Char
c:String
s) | Char -> Bool
isSingle Char
c = forall z a. z -> a -> Result z a
Success String
s [Char
c]
            | Char -> Bool
isSym    Char
c = let (String
sym,String
t) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSym String
s in forall z a. z -> a -> Result z a
Success String
t (Char
cforall a. a -> [a] -> [a]
:String
sym)
            | Char -> Bool
isIdInit Char
c = let (String
nam,String
t) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isIdChar String
s in forall z a. z -> a -> Result z a
Success String
t (Char
cforall a. a -> [a] -> [a]
:String
nam)
            | Char -> Bool
isDigit  Char
c = let (String
ds,String
t)  = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
s in
                           String -> String -> Result String String
lexFracExp (Char
cforall a. a -> [a] -> [a]
:String
ds) String
t
            | Bool
otherwise  = forall z a. z -> String -> Result z a
Failure (Char
cforall a. a -> [a] -> [a]
:String
s) (String
"Bad character: "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Char
c)
             where isSingle :: Char -> Bool
isSingle Char
c  =  Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
",;()[]{}`"
                   isSym :: Char -> Bool
isSym    Char
c  =  Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"!@#$%&*+./<=>?\\^|:-~"
                   isIdInit :: Char -> Bool
isIdInit Char
c  =  Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
                   isIdChar :: Char -> Bool
isIdChar Char
c  =  Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"_'"
                   lexFracExp :: String -> String -> Result String String
lexFracExp String
acc (Char
'.':Char
d:String
s) | Char -> Bool
isDigit Char
d   =
                                      String -> String -> Result String String
lexExp (String
accforall a. [a] -> [a] -> [a]
++Char
'.'forall a. a -> [a] -> [a]
:Char
dforall a. a -> [a] -> [a]
:String
ds) String
t
                                              where (String
ds,String
t) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
s
                   lexFracExp String
acc String
s = String -> String -> Result String String
lexExp String
acc String
s
                   lexExp :: String -> String -> Result String String
lexExp     String
acc (Char
e:String
s) | Char
eforall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`String
"eE" =
                                      case String
s of
                                        (Char
'+':Char
d:String
t) | Char -> Bool
isDigit Char
d ->
                                                    let (String
ds,String
u)=forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
t in
                                                    forall z a. z -> a -> Result z a
Success String
u (String
accforall a. [a] -> [a] -> [a]
++String
"e+"forall a. [a] -> [a] -> [a]
++Char
dforall a. a -> [a] -> [a]
:String
ds)
                                        (Char
'-':Char
d:String
t) | Char -> Bool
isDigit Char
d ->
                                                    let (String
ds,String
u)=forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
t in
                                                    forall z a. z -> a -> Result z a
Success String
u (String
accforall a. [a] -> [a] -> [a]
++String
"e-"forall a. [a] -> [a] -> [a]
++Char
dforall a. a -> [a] -> [a]
:String
ds)
                                        (Char
d:String
t) |Char -> Bool
isDigit Char
d ->
                                                    let (String
ds,String
u)=forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
t in
                                                    forall z a. z -> a -> Result z a
Success String
u (String
accforall a. [a] -> [a] -> [a]
++String
"e"forall a. [a] -> [a] -> [a]
++Char
dforall a. a -> [a] -> [a]
:String
ds)
                                        String
_ -> forall z a. z -> String -> Result z a
Failure String
s (String
"missing +/-/digit "
                                                       forall a. [a] -> [a] -> [a]
++String
"after e in float "
                                                       forall a. [a] -> [a] -> [a]
++String
"literal: "
                                                       forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show (String
accforall a. [a] -> [a] -> [a]
++String
"e"forall a. [a] -> [a] -> [a]
++String
"..."))
                   lexExp     String
acc String
s     = forall z a. z -> a -> Result z a
Success String
s String
acc



-- | One lexical chunk (Haskell'98-style lexing - the result should match
--   Prelude.lex apart from error-reporting).
oldword :: TextParser String
oldword :: TextParser String
oldword = forall t a. ([t] -> Result [t] a) -> Parser t a
P (\String
s-> case ReadS String
lex String
s of
                   []         -> forall z a. z -> String -> Result z a
Failure String
s  (String
"no input? (impossible)")
                   [(String
"",String
"")]  -> forall z a. z -> String -> Result z a
Failure String
"" (String
"no input?")
                   [(String
"",String
s')]  -> forall z a. z -> String -> Result z a
Failure String
s  (String
"lexing failed?")
                   ((String
x,String
s'):[(String, String)]
_) -> forall z a. z -> a -> Result z a
Success String
s' String
x
         )

-- | Ensure that the next input word is the given string.  (Note the input
--   is lexed as haskell, so wordbreaks at spaces, symbols, etc.)
isWord :: String -> TextParser String
isWord :: String -> TextParser String
isWord String
w = do { String
w' <- TextParser String
word
              ; if String
w'forall a. Eq a => a -> a -> Bool
==String
w then forall (m :: * -> *) a. Monad m => a -> m a
return String
w else forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expected "forall a. [a] -> [a] -> [a]
++String
wforall a. [a] -> [a] -> [a]
++String
" got "forall a. [a] -> [a] -> [a]
++String
w')
              }

-- | Ensure that the next input word is the given string.  (No
--   lexing, so mixed spaces, symbols, are accepted.)
literal :: String -> TextParser String
literal :: String -> TextParser String
literal String
w = do { String
w' <- forall {a}. Eq a => [a] -> Parser a String
walk String
w
               ; if String
w'forall a. Eq a => a -> a -> Bool
==String
w then forall (m :: * -> *) a. Monad m => a -> m a
return String
w else forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expected "forall a. [a] -> [a] -> [a]
++String
wforall a. [a] -> [a] -> [a]
++String
" got "forall a. [a] -> [a] -> [a]
++String
w')
               }
  where walk :: [a] -> Parser a String
walk []     = forall (m :: * -> *) a. Monad m => a -> m a
return String
w
        walk (a
c:[a]
cs) = do { a
x <- forall t. Parser t t
next
                         ; if a
xforall a. Eq a => a -> a -> Bool
==a
c then [a] -> Parser a String
walk [a]
cs
                                   else forall (m :: * -> *) a. Monad m => a -> m a
return []
                         }

-- | Allow nested parens around an item.
optionalParens :: TextParser a -> TextParser a
optionalParens :: forall a. TextParser a -> TextParser a
optionalParens TextParser a
p = forall a. Bool -> TextParser a -> TextParser a
parens Bool
False TextParser a
p

-- | Allow nested parens around an item (one set required when Bool is True).
parens :: Bool -> TextParser a -> TextParser a
parens :: forall a. Bool -> TextParser a -> TextParser a
parens Bool
True  TextParser a
p = forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (String -> TextParser String
isWord String
"(") (String -> TextParser String
isWord String
")") (forall a. Bool -> TextParser a -> TextParser a
parens Bool
False TextParser a
p)
parens Bool
False TextParser a
p = forall a. Bool -> TextParser a -> TextParser a
parens Bool
True TextParser a
p forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` TextParser a
p

-- | Deal with named field syntax.  The string argument is the field name,
--   and the parser returns the value of the field.
field :: Parse a => String -> TextParser a
field :: forall a. Parse a => String -> TextParser a
field String
name = do { String -> TextParser String
isWord String
name; forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ do { String -> TextParser String
isWord String
"="; forall a. Parse a => TextParser a
parse } }

-- | Parse one of a bunch of alternative constructors.  In the list argument,
--   the first element of the pair is the constructor name, and
--   the second is the parser for the rest of the value.  The first matching
--   parse is returned.
constructors :: [(String,TextParser a)] -> TextParser a
constructors :: forall a. [(String, TextParser a)] -> TextParser a
constructors [(String, TextParser a)]
cs = forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' (forall a b. (a -> b) -> [a] -> [b]
map forall {b}. (String, Parser Char b) -> (String, Parser Char b)
cons [(String, TextParser a)]
cs)
    where cons :: (String, Parser Char b) -> (String, Parser Char b)
cons (String
name,Parser Char b
p) =
               ( String
name
               , do { String -> TextParser String
isWord String
name
                    ; Parser Char b
p forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` ((String
"got constructor, but within "
                                        forall a. [a] -> [a] -> [a]
++String
nameforall a. [a] -> [a] -> [a]
++String
",\n")forall a. [a] -> [a] -> [a]
++)
                    }
               )

-- | Parse one of the given nullary constructors (an enumeration).
--   The string argument is the name of the type, and the list argument
--   should contain all of the possible enumeration values.
enumeration :: (Show a) => String -> [a] -> TextParser a
enumeration :: forall a. Show a => String -> [a] -> TextParser a
enumeration String
typ [a]
cs = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf (forall a b. (a -> b) -> [a] -> [b]
map (\a
c-> do { String -> TextParser String
isWord (forall a. Show a => a -> String
show a
c); forall (m :: * -> *) a. Monad m => a -> m a
return a
c }) [a]
cs)
                         forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr`
                     (forall a. [a] -> [a] -> [a]
++(String
"\n  expected "forall a. [a] -> [a] -> [a]
++String
typforall a. [a] -> [a] -> [a]
++String
" value ("forall a. [a] -> [a] -> [a]
++String
eforall a. [a] -> [a] -> [a]
++String
")"))
    where e :: String
e = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. a -> [a] -> [a]
intersperse String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show (forall a. [a] -> [a]
init [a]
cs)))
              forall a. [a] -> [a] -> [a]
++ String
", or " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. [a] -> a
last [a]
cs)

------------------------------------------------------------------------
-- Instances for all the Standard Prelude types.

-- Numeric types
parseSigned :: Real a => TextParser a -> TextParser a
parseSigned :: forall a. Real a => TextParser a -> TextParser a
parseSigned TextParser a
p = do Char
'-' <- forall t. Parser t t
next; forall (p :: * -> *) a. Commitment p => p a -> p a
commit (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
negate TextParser a
p)
                forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                do TextParser a
p

parseInt :: (Integral a) => String ->
                            a -> (Char -> Bool) -> (Char -> Int) ->
                            TextParser a
parseInt :: forall a.
Integral a =>
String -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
parseInt String
base a
radix Char -> Bool
isDigit Char -> Int
digitToInt =
                 do String
cs <- forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 (forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isDigit)
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\a
n a
d-> a
nforall a. Num a => a -> a -> a
*a
radixforall a. Num a => a -> a -> a
+a
d)
                                   (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Int
digitToInt) String
cs))
                 forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (forall a. [a] -> [a] -> [a]
++(String
"\nexpected one or more "forall a. [a] -> [a] -> [a]
++String
baseforall a. [a] -> [a] -> [a]
++String
" digits"))
parseDec, parseOct, parseHex :: (Integral a) => TextParser a
parseDec :: forall a. Integral a => TextParser a
parseDec = forall a.
Integral a =>
String -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
parseInt String
"decimal" a
10 Char -> Bool
Char.isDigit    Char -> Int
Char.digitToInt
parseOct :: forall a. Integral a => TextParser a
parseOct = forall a.
Integral a =>
String -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
parseInt String
"octal"    a
8 Char -> Bool
Char.isOctDigit Char -> Int
Char.digitToInt
parseHex :: forall a. Integral a => TextParser a
parseHex = forall a.
Integral a =>
String -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
parseInt String
"hex"     a
16 Char -> Bool
Char.isHexDigit Char -> Int
Char.digitToInt

parseFloat :: (RealFrac a) => TextParser a
parseFloat :: forall a. RealFrac a => TextParser a
parseFloat = do String
ds   <- forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 (forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isDigit)
                String
frac <- (do Char
'.' <- forall t. Parser t t
next
                            forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isDigit)
                              forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (forall a. [a] -> [a] -> [a]
++String
"expected digit after .")
                         forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` forall (m :: * -> *) a. Monad m => a -> m a
return [] )
                Int
exp  <- Parser Char Int
exponent forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
                ( forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* (Rational
10forall a b. (Fractional a, Integral b) => a -> b -> a
^^(Int
exp forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
frac)))
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> Ratio a
%Integer
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (\ (Right Integer
x)->Integer
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Parser t a -> [t] -> (Either String a, [t])
runParser forall a. Integral a => TextParser a
parseDec ) (String
dsforall a. [a] -> [a] -> [a]
++String
frac)
             forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
             do String
w <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall t. (t -> Bool) -> Parser t t
satisfy (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace))
                case forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
w of
                  String
"nan"      -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
0forall a. Fractional a => a -> a -> a
/a
0)
                  String
"infinity" -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
1forall a. Fractional a => a -> a -> a
/a
0)
                  String
_          -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected a floating point number"
  where exponent :: Parser Char Int
exponent = do Char
'e' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower forall t. Parser t t
next
                      forall (p :: * -> *) a. Commitment p => p a -> p a
commit (do Char
'+' <- forall t. Parser t t
next; forall a. Integral a => TextParser a
parseDec
                              forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                              forall a. Real a => TextParser a -> TextParser a
parseSigned forall a. Integral a => TextParser a
parseDec )

-- | Parse a Haskell character literal, including the surrounding single quotes.
parseLitChar' :: TextParser Char
parseLitChar' :: Parser Char Char
parseLitChar' = do Char
'\'' <- forall t. Parser t t
next forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (forall a. [a] -> [a] -> [a]
++String
"expected a literal char")
                   Char
char <- Parser Char Char
parseLitChar
                   Char
'\'' <- forall t. Parser t t
next forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (forall a. [a] -> [a] -> [a]
++String
"literal char has no final '")
                   forall (m :: * -> *) a. Monad m => a -> m a
return Char
char

-- | Parse a Haskell character literal, excluding the surrounding single quotes.
parseLitChar :: TextParser Char
parseLitChar :: Parser Char Char
parseLitChar = do Char
c <- forall t. Parser t t
next
                  Char
char <- case Char
c of
                            Char
'\\' -> forall t. Parser t t
next forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Parser Char Char
escape
                            Char
'\'' -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected a literal char, got ''"
                            Char
_    -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
                  forall (m :: * -> *) a. Monad m => a -> m a
return Char
char

  where
    escape :: Char -> Parser Char Char
escape Char
'a'  = forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\a'
    escape Char
'b'  = forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\b'
    escape Char
'f'  = forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f'
    escape Char
'n'  = forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'
    escape Char
'r'  = forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r'
    escape Char
't'  = forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t'
    escape Char
'v'  = forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\v'
    escape Char
'\\' = forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\\'
    escape Char
'"'  = forall (m :: * -> *) a. Monad m => a -> m a
return Char
'"'
    escape Char
'\'' = forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\''
    escape Char
'^'  = do Char
ctrl <- forall t. Parser t t
next
                     if Char
ctrl forall a. Ord a => a -> a -> Bool
>= Char
'@' Bool -> Bool -> Bool
&& Char
ctrl forall a. Ord a => a -> a -> Bool
<= Char
'_'
                       then forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
chr (Char -> Int
ord Char
ctrl forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'@'))
                       else forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"literal char ctrl-escape malformed: \\^"
                                   forall a. [a] -> [a] -> [a]
++[Char
ctrl])
    escape Char
d | Char -> Bool
isDigit Char
d
                = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
chr forall a b. (a -> b) -> a -> b
$  (forall t. [t] -> Parser t ()
reparse [Char
d] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Integral a => TextParser a
parseDec)
    escape Char
'o'  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
chr forall a b. (a -> b) -> a -> b
$  forall a. Integral a => TextParser a
parseOct
    escape Char
'x'  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
chr forall a b. (a -> b) -> a -> b
$  forall a. Integral a => TextParser a
parseHex
    escape Char
c | Char -> Bool
isUpper Char
c
                = Char -> Parser Char Char
mnemonic Char
c
    escape Char
c    = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unrecognised escape sequence in literal char: \\"forall a. [a] -> [a] -> [a]
++[Char
c])

    mnemonic :: Char -> Parser Char Char
mnemonic Char
'A' = do Char
'C' <- forall t. Parser t t
next; Char
'K' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ACK'
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"'\\ACK'"
    mnemonic Char
'B' = do Char
'E' <- forall t. Parser t t
next; Char
'L' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\BEL'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'S' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\BS'
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"'\\BEL' or '\\BS'"
    mnemonic Char
'C' = do Char
'R' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\CR'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'A' <- forall t. Parser t t
next; Char
'N' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\CAN'
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"'\\CR' or '\\CAN'"
    mnemonic Char
'D' = do Char
'E' <- forall t. Parser t t
next; Char
'L' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DEL'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'L' <- forall t. Parser t t
next; Char
'E' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DLE'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'C' <- forall t. Parser t t
next; ( do Char
'1' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC1'
                                     forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                                     do Char
'2' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC2'
                                     forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                                     do Char
'3' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC3'
                                     forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                                     do Char
'4' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC4' )
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"'\\DEL' or '\\DLE' or '\\DC[1..4]'"
    mnemonic Char
'E' = do Char
'T' <- forall t. Parser t t
next; Char
'X' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ETX'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'O' <- forall t. Parser t t
next; Char
'T' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\EOT'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'N' <- forall t. Parser t t
next; Char
'Q' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ENQ'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'T' <- forall t. Parser t t
next; Char
'B' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ETB'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'M' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\EM'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'S' <- forall t. Parser t t
next; Char
'C' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ESC'
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"one of '\\ETX' '\\EOT' '\\ENQ' '\\ETB' '\\EM' or '\\ESC'"
    mnemonic Char
'F' = do Char
'F' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\FF'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'S' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\FS'
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"'\\FF' or '\\FS'"
    mnemonic Char
'G' = do Char
'S' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\GS'
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"'\\GS'"
    mnemonic Char
'H' = do Char
'T' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\HT'
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"'\\HT'"
    mnemonic Char
'L' = do Char
'F' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\LF'
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"'\\LF'"
    mnemonic Char
'N' = do Char
'U' <- forall t. Parser t t
next; Char
'L' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\NUL'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'A' <- forall t. Parser t t
next; Char
'K' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\NAK'
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"'\\NUL' or '\\NAK'"
    mnemonic Char
'R' = do Char
'S' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\RS'
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"'\\RS'"
    mnemonic Char
'S' = do Char
'O' <- forall t. Parser t t
next; Char
'H' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SOH'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'O' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SO'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'T' <- forall t. Parser t t
next; Char
'X' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\STX'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'I' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SI'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'Y' <- forall t. Parser t t
next; Char
'N' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SYN'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'U' <- forall t. Parser t t
next; Char
'B' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SUB'
                   forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   do Char
'P' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SP'
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"'\\SOH' '\\SO' '\\STX' '\\SI' '\\SYN' '\\SUB' or '\\SP'"
    mnemonic Char
'U' = do Char
'S' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\US'
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"'\\US'"
    mnemonic Char
'V' = do Char
'T' <- forall t. Parser t t
next; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\VT'
                   forall {t} {a}. Parser t a -> String -> Parser t a
`wrap` String
"'\\VT'"
    wrap :: Parser t a -> String -> Parser t a
wrap Parser t a
p String
s = Parser t a
p forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expected literal char "forall a. [a] -> [a] -> [a]
++String
s)

-- Basic types
instance Parse Int where
 -- parse = parseByRead "Int"	-- convert from Integer, deals with minInt
    parse :: Parser Char Int
parse = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$
              do forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isSpace); forall a. Real a => TextParser a -> TextParser a
parseSigned forall a. Integral a => TextParser a
parseDec
instance Parse Integer where
 -- parse = parseByRead "Integer"
    parse :: Parser Char Integer
parse = do forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isSpace); forall a. Real a => TextParser a -> TextParser a
parseSigned forall a. Integral a => TextParser a
parseDec
instance Parse Float where
 -- parse = parseByRead "Float"
    parse :: TextParser Float
parse = do forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isSpace); forall a. Real a => TextParser a -> TextParser a
parseSigned forall a. RealFrac a => TextParser a
parseFloat
instance Parse Double where
 -- parse = parseByRead "Double"
    parse :: TextParser Double
parse = do forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isSpace); forall a. Real a => TextParser a -> TextParser a
parseSigned forall a. RealFrac a => TextParser a
parseFloat
instance Parse Char where
--  parse = parseByRead "Char"
    parse :: Parser Char Char
parse = do forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isSpace); Parser Char Char
parseLitChar'
 -- parse = do { w <- word; if head w == '\'' then readLitChar (tail w)
 --                                           else fail "expected a char" }
 -- parseList = bracket (isWord "\"") (satisfy (=='"'))
 --                     (many (satisfy (/='"')))
	-- not totally correct for strings...
    parseList :: TextParser String
parseList = do { String
w <- TextParser String
word; if forall a. [a] -> a
head String
w forall a. Eq a => a -> a -> Bool
== Char
'"' then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> [a]
init (forall a. [a] -> [a]
tail String
w))
                                else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a string" }

instance Parse Bool where
    parse :: TextParser Bool
parse = forall a. Show a => String -> [a] -> TextParser a
enumeration String
"Bool" [Bool
False,Bool
True]

instance Parse Ordering where
    parse :: TextParser Ordering
parse = forall a. Show a => String -> [a] -> TextParser a
enumeration String
"Ordering" [Ordering
LT,Ordering
EQ,Ordering
GT]

-- Structural types
instance Parse () where
    parse :: TextParser ()
parse = forall t a. ([t] -> Result [t] a) -> Parser t a
P String -> Result String ()
p
      where p :: String -> Result String ()
p []       = forall z a. z -> String -> Result z a
Failure [] String
"no input: expected a ()"
            p (Char
'(':String
cs) = case forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
cs of
                             (Char
')':String
s) -> forall z a. z -> a -> Result z a
Success String
s ()
                             String
_       -> forall z a. z -> String -> Result z a
Failure String
cs String
"Expected ) after ("
            p (Char
c:String
cs) | Char -> Bool
isSpace Char
c = String -> Result String ()
p String
cs
                     | Bool
otherwise = forall z a. z -> String -> Result z a
Failure (Char
cforall a. a -> [a] -> [a]
:String
cs) (String
"Expected a (), got "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Char
c)

instance (Parse a, Parse b) => Parse (a,b) where
    parse :: TextParser (a, b)
parse = do{ String -> TextParser String
isWord String
"(" forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"Opening a 2-tuple\n"forall a. [a] -> [a] -> [a]
++)
              ; a
x <- forall a. Parse a => TextParser a
parse forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"In 1st item of a 2-tuple\n"forall a. [a] -> [a] -> [a]
++)
              ; String -> TextParser String
isWord String
"," forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"Separating a 2-tuple\n"forall a. [a] -> [a] -> [a]
++)
              ; b
y <- forall a. Parse a => TextParser a
parse forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"In 2nd item of a 2-tuple\n"forall a. [a] -> [a] -> [a]
++)
              ; String -> TextParser String
isWord String
")" forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"Closing a 2-tuple\n"forall a. [a] -> [a] -> [a]
++)
              ; forall (m :: * -> *) a. Monad m => a -> m a
return (a
x,b
y) }

instance (Parse a, Parse b, Parse c) => Parse (a,b,c) where
    parse :: TextParser (a, b, c)
parse = do{ String -> TextParser String
isWord String
"(" forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"Opening a 3-tuple\n"forall a. [a] -> [a] -> [a]
++)
              ; a
x <- forall a. Parse a => TextParser a
parse forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"In 1st item of a 3-tuple\n"forall a. [a] -> [a] -> [a]
++)
              ; String -> TextParser String
isWord String
"," forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"Separating(1) a 3-tuple\n"forall a. [a] -> [a] -> [a]
++)
              ; b
y <- forall a. Parse a => TextParser a
parse forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"In 2nd item of a 3-tuple\n"forall a. [a] -> [a] -> [a]
++)
              ; String -> TextParser String
isWord String
"," forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"Separating(2) a 3-tuple\n"forall a. [a] -> [a] -> [a]
++)
              ; c
z <- forall a. Parse a => TextParser a
parse forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"In 3rd item of a 3-tuple\n"forall a. [a] -> [a] -> [a]
++)
              ; String -> TextParser String
isWord String
")" forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"Closing a 3-tuple\n"forall a. [a] -> [a] -> [a]
++)
              ; forall (m :: * -> *) a. Monad m => a -> m a
return (a
x,b
y,c
z) }

instance Parse a => Parse (Maybe a) where
    parsePrec :: Int -> TextParser (Maybe a)
parsePrec Int
p =
            forall a. TextParser a -> TextParser a
optionalParens (do { String -> TextParser String
isWord String
"Nothing"; forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing })
            forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
            forall a. Bool -> TextParser a -> TextParser a
parens (Int
pforall a. Ord a => a -> a -> Bool
>Int
9)   (do { String -> TextParser String
isWord String
"Just"
                               ; forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Parse a => Int -> TextParser a
parsePrec Int
10
                                     forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (String
"but within Just, "forall a. [a] -> [a] -> [a]
++) })
            forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ((String
"expected a Maybe (Just or Nothing)\n"forall a. [a] -> [a] -> [a]
++)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> String -> String
indent Int
2)

instance (Parse a, Parse b) => Parse (Either a b) where
    parsePrec :: Int -> TextParser (Either a b)
parsePrec Int
p =
            forall a. Bool -> TextParser a -> TextParser a
parens (Int
pforall a. Ord a => a -> a -> Bool
>Int
9) forall a b. (a -> b) -> a -> b
$
            forall a. [(String, TextParser a)] -> TextParser a
constructors [ (String
"Left",  do { forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left  forall a b. (a -> b) -> a -> b
$ forall a. Parse a => Int -> TextParser a
parsePrec Int
10 } )
                         , (String
"Right", do { forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Parse a => Int -> TextParser a
parsePrec Int
10 } )
                         ]

instance Parse a => Parse [a] where
    parse :: TextParser [a]
parse = forall a. Parse a => TextParser [a]
parseList

-- | Simply return the entire remaining input String.
allAsString :: TextParser String
allAsString :: TextParser String
allAsString =  forall t a. ([t] -> Result [t] a) -> Parser t a
P (\String
s-> forall z a. z -> a -> Result z a
Success [] String
s)

------------------------------------------------------------------------