module Text.Parse.ByteString
  ( -- * The Parse class is a replacement for the standard Read class. 
    --   This particular instance reads from ByteString rather than String.
    -- $parser
    TextParser	-- synonym for Text.ParserCombinators.Poly.ByteString
  , 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 bytestring 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
  , parseUnsignedInteger
  , parseFloat
  , parseLitChar
  , parseLitChar'
    -- ** Re-export all the more general combinators from Poly too
  , module Text.ParserCombinators.Poly.ByteStringChar
    -- ** ByteStrings and Strings as whole entities
  , allAsByteString
  , allAsString
  ) where

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

------------------------------------------------------------------------
-- $parser
-- The Parse class is a replacement for the standard Read class.  It is a
-- specialisation of the (poly) Parser monad for ByteString 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 a ByteString Parser, i.e. bytestring input (no state)
type TextParser a = Parser 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|.  In general,
    --   for a type that never needs parens, you should define |parse|, but
    --   for a type that _may_ need parens, you should define |parsePrec|.)
    parse     :: TextParser a
    parse       = Int -> TextParser a
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
_ = TextParser a -> TextParser a
forall a. TextParser a -> TextParser a
optionalParens TextParser a
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 { [Char] -> TextParser [Char]
isWord [Char]
"[]"; [a] -> TextParser [a]
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return [] }
                   TextParser [a] -> TextParser [a] -> TextParser [a]
forall a. Parser a -> Parser a -> Parser a
`onFail`
                 do { [Char] -> TextParser [Char]
isWord [Char]
"["; [Char] -> TextParser [Char]
isWord [Char]
"]"; [a] -> TextParser [a]
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return [] }
                   TextParser [a] -> TextParser [a] -> TextParser [a]
forall a. Parser a -> Parser a -> Parser a
`onFail`
                 TextParser [Char]
-> TextParser [Char]
-> TextParser [Char]
-> TextParser a
-> TextParser [a]
forall (p :: * -> *) bra sep ket a.
PolyParse p =>
p bra -> p sep -> p ket -> p a -> p [a]
bracketSep ([Char] -> TextParser [Char]
isWord [Char]
"[") ([Char] -> TextParser [Char]
isWord [Char]
",") ([Char] -> TextParser [Char]
isWord [Char]
"]")
                            (TextParser a -> TextParser a
forall a. TextParser a -> TextParser a
optionalParens TextParser a
forall a. Parse a => TextParser a
parse)
                   TextParser [a] -> ([Char] -> [Char]) -> TextParser [a]
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"Expected a list, but\n"[Char] -> [Char] -> [Char]
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).  Use of this
--   wrapper function is NOT recommended with ByteString, because there
--   is a lot of inefficiency in repeated conversions to/from String.
parseByRead :: Read a => String -> TextParser a
parseByRead :: forall a. Read a => [Char] -> TextParser a
parseByRead [Char]
name =
    (ByteString -> Result ByteString a) -> Parser a
forall a. (ByteString -> Result ByteString a) -> Parser a
P (\ByteString
s-> case ReadS a
forall a. Read a => ReadS a
reads (ByteString -> [Char]
BS.unpack ByteString
s) of
                []       -> ByteString -> [Char] -> Result ByteString a
forall z a. z -> [Char] -> Result z a
Failure ByteString
s ([Char]
"no parse, expected a "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
name)
                [(a
a,[Char]
s')] -> ByteString -> a -> Result ByteString a
forall z a. z -> a -> Result z a
Success ([Char] -> ByteString
BS.pack [Char]
s') a
a
                [(a, [Char])]
_        -> ByteString -> [Char] -> Result ByteString a
forall z a. z -> [Char] -> Result z a
Failure ByteString
s ([Char]
"ambiguous parse, expected a "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
name)
      )

-- | If you have a TextParser for a type, you can easily make it into
--   a Read instance, by throwing away any error messages.  Use of this
--   wrapper function is NOT recommended with ByteString, because there
--   is a lot of inefficiency in conversions to/from String.
readByParse :: TextParser a -> ReadS a
readByParse :: forall a. TextParser a -> ReadS a
readByParse TextParser a
p = \[Char]
inp->
    case TextParser a -> ByteString -> (Either [Char] a, ByteString)
forall a. Parser a -> ByteString -> (Either [Char] a, ByteString)
runParser TextParser a
p ([Char] -> ByteString
BS.pack [Char]
inp) of
        (Left [Char]
err,  ByteString
rest) -> []
        (Right a
val, ByteString
rest) -> [(a
val, ByteString -> [Char]
BS.unpack ByteString
rest)]

-- | If you have a TextParser for a type, you can easily make it into
--   a Read instance, by throwing away any error messages.  Use of this
--   wrapper function is NOT recommended with ByteString, because there
--   is a lot of inefficiency in conversions to/from String.
readsPrecByParsePrec :: (Int -> TextParser a) -> Int -> ReadS a
readsPrecByParsePrec :: forall a. (Int -> TextParser a) -> Int -> ReadS a
readsPrecByParsePrec Int -> TextParser a
p = \Int
prec [Char]
inp->
    case TextParser a -> ByteString -> (Either [Char] a, ByteString)
forall a. Parser a -> ByteString -> (Either [Char] a, ByteString)
runParser (Int -> TextParser a
p Int
prec) ([Char] -> ByteString
BS.pack [Char]
inp) of
        (Left [Char]
err,  ByteString
rest) -> []
        (Right a
val, ByteString
rest) -> [(a
val, ByteString -> [Char]
BS.unpack ByteString
rest)]


-- | One lexical chunk (Haskell-style lexing).
word :: TextParser String
{-
word = P (\s-> case lex (BS.unpack s) of
                   []         -> Failure s  ("no input? (impossible)")
                   [("","")]  -> Failure s ("no input?")
                   [("",_)]   -> Failure s  ("lexing failed?")
                   ((x,_):_)  -> Success (BS.drop (fromIntegral (length x)) s) x
         )
-}
word :: TextParser [Char]
word = (ByteString -> Result ByteString [Char]) -> TextParser [Char]
forall a. (ByteString -> Result ByteString a) -> Parser a
P (ByteString -> Result ByteString [Char]
p (ByteString -> Result ByteString [Char])
-> (ByteString -> ByteString)
-> ByteString
-> Result ByteString [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile Char -> Bool
isSpace)
  where
    p :: ByteString -> Result ByteString [Char]
p ByteString
s | ByteString -> Bool
BS.null ByteString
s = ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> [Char] -> Result z a
Failure ByteString
BS.empty [Char]
"end of input"
        | Bool
otherwise =
      case (ByteString -> Char
BS.head ByteString
s, HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.tail ByteString
s) of
        (Char
'\'',ByteString
t) -> let (P ByteString -> Result ByteString Char
lit) = Parser Char
parseLitChar' in (Char -> [Char])
-> Result ByteString Char -> Result ByteString [Char]
forall a b. (a -> b) -> Result ByteString a -> Result ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Result ByteString Char
lit ByteString
s)
        (Char
'\"',ByteString
t) -> let (ByteString
str,ByteString
rest) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"\\\"")) ByteString
t
                    in [Char] -> ByteString -> Result ByteString [Char]
litString (Char
'\"'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ByteString -> [Char]
BS.unpack ByteString
str) ByteString
rest
        (Char
'0',ByteString
s) -> case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
s of
                     Just (Char
'x',ByteString
r) -> ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> a -> Result z a
Success ByteString
t ([Char]
"0x"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ByteString -> [Char]
BS.unpack ByteString
ds)
                                            where (ByteString
ds,ByteString
t) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
isHexDigit ByteString
r
                     Just (Char
'X',ByteString
r) -> ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> a -> Result z a
Success ByteString
t ([Char]
"0X"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ByteString -> [Char]
BS.unpack ByteString
ds)
                                            where (ByteString
ds,ByteString
t) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
isHexDigit ByteString
r
                     Just (Char
'o',ByteString
r) -> ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> a -> Result z a
Success ByteString
t ([Char]
"0o"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ByteString -> [Char]
BS.unpack ByteString
ds)
                                            where (ByteString
ds,ByteString
t) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
isOctDigit ByteString
r
                     Just (Char
'O',ByteString
r) -> ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> a -> Result z a
Success ByteString
t ([Char]
"0O"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ByteString -> [Char]
BS.unpack ByteString
ds)
                                            where (ByteString
ds,ByteString
t) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
isOctDigit ByteString
r
                     Maybe (Char, ByteString)
_ -> [Char] -> ByteString -> Result ByteString [Char]
lexFracExp (Char
'0'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ByteString -> [Char]
BS.unpack ByteString
ds) ByteString
t
                                            where (ByteString
ds,ByteString
t) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
isDigit ByteString
s
        (Char
c,ByteString
s) | Char -> Bool
isIdInit Char
c -> let (ByteString
nam,ByteString
t) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
isIdChar ByteString
s in
                                                   ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> a -> Result z a
Success ByteString
t (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ByteString -> [Char]
BS.unpack ByteString
nam)
              | Char -> Bool
isDigit  Char
c -> let (ByteString
ds,ByteString
t)  = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
isDigit ByteString
s in
                                                 [Char] -> ByteString -> Result ByteString [Char]
lexFracExp (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ByteString -> [Char]
BS.unpack ByteString
ds) ByteString
t
              | Char -> Bool
isSingle Char
c -> ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> a -> Result z a
Success ByteString
s (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[])
              | Char -> Bool
isSym    Char
c -> let (ByteString
sym,ByteString
t) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
isSym ByteString
s in
                                                   ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> a -> Result z a
Success ByteString
t (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ByteString -> [Char]
BS.unpack ByteString
sym)
              | Bool
otherwise  -> ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> [Char] -> Result z a
Failure (Char -> ByteString -> ByteString
BS.cons Char
c ByteString
s) ([Char]
"Bad character: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Char -> [Char]
forall a. Show a => a -> [Char]
show Char
c)

    isSingle :: Char -> Bool
isSingle Char
c  =  Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
",;()[]{}`"
    isSym :: Char -> Bool
isSym    Char
c  =  Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"!@#$%&*+./<=>?\\^|:-~"
    isIdInit :: Char -> Bool
isIdInit Char
c  =  Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
    isIdChar :: Char -> Bool
isIdChar Char
c  =  Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"_'"

    lexFracExp :: [Char] -> ByteString -> Result ByteString [Char]
lexFracExp [Char]
acc ByteString
s = case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
s of
                           Just (Char
'.',ByteString
s') ->
                               case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
s' of
                                   Just (Char
d,ByteString
s'') | Char -> Bool
isDigit Char
d ->
                                        let (ByteString
ds,ByteString
t) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
isDigit ByteString
s'' in
                                        [Char] -> ByteString -> Result ByteString [Char]
lexExp ([Char]
acc[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Char
'.'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
dChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ByteString -> [Char]
BS.unpack ByteString
ds) ByteString
t
                                   Maybe (Char, ByteString)
_ -> [Char] -> ByteString -> Result ByteString [Char]
lexExp [Char]
acc ByteString
s'
                           Maybe (Char, ByteString)
_ -> [Char] -> ByteString -> Result ByteString [Char]
lexExp [Char]
acc ByteString
s

    lexExp :: [Char] -> ByteString -> Result ByteString [Char]
lexExp [Char]
acc ByteString
s = case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
s of
        Just (Char
e,ByteString
s') | Char
e Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"eE" ->
                    case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
s' of
                        Just (Char
sign,ByteString
dt)
                            | Char
sign Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"+-" ->
                                  case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
dt of
                                      Just (Char
d,ByteString
t) | Char -> Bool
isDigit Char
d ->
                                          let (ByteString
ds,ByteString
u) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
isDigit ByteString
t in
                                          ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> a -> Result z a
Success ByteString
u ([Char]
acc[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Char
'e'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
signChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
dChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:
                                                     ByteString -> [Char]
BS.unpack ByteString
ds)
                            | Char -> Bool
isDigit Char
sign ->
                                  let (ByteString
ds,ByteString
u) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
isDigit ByteString
dt in
                                  ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> a -> Result z a
Success ByteString
u ([Char]
acc[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Char
'e'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
signChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ByteString -> [Char]
BS.unpack ByteString
ds)
                        Maybe (Char, ByteString)
_ -> ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> [Char] -> Result z a
Failure ByteString
s' ([Char]
"missing +/-/digit "
                                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"after e in float literal: "
                                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char] -> [Char]
forall a. Show a => a -> [Char]
show ([Char]
acc[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Char
'e'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
"..."))
        Maybe (Char, ByteString)
_ -> ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> a -> Result z a
Success ByteString
s [Char]
acc

    litString :: [Char] -> ByteString -> Result ByteString [Char]
litString [Char]
acc ByteString
s = case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
s of
        Maybe (Char, ByteString)
Nothing       -> ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> [Char] -> Result z a
Failure (ByteString
BS.empty)
                                 ([Char]
"end of input in string literal "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
acc)
        Just (Char
'\"',ByteString
r) -> ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> a -> Result z a
Success ByteString
r ([Char]
acc[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\"")
        Just (Char
'\\',ByteString
r) -> let (P ByteString -> Result ByteString Char
lit) = Parser Char
parseLitChar
                         in case ByteString -> Result ByteString Char
lit ByteString
s of
                              Failure ByteString
a [Char]
b  -> ByteString -> [Char] -> Result ByteString [Char]
forall z a. z -> [Char] -> Result z a
Failure ByteString
a [Char]
b
                              Success ByteString
t Char
char ->
                                  let (ByteString
u,ByteString
v) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`[Char]
"\\\"") ByteString
t
                                  in  [Char] -> ByteString -> Result ByteString [Char]
litString ([Char]
acc[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char
char][Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ByteString -> [Char]
BS.unpack ByteString
u) ByteString
v
        Just (Char
_,ByteString
r)    -> [Char] -> Result ByteString [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"Text.Parse.word(litString) - can't happen"


-- | 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 :: [Char] -> TextParser [Char]
isWord [Char]
w = do { [Char]
w' <- TextParser [Char]
word
              ; if [Char]
w'[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
w then [Char] -> TextParser [Char]
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
w else [Char] -> TextParser [Char]
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"expected "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
w[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" got "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
w')
              }

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

-- | Allow optional nested string parens around an item.
optionalParens :: TextParser a -> TextParser a
optionalParens :: forall a. TextParser a -> TextParser a
optionalParens TextParser a
p = Bool -> TextParser a -> TextParser a
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 = TextParser [Char]
-> TextParser [Char] -> TextParser a -> TextParser a
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket ([Char] -> TextParser [Char]
isWord [Char]
"(") ([Char] -> TextParser [Char]
isWord [Char]
")") (Bool -> TextParser a -> TextParser a
forall a. Bool -> TextParser a -> TextParser a
parens Bool
False TextParser a
p)
parens Bool
False TextParser a
p = Bool -> TextParser a -> TextParser a
forall a. Bool -> TextParser a -> TextParser a
parens Bool
True TextParser a
p TextParser a -> TextParser a -> TextParser a
forall a. Parser a -> Parser a -> Parser 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 => [Char] -> TextParser a
field [Char]
name = do { [Char] -> TextParser [Char]
isWord [Char]
name; TextParser a -> TextParser a
forall a. TextParser a -> TextParser a
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (TextParser a -> TextParser a) -> TextParser a -> TextParser a
forall a b. (a -> b) -> a -> b
$ do { [Char] -> TextParser [Char]
isWord [Char]
"="; TextParser a
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. [([Char], TextParser a)] -> TextParser a
constructors [([Char], TextParser a)]
cs = [([Char], TextParser a)] -> TextParser a
forall a. [([Char], TextParser a)] -> TextParser a
forall (p :: * -> *) a. Commitment p => [([Char], p a)] -> p a
oneOf' ((([Char], TextParser a) -> ([Char], TextParser a))
-> [([Char], TextParser a)] -> [([Char], TextParser a)]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], TextParser a) -> ([Char], TextParser a)
forall {b}. ([Char], Parser b) -> ([Char], Parser b)
cons [([Char], TextParser a)]
cs)
    where cons :: ([Char], Parser b) -> ([Char], Parser b)
cons ([Char]
name,Parser b
p) =
               ( [Char]
name
               , do { [Char] -> TextParser [Char]
isWord [Char]
name
                    ; Parser b
p Parser b -> ([Char] -> [Char]) -> Parser b
forall (p :: * -> *) a.
PolyParse p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErrBad` (([Char]
"got constructor, but within "
                                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
name[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
",\n")[Char] -> [Char] -> [Char]
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 => [Char] -> [a] -> TextParser a
enumeration [Char]
typ [a]
cs = [Parser a] -> Parser a
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf ((a -> Parser a) -> [a] -> [Parser a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
c-> do { [Char] -> TextParser [Char]
isWord (a -> [Char]
forall a. Show a => a -> [Char]
show a
c); a -> Parser a
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
c }) [a]
cs)
                         Parser a -> ([Char] -> [Char]) -> Parser a
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr`
                     ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++([Char]
"\n  expected "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
typ[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" value ("[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
e[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
")"))
    where e :: [Char]
e = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
", " ((a -> [Char]) -> [a] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [Char]
forall a. Show a => a -> [Char]
show ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
init [a]
cs)))
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", or " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show ([a] -> a
forall a. HasCallStack => [a] -> a
last [a]
cs)

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

-- Numeric types

-- | For any numeric parser, permit a negation sign in front of it.
parseSigned :: Real a => TextParser a -> TextParser a
parseSigned :: forall a. Real a => TextParser a -> TextParser a
parseSigned TextParser a
p = do Char
'-' <- Parser Char
next; TextParser a -> TextParser a
forall a. TextParser a -> TextParser a
forall (p :: * -> *) a. Commitment p => p a -> p a
commit ((a -> a) -> TextParser a -> TextParser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate TextParser a
p)
                TextParser a -> TextParser a -> TextParser a
forall a. Parser a -> Parser a -> Parser a
`onFail`
                do TextParser a
p

-- | Parse any (unsigned) Integral numeric literal.
--   Needs a base, radix, isDigit predicate,
--   and digitToInt converter, appropriate to the result type.
parseInt :: (Integral a) => String ->
                            a -> (Char -> Bool) -> (Char -> Int) ->
                            TextParser a
parseInt :: forall a.
Integral a =>
[Char] -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
parseInt [Char]
base a
radix Char -> Bool
isDigit Char -> Int
digitToInt =
                 do [Char]
cs <- Parser Char -> TextParser [Char]
forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 ((Char -> Bool) -> Parser Char
satisfy Char -> Bool
isDigit)
                    a -> Parser a
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\a
n a
d-> a
na -> a -> a
forall a. Num a => a -> a -> a
*a
radixa -> a -> a
forall a. Num a => a -> a -> a
+a
d)
                                   ((Char -> a) -> [Char] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> a) -> (Char -> Int) -> Char -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Int
digitToInt) [Char]
cs))
                 Parser a -> ([Char] -> [Char]) -> Parser a
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++([Char]
"\nexpected one or more "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
base[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" digits"))

-- | Parse a decimal, octal, or hexadecimal (unsigned) Integral numeric literal.
parseDec, parseOct, parseHex :: (Integral a) => TextParser a
parseDec :: forall a. Integral a => TextParser a
parseDec = [Char] -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
forall a.
Integral a =>
[Char] -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
parseInt [Char]
"decimal" a
10 Char -> Bool
Char.isDigit    Char -> Int
Char.digitToInt
parseOct :: forall a. Integral a => TextParser a
parseOct = [Char] -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
forall a.
Integral a =>
[Char] -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
parseInt [Char]
"octal"    a
8 Char -> Bool
Char.isOctDigit Char -> Int
Char.digitToInt
parseHex :: forall a. Integral a => TextParser a
parseHex = [Char] -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
forall a.
Integral a =>
[Char] -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
parseInt [Char]
"hex"     a
16 Char -> Bool
Char.isHexDigit Char -> Int
Char.digitToInt

-- | parseUnsignedInteger uses the underlying ByteString readInteger, so
--   will be a lot faster than the generic character-by-character parseInt.
parseUnsignedInteger :: TextParser Integer
parseUnsignedInteger :: TextParser Integer
parseUnsignedInteger = (ByteString -> Result ByteString Integer) -> TextParser Integer
forall a. (ByteString -> Result ByteString a) -> Parser a
P (\ByteString
bs -> case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
bs of
                                 Just (Char
c, ByteString
_)
                                  | Char -> Bool
Char.isDigit Char
c ->
                                     case ByteString -> Maybe (Integer, ByteString)
BS.readInteger ByteString
bs of
                                     Just (Integer
i, ByteString
bs') -> ByteString -> Integer -> Result ByteString Integer
forall z a. z -> a -> Result z a
Success ByteString
bs' Integer
i
                                     Maybe (Integer, ByteString)
Nothing -> [Char] -> Result ByteString Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"XXX Can't happen"
                                 Maybe (Char, ByteString)
_ -> ByteString -> [Char] -> Result ByteString Integer
forall z a. z -> [Char] -> Result z a
Failure ByteString
bs [Char]
"parsing Integer: not a digit")
               TextParser Integer -> ([Char] -> [Char]) -> TextParser Integer
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++([Char]
"\nexpected one or more decimal digits"))

-- | Parse any (unsigned) Floating numeric literal, e.g. Float or Double.
parseFloat :: (RealFrac a) => TextParser a
parseFloat :: forall a. RealFrac a => TextParser a
parseFloat = do ByteString
ds   <- (Char -> Bool) -> Parser ByteString
many1Satisfy Char -> Bool
isDigit
                ByteString
frac <- (do Char
'.' <- Parser Char
next
                            (Char -> Bool) -> Parser ByteString
manySatisfy Char -> Bool
isDigit
                              Parser ByteString -> ([Char] -> [Char]) -> Parser ByteString
forall (p :: * -> *) a.
PolyParse p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErrBad` ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"expected digit after .")
                         Parser ByteString -> Parser ByteString -> Parser ByteString
forall a. Parser a -> Parser a -> Parser a
`onFail` ByteString -> Parser ByteString
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
BS.empty )
                Int64
exp  <- Parser Int64
exponent Parser Int64 -> Parser Int64 -> Parser Int64
forall a. Parser a -> Parser a -> Parser a
`onFail` Int64 -> Parser Int64
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
0
                ( a -> Parser a
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Parser a) -> (ByteString -> a) -> ByteString -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> (ByteString -> Rational) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
10Rational -> Int64 -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
^^(Int64
exp Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- ByteString -> Int64
BS.length ByteString
frac)))
                  (Rational -> Rational)
-> (ByteString -> Rational) -> ByteString -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
1) (Integer -> Rational)
-> (ByteString -> Integer) -> ByteString -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (\ (Right Integer
x)->Integer
x) (Either [Char] Integer -> Integer)
-> (ByteString -> Either [Char] Integer) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either [Char] Integer, ByteString) -> Either [Char] Integer
forall a b. (a, b) -> a
fst
                  ((Either [Char] Integer, ByteString) -> Either [Char] Integer)
-> (ByteString -> (Either [Char] Integer, ByteString))
-> ByteString
-> Either [Char] Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextParser Integer
-> ByteString -> (Either [Char] Integer, ByteString)
forall a. Parser a -> ByteString -> (Either [Char] a, ByteString)
runParser TextParser Integer
forall a. Integral a => TextParser a
parseDec ) (ByteString
ds ByteString -> ByteString -> ByteString
`BS.append` ByteString
frac)
             Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
`onFail`
             do ByteString
w <- (Char -> Bool) -> Parser ByteString
manySatisfy Char -> Bool
isAlpha
                case (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (ByteString -> [Char]
BS.unpack ByteString
w) of
                  [Char]
"nan"      -> a -> Parser a
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
0a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0)
                  [Char]
"infinity" -> a -> Parser a
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0)
                  [Char]
_          -> [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expected a floating point number"
  where exponent :: Parser Int64
exponent = do Char
'e' <- (Char -> Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower Parser Char
next
                      Parser Int64 -> Parser Int64
forall a. TextParser a -> TextParser a
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (do Char
'+' <- Parser Char
next; Parser Int64
forall a. Integral a => TextParser a
parseDec
                              Parser Int64 -> Parser Int64 -> Parser Int64
forall a. Parser a -> Parser a -> Parser a
`onFail`
                              Parser Int64 -> Parser Int64
forall a. Real a => TextParser a -> TextParser a
parseSigned Parser Int64
forall a. Integral a => TextParser a
parseDec )

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

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

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

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

-- Basic types
instance Parse Int where
    parse :: Parser Int
parse = (Integer -> Int) -> TextParser Integer -> Parser Int
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int
forall a. Num a => Integer -> a
fromInteger (TextParser Integer -> Parser Int)
-> TextParser Integer -> Parser Int
forall a b. (a -> b) -> a -> b
$	-- convert from Integer, deals with minInt
              do (Char -> Bool) -> Parser ByteString
manySatisfy Char -> Bool
isSpace; TextParser Integer -> TextParser Integer
forall a. Real a => TextParser a -> TextParser a
parseSigned TextParser Integer
parseUnsignedInteger
instance Parse Integer where
    parse :: TextParser Integer
parse = do (Char -> Bool) -> Parser ByteString
manySatisfy Char -> Bool
isSpace; TextParser Integer -> TextParser Integer
forall a. Real a => TextParser a -> TextParser a
parseSigned TextParser Integer
parseUnsignedInteger
instance Parse Float where
    parse :: TextParser Float
parse = do (Char -> Bool) -> Parser ByteString
manySatisfy Char -> Bool
isSpace; TextParser Float -> TextParser Float
forall a. Real a => TextParser a -> TextParser a
parseSigned TextParser Float
forall a. RealFrac a => TextParser a
parseFloat
instance Parse Double where
    parse :: TextParser Double
parse = do (Char -> Bool) -> Parser ByteString
manySatisfy Char -> Bool
isSpace; TextParser Double -> TextParser Double
forall a. Real a => TextParser a -> TextParser a
parseSigned TextParser Double
forall a. RealFrac a => TextParser a
parseFloat
instance Parse Char where
    parse :: Parser Char
parse = do (Char -> Bool) -> Parser ByteString
manySatisfy Char -> Bool
isSpace; Parser Char
parseLitChar'
	-- not totally correct for strings...
    parseList :: TextParser [Char]
parseList = do { [Char]
w <- TextParser [Char]
word; if [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' then [Char] -> TextParser [Char]
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init ([Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [Char]
w))
                                else [Char] -> TextParser [Char]
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"not a string" }

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

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

-- Structural types
instance Parse () where
    parse :: Parser ()
parse = (ByteString -> Result ByteString ()) -> Parser ()
forall a. (ByteString -> Result ByteString a) -> Parser a
P (Maybe (Char, ByteString) -> Result ByteString ()
p (Maybe (Char, ByteString) -> Result ByteString ())
-> (ByteString -> Maybe (Char, ByteString))
-> ByteString
-> Result ByteString ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Char, ByteString)
BS.uncons)
      where p :: Maybe (Char, ByteString) -> Result ByteString ()
p Maybe (Char, ByteString)
Nothing         = ByteString -> [Char] -> Result ByteString ()
forall z a. z -> [Char] -> Result z a
Failure ByteString
BS.empty [Char]
"no input: expected a ()"
            p (Just (Char
'(',ByteString
cs)) = case ByteString -> Maybe (Char, ByteString)
BS.uncons ((Char -> Bool) -> ByteString -> ByteString
BS.dropWhile Char -> Bool
isSpace ByteString
cs) of
                                Just (Char
')',ByteString
s) -> ByteString -> () -> Result ByteString ()
forall z a. z -> a -> Result z a
Success ByteString
s ()
                                Maybe (Char, ByteString)
_            -> ByteString -> [Char] -> Result ByteString ()
forall z a. z -> [Char] -> Result z a
Failure ByteString
cs [Char]
"Expected ) after ("
            p (Just (Char
c,ByteString
cs))   | Char -> Bool
isSpace Char
c = Maybe (Char, ByteString) -> Result ByteString ()
p (ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
cs)
                              | Bool
otherwise = ByteString -> [Char] -> Result ByteString ()
forall z a. z -> [Char] -> Result z a
Failure (Char -> ByteString -> ByteString
BS.cons Char
c ByteString
cs)
                                                ([Char]
"Expected a (), got "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Char -> [Char]
forall a. Show a => a -> [Char]
show Char
c)

instance (Parse a, Parse b) => Parse (a,b) where
    parse :: TextParser (a, b)
parse = do{ [Char] -> TextParser [Char]
isWord [Char]
"(" TextParser [Char] -> ([Char] -> [Char]) -> TextParser [Char]
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"Opening a 2-tuple\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
              ; a
x <- TextParser a
forall a. Parse a => TextParser a
parse TextParser a -> ([Char] -> [Char]) -> TextParser a
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"In 1st item of a 2-tuple\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
              ; [Char] -> TextParser [Char]
isWord [Char]
"," TextParser [Char] -> ([Char] -> [Char]) -> TextParser [Char]
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"Separating a 2-tuple\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
              ; b
y <- TextParser b
forall a. Parse a => TextParser a
parse TextParser b -> ([Char] -> [Char]) -> TextParser b
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"In 2nd item of a 2-tuple\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
              ; [Char] -> TextParser [Char]
isWord [Char]
")" TextParser [Char] -> ([Char] -> [Char]) -> TextParser [Char]
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"Closing a 2-tuple\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
              ; (a, b) -> TextParser (a, b)
forall a. a -> Parser 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{ [Char] -> TextParser [Char]
isWord [Char]
"(" TextParser [Char] -> ([Char] -> [Char]) -> TextParser [Char]
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"Opening a 3-tuple\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
              ; a
x <- TextParser a
forall a. Parse a => TextParser a
parse TextParser a -> ([Char] -> [Char]) -> TextParser a
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"In 1st item of a 3-tuple\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
              ; [Char] -> TextParser [Char]
isWord [Char]
"," TextParser [Char] -> ([Char] -> [Char]) -> TextParser [Char]
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"Separating(1) a 3-tuple\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
              ; b
y <- TextParser b
forall a. Parse a => TextParser a
parse TextParser b -> ([Char] -> [Char]) -> TextParser b
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"In 2nd item of a 3-tuple\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
              ; [Char] -> TextParser [Char]
isWord [Char]
"," TextParser [Char] -> ([Char] -> [Char]) -> TextParser [Char]
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"Separating(2) a 3-tuple\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
              ; c
z <- TextParser c
forall a. Parse a => TextParser a
parse TextParser c -> ([Char] -> [Char]) -> TextParser c
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"In 3rd item of a 3-tuple\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
              ; [Char] -> TextParser [Char]
isWord [Char]
")" TextParser [Char] -> ([Char] -> [Char]) -> TextParser [Char]
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` ([Char]
"Closing a 3-tuple\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
              ; (a, b, c) -> TextParser (a, b, c)
forall a. a -> Parser 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 =
            TextParser (Maybe a) -> TextParser (Maybe a)
forall a. TextParser a -> TextParser a
optionalParens (do { [Char] -> TextParser [Char]
isWord [Char]
"Nothing"; Maybe a -> TextParser (Maybe a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing })
            TextParser (Maybe a)
-> TextParser (Maybe a) -> TextParser (Maybe a)
forall a. Parser a -> Parser a -> Parser a
`onFail`
            Bool -> TextParser (Maybe a) -> TextParser (Maybe a)
forall a. Bool -> TextParser a -> TextParser a
parens (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
9)   (do { [Char] -> TextParser [Char]
isWord [Char]
"Just"
                               ; (a -> Maybe a) -> Parser a -> TextParser (Maybe a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Parser a -> TextParser (Maybe a))
-> Parser a -> TextParser (Maybe a)
forall a b. (a -> b) -> a -> b
$ Int -> Parser a
forall a. Parse a => Int -> TextParser a
parsePrec Int
10
                                     Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
PolyParse p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErrBad` ([Char]
"but within Just, "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) })
            TextParser (Maybe a) -> ([Char] -> [Char]) -> TextParser (Maybe a)
forall a. Parser a -> ([Char] -> [Char]) -> Parser a
forall (p :: * -> *) a.
Commitment p =>
p a -> ([Char] -> [Char]) -> p a
`adjustErr` (([Char]
"expected a Maybe (Just or Nothing)\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> [Char] -> [Char]
indent Int
2)

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

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

------------------------------------------------------------------------
-- ByteStrings as a whole entity.

-- | Simply return the remaining input ByteString.
allAsByteString :: TextParser ByteString
allAsByteString :: Parser ByteString
allAsByteString =  (ByteString -> Result ByteString ByteString) -> Parser ByteString
forall a. (ByteString -> Result ByteString a) -> Parser a
P (\ByteString
bs-> ByteString -> ByteString -> Result ByteString ByteString
forall z a. z -> a -> Result z a
Success ByteString
BS.empty ByteString
bs)

-- | Simply return the remaining input as a String.
allAsString     :: TextParser String
allAsString :: TextParser [Char]
allAsString     =  (ByteString -> [Char]) -> Parser ByteString -> TextParser [Char]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> [Char]
BS.unpack Parser ByteString
allAsByteString

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