module Text.Parse
(
TextParser
, Parse(..)
, parseByRead
, readByParse
, readsPrecByParsePrec
, word
, isWord
, literal
, optionalParens
, parens
, field
, constructors
, enumeration
, parseSigned
, parseInt
, parseDec
, parseOct
, parseHex
, parseFloat
, parseLitChar
, parseLitChar'
, module Text.ParserCombinators.Poly
, 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
type TextParser a = Parser Char a
class Parse a where
parse :: TextParser a
parse = Int -> TextParser a
forall a. Parse a => Int -> TextParser a
parsePrec 0
parsePrec :: Int -> TextParser a
parsePrec _ = TextParser a -> TextParser a
forall a. TextParser a -> TextParser a
optionalParens TextParser a
forall a. Parse a => TextParser a
parse
parseList :: TextParser [a]
parseList = do { String -> TextParser String
isWord "[]"; [a] -> TextParser [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [] }
TextParser [a] -> TextParser [a] -> TextParser [a]
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do { String -> TextParser String
isWord "["; String -> TextParser String
isWord "]"; [a] -> TextParser [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [] }
TextParser [a] -> TextParser [a] -> TextParser [a]
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
TextParser String
-> TextParser String
-> TextParser String
-> TextParser a
-> TextParser [a]
forall (p :: * -> *) bra sep ket a.
PolyParse p =>
p bra -> p sep -> p ket -> p a -> p [a]
bracketSep (String -> TextParser String
isWord "[") (String -> TextParser String
isWord ",") (String -> TextParser String
isWord "]")
(TextParser a -> TextParser a
forall a. TextParser a -> TextParser a
optionalParens TextParser a
forall a. Parse a => TextParser a
parse)
TextParser [a] -> (String -> String) -> TextParser [a]
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("Expected a list, but\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
parseByRead :: Read a => String -> TextParser a
parseByRead :: String -> TextParser a
parseByRead name :: String
name =
(String -> Result String a) -> TextParser a
forall t a. ([t] -> Result [t] a) -> Parser t a
P (\s :: String
s-> case ReadS a
forall a. Read a => ReadS a
reads String
s of
[] -> String -> String -> Result String a
forall z a. z -> String -> Result z a
Failure String
s ("no parse, expected a "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name)
[(a :: a
a,s' :: String
s')] -> String -> a -> Result String a
forall z a. z -> a -> Result z a
Success String
s' a
a
_ -> String -> String -> Result String a
forall z a. z -> String -> Result z a
Failure String
s ("ambiguous parse, expected a "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name)
)
readByParse :: TextParser a -> ReadS a
readByParse :: TextParser a -> ReadS a
readByParse p :: TextParser a
p = \inp :: String
inp->
case TextParser a -> String -> (Either String a, String)
forall t a. Parser t a -> [t] -> (Either String a, [t])
runParser TextParser a
p String
inp of
(Left err :: String
err, rest :: String
rest) -> []
(Right val :: a
val, rest :: String
rest) -> [(a
val,String
rest)]
readsPrecByParsePrec :: (Int -> TextParser a) -> Int -> ReadS a
readsPrecByParsePrec :: (Int -> TextParser a) -> Int -> ReadS a
readsPrecByParsePrec p :: Int -> TextParser a
p = \prec :: Int
prec inp :: String
inp->
case TextParser a -> String -> (Either String a, String)
forall t a. Parser t a -> [t] -> (Either String a, [t])
runParser (Int -> TextParser a
p Int
prec) String
inp of
(Left err :: String
err, rest :: String
rest) -> []
(Right val :: a
val, rest :: String
rest) -> [(a
val,String
rest)]
word :: TextParser String
word :: TextParser String
word = (String -> Result String String) -> TextParser String
forall t a. ([t] -> Result [t] a) -> Parser t a
P String -> Result String String
p
where
p :: String -> Result String String
p "" = String -> String -> Result String String
forall z a. z -> String -> Result z a
Failure "" "end of input"
p (c :: Char
c:s :: String
s) | Char -> Bool
isSpace Char
c = String -> Result String String
p ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
s)
p ('\'':s :: String
s) = let (P lit :: String -> Result String Char
lit) = Parser Char Char
parseLitChar' in (Char -> String) -> Result String Char -> Result String String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> String
forall a. Show a => a -> String
show (String -> Result String Char
lit ('\''Char -> String -> String
forall a. a -> [a] -> [a]
:String
s))
p ('"':s :: String
s) = String -> String -> Result String String
lexString "\"" String
s
where lexString :: String -> String -> Result String String
lexString acc :: String
acc ('"':s :: String
s) = String -> String -> Result String String
forall z a. z -> a -> Result z a
Success String
s (String -> String
forall a. [a] -> [a]
reverse ('"'Char -> String -> String
forall a. a -> [a] -> [a]
:String
acc))
lexString acc :: String
acc [] = String -> String -> Result String String
forall z a. z -> String -> Result z a
Failure [] ("end of input in "
String -> String -> String
forall a. [a] -> [a] -> [a]
++"string literal "
String -> String -> String
forall a. [a] -> [a] -> [a]
++String
acc)
lexString acc :: String
acc s :: String
s = let (P lit :: String -> Result String Char
lit) = Parser Char Char
parseLitChar
in case String -> Result String Char
lit String
s of
Failure a :: String
a b :: String
b -> String -> String -> Result String String
forall z a. z -> String -> Result z a
Failure String
a String
b
Success t :: String
t c :: Char
c -> String -> String -> Result String String
lexString (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) String
t
p ('0':'x':s :: String
s) = String -> String -> Result String String
forall z a. z -> a -> Result z a
Success String
t ('0'Char -> String -> String
forall a. a -> [a] -> [a]
:'x'Char -> String -> String
forall a. a -> [a] -> [a]
:String
ds) where (ds :: String
ds,t :: String
t) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isHexDigit String
s
p ('0':'X':s :: String
s) = String -> String -> Result String String
forall z a. z -> a -> Result z a
Success String
t ('0'Char -> String -> String
forall a. a -> [a] -> [a]
:'X'Char -> String -> String
forall a. a -> [a] -> [a]
:String
ds) where (ds :: String
ds,t :: String
t) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isHexDigit String
s
p ('0':'o':s :: String
s) = String -> String -> Result String String
forall z a. z -> a -> Result z a
Success String
t ('0'Char -> String -> String
forall a. a -> [a] -> [a]
:'o'Char -> String -> String
forall a. a -> [a] -> [a]
:String
ds) where (ds :: String
ds,t :: String
t) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isOctDigit String
s
p ('0':'O':s :: String
s) = String -> String -> Result String String
forall z a. z -> a -> Result z a
Success String
t ('0'Char -> String -> String
forall a. a -> [a] -> [a]
:'O'Char -> String -> String
forall a. a -> [a] -> [a]
:String
ds) where (ds :: String
ds,t :: String
t) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isOctDigit String
s
p (c :: Char
c:s :: String
s) | Char -> Bool
isSingle Char
c = String -> String -> Result String String
forall z a. z -> a -> Result z a
Success String
s [Char
c]
| Char -> Bool
isSym Char
c = let (sym :: String
sym,t :: String
t) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSym String
s in String -> String -> Result String String
forall z a. z -> a -> Result z a
Success String
t (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
sym)
| Char -> Bool
isIdInit Char
c = let (nam :: String
nam,t :: String
t) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isIdChar String
s in String -> String -> Result String String
forall z a. z -> a -> Result z a
Success String
t (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
nam)
| Char -> Bool
isDigit Char
c = let (ds :: String
ds,t :: String
t) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
s in
String -> String -> Result String String
lexFracExp (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
ds) String
t
| Bool
otherwise = String -> String -> Result String String
forall z a. z -> String -> Result z a
Failure (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
s) ("Bad character: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Char -> String
forall a. Show a => a -> String
show Char
c)
where isSingle :: Char -> Bool
isSingle c :: Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ",;()[]{}`"
isSym :: Char -> Bool
isSym c :: Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "!@#$%&*+./<=>?\\^|:-~"
isIdInit :: Char -> Bool
isIdInit c :: Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_'
isIdChar :: Char -> Bool
isIdChar c :: Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "_'"
lexFracExp :: String -> String -> Result String String
lexFracExp acc :: String
acc ('.':d :: Char
d:s :: String
s) | Char -> Bool
isDigit Char
d =
String -> String -> Result String String
lexExp (String
accString -> String -> String
forall a. [a] -> [a] -> [a]
++'.'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
ds) String
t
where (ds :: String
ds,t :: String
t) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
s
lexFracExp acc :: String
acc s :: String
s = String -> String -> Result String String
lexExp String
acc String
s
lexExp :: String -> String -> Result String String
lexExp acc :: String
acc (e :: Char
e:s :: String
s) | Char
eChar -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`"eE" =
case String
s of
('+':d :: Char
d:t :: String
t) | Char -> Bool
isDigit Char
d ->
let (ds :: String
ds,u :: String
u)=(Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
t in
String -> String -> Result String String
forall z a. z -> a -> Result z a
Success String
u (String
accString -> String -> String
forall a. [a] -> [a] -> [a]
++"e+"String -> String -> String
forall a. [a] -> [a] -> [a]
++Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
ds)
('-':d :: Char
d:t :: String
t) | Char -> Bool
isDigit Char
d ->
let (ds :: String
ds,u :: String
u)=(Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
t in
String -> String -> Result String String
forall z a. z -> a -> Result z a
Success String
u (String
accString -> String -> String
forall a. [a] -> [a] -> [a]
++"e-"String -> String -> String
forall a. [a] -> [a] -> [a]
++Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
ds)
(d :: Char
d:t :: String
t) |Char -> Bool
isDigit Char
d ->
let (ds :: String
ds,u :: String
u)=(Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
t in
String -> String -> Result String String
forall z a. z -> a -> Result z a
Success String
u (String
accString -> String -> String
forall a. [a] -> [a] -> [a]
++"e"String -> String -> String
forall a. [a] -> [a] -> [a]
++Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
ds)
_ -> String -> String -> Result String String
forall z a. z -> String -> Result z a
Failure String
s ("missing +/-/digit "
String -> String -> String
forall a. [a] -> [a] -> [a]
++"after e in float "
String -> String -> String
forall a. [a] -> [a] -> [a]
++"literal: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
show (String
accString -> String -> String
forall a. [a] -> [a] -> [a]
++"e"String -> String -> String
forall a. [a] -> [a] -> [a]
++"..."))
lexExp acc :: String
acc s :: String
s = String -> String -> Result String String
forall z a. z -> a -> Result z a
Success String
s String
acc
oldword :: TextParser String
oldword :: TextParser String
oldword = (String -> Result String String) -> TextParser String
forall t a. ([t] -> Result [t] a) -> Parser t a
P (\s :: String
s-> case ReadS String
lex String
s of
[] -> String -> String -> Result String String
forall z a. z -> String -> Result z a
Failure String
s ("no input? (impossible)")
[("","")] -> String -> String -> Result String String
forall z a. z -> String -> Result z a
Failure "" ("no input?")
[("",s' :: String
s')] -> String -> String -> Result String String
forall z a. z -> String -> Result z a
Failure String
s ("lexing failed?")
((x :: String
x,s' :: String
s'):_) -> String -> String -> Result String String
forall z a. z -> a -> Result z a
Success String
s' String
x
)
isWord :: String -> TextParser String
isWord :: String -> TextParser String
isWord w :: String
w = do { String
w' <- TextParser String
word
; if String
w'String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
w then String -> TextParser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
w else String -> TextParser String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("expected "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
wString -> String -> String
forall a. [a] -> [a] -> [a]
++" got "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
w')
}
literal :: String -> TextParser String
literal :: String -> TextParser String
literal w :: String
w = do { String
w' <- String -> TextParser String
forall a. Eq a => [a] -> Parser a String
walk String
w
; if String
w'String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
w then String -> TextParser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
w else String -> TextParser String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("expected "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
wString -> String -> String
forall a. [a] -> [a] -> [a]
++" got "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
w')
}
where walk :: [a] -> Parser a String
walk [] = String -> Parser a String
forall (m :: * -> *) a. Monad m => a -> m a
return String
w
walk (c :: a
c:cs :: [a]
cs) = do { a
x <- Parser a a
forall t. Parser t t
next
; if a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
c then [a] -> Parser a String
walk [a]
cs
else String -> Parser a String
forall (m :: * -> *) a. Monad m => a -> m a
return []
}
optionalParens :: TextParser a -> TextParser a
optionalParens :: TextParser a -> TextParser a
optionalParens p :: TextParser a
p = Bool -> TextParser a -> TextParser a
forall a. Bool -> TextParser a -> TextParser a
parens Bool
False TextParser a
p
parens :: Bool -> TextParser a -> TextParser a
parens :: Bool -> TextParser a -> TextParser a
parens True p :: TextParser a
p = TextParser String
-> TextParser String -> TextParser a -> TextParser a
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (String -> TextParser String
isWord "(") (String -> TextParser String
isWord ")") (Bool -> TextParser a -> TextParser a
forall a. Bool -> TextParser a -> TextParser a
parens Bool
False TextParser a
p)
parens False p :: 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 t a. Parser t a -> Parser t a -> Parser t a
`onFail` TextParser a
p
field :: Parse a => String -> TextParser a
field :: String -> TextParser a
field name :: String
name = do { String -> TextParser String
isWord String
name; 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 { String -> TextParser String
isWord "="; TextParser a
forall a. Parse a => TextParser a
parse } }
constructors :: [(String,TextParser a)] -> TextParser a
constructors :: [(String, TextParser a)] -> TextParser a
constructors cs :: [(String, TextParser a)]
cs = [(String, TextParser a)] -> TextParser a
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' (((String, TextParser a) -> (String, TextParser a))
-> [(String, TextParser a)] -> [(String, TextParser a)]
forall a b. (a -> b) -> [a] -> [b]
map (String, TextParser a) -> (String, TextParser a)
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 (name :: String
name,p :: Parser Char b
p) =
( String
name
, do { String -> TextParser String
isWord String
name
; Parser Char b
p Parser Char b -> (String -> String) -> Parser Char b
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (("got constructor, but within "
String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nameString -> String -> String
forall a. [a] -> [a] -> [a]
++",\n")String -> String -> String
forall a. [a] -> [a] -> [a]
++)
}
)
enumeration :: (Show a) => String -> [a] -> TextParser a
enumeration :: String -> [a] -> TextParser a
enumeration typ :: String
typ cs :: [a]
cs = [TextParser a] -> TextParser a
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf ((a -> TextParser a) -> [a] -> [TextParser a]
forall a b. (a -> b) -> [a] -> [b]
map (\c :: a
c-> do { String -> TextParser String
isWord (a -> String
forall a. Show a => a -> String
show a
c); a -> TextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
c }) [a]
cs)
TextParser a -> (String -> String) -> TextParser a
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr`
(String -> String -> String
forall a. [a] -> [a] -> [a]
++("\n expected "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
typString -> String -> String
forall a. [a] -> [a] -> [a]
++" value ("String -> String -> String
forall a. [a] -> [a] -> [a]
++String
eString -> String -> String
forall a. [a] -> [a] -> [a]
++")"))
where e :: String
e = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse ", " ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show ([a] -> [a]
forall a. [a] -> [a]
init [a]
cs)))
String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", or " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show ([a] -> a
forall a. [a] -> a
last [a]
cs)
parseSigned :: Real a => TextParser a -> TextParser a
parseSigned :: TextParser a -> TextParser a
parseSigned p :: TextParser a
p = do Char
'-' <- Parser Char Char
forall t. Parser t t
next; TextParser a -> TextParser a
forall (p :: * -> *) a. Commitment p => p a -> p a
commit ((a -> a) -> TextParser a -> TextParser a
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 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 :: String -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
parseInt base :: String
base radix :: a
radix isDigit :: Char -> Bool
isDigit digitToInt :: Char -> Int
digitToInt =
do String
cs <- Parser Char Char -> TextParser String
forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 ((Char -> Bool) -> Parser Char Char
forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isDigit)
a -> TextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\n :: a
n d :: 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) -> String -> [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) String
cs))
TextParser a -> (String -> String) -> TextParser a
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String -> String -> String
forall a. [a] -> [a] -> [a]
++("\nexpected one or more "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
baseString -> String -> String
forall a. [a] -> [a] -> [a]
++" digits"))
parseDec, parseOct, parseHex :: (Integral a) => TextParser a
parseDec :: TextParser a
parseDec = String -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
forall a.
Integral a =>
String -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
parseInt "decimal" 10 Char -> Bool
Char.isDigit Char -> Int
Char.digitToInt
parseOct :: TextParser a
parseOct = String -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
forall a.
Integral a =>
String -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
parseInt "octal" 8 Char -> Bool
Char.isOctDigit Char -> Int
Char.digitToInt
parseHex :: TextParser a
parseHex = String -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
forall a.
Integral a =>
String -> a -> (Char -> Bool) -> (Char -> Int) -> TextParser a
parseInt "hex" 16 Char -> Bool
Char.isHexDigit Char -> Int
Char.digitToInt
parseFloat :: (RealFrac a) => TextParser a
parseFloat :: TextParser a
parseFloat = do String
ds <- Parser Char Char -> TextParser String
forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 ((Char -> Bool) -> Parser Char Char
forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isDigit)
String
frac <- (do Char
'.' <- Parser Char Char
forall t. Parser t t
next
Parser Char Char -> TextParser String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Parser Char Char
forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isDigit)
TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (String -> String -> String
forall a. [a] -> [a] -> [a]
++"expected digit after .")
TextParser String -> TextParser String -> TextParser String
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> TextParser String
forall (m :: * -> *) a. Monad m => a -> m a
return [] )
Int
exp <- Parser Char Int
exponent Parser Char Int -> Parser Char Int -> Parser Char Int
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` Int -> Parser Char Int
forall (m :: * -> *) a. Monad m => a -> m a
return 0
( a -> TextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> TextParser a) -> (String -> a) -> String -> TextParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> (String -> Rational) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (10Rational -> Int -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
^^(Int
exp Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
frac)))
(Rational -> Rational)
-> (String -> Rational) -> String -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%1) (Integer -> Rational) -> (String -> Integer) -> String -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ (Right x :: Integer
x)->Integer
x) (Either String Integer -> Integer)
-> (String -> Either String Integer) -> String -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String Integer, String) -> Either String Integer
forall a b. (a, b) -> a
fst
((Either String Integer, String) -> Either String Integer)
-> (String -> (Either String Integer, String))
-> String
-> Either String Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Char Integer -> String -> (Either String Integer, String)
forall t a. Parser t a -> [t] -> (Either String a, [t])
runParser Parser Char Integer
forall a. Integral a => TextParser a
parseDec ) (String
dsString -> String -> String
forall a. [a] -> [a] -> [a]
++String
frac)
TextParser a -> TextParser a -> TextParser a
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do String
w <- Parser Char Char -> TextParser String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Parser Char Char
forall t. (t -> Bool) -> Parser t t
satisfy (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace))
case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
w of
"nan" -> a -> TextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (0a -> a -> a
forall a. Fractional a => a -> a -> a
/0)
"infinity" -> a -> TextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (1a -> a -> a
forall a. Fractional a => a -> a -> a
/0)
_ -> String -> TextParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expected a floating point number"
where exponent :: Parser Char Int
exponent = do Char
'e' <- (Char -> Char) -> Parser Char Char -> Parser Char Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower Parser Char Char
forall t. Parser t t
next
Parser Char Int -> Parser Char Int
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (do Char
'+' <- Parser Char Char
forall t. Parser t t
next; Parser Char Int
forall a. Integral a => TextParser a
parseDec
Parser Char Int -> Parser Char Int -> Parser Char Int
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
Parser Char Int -> Parser Char Int
forall a. Real a => TextParser a -> TextParser a
parseSigned Parser Char Int
forall a. Integral a => TextParser a
parseDec )
parseLitChar' :: TextParser Char
parseLitChar' :: Parser Char Char
parseLitChar' = do Char
'\'' <- Parser Char Char
forall t. Parser t t
next Parser Char Char -> (String -> String) -> Parser Char Char
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String -> String -> String
forall a. [a] -> [a] -> [a]
++"expected a literal char")
Char
char <- Parser Char Char
parseLitChar
Char
'\'' <- Parser Char Char
forall t. Parser t t
next Parser Char Char -> (String -> String) -> Parser Char Char
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (String -> String -> String
forall a. [a] -> [a] -> [a]
++"literal char has no final '")
Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
char
parseLitChar :: TextParser Char
parseLitChar :: Parser Char Char
parseLitChar = do Char
c <- Parser Char Char
forall t. Parser t t
next
Char
char <- case Char
c of
'\\' -> Parser Char Char
forall t. Parser t t
next Parser Char Char -> (Char -> Parser Char Char) -> Parser Char Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Parser Char Char
escape
'\'' -> String -> Parser Char Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expected a literal char, got ''"
_ -> Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
char
where
escape :: Char -> Parser Char Char
escape 'a' = Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\a'
escape 'b' = Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\b'
escape 'f' = Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\f'
escape 'n' = Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\n'
escape 'r' = Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\r'
escape 't' = Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\t'
escape 'v' = Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\v'
escape '\\' = Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\\'
escape '"' = Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '"'
escape '\'' = Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\''
escape '^' = do Char
ctrl <- Parser Char Char
forall t. Parser t t
next
if Char
ctrl Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '@' Bool -> Bool -> Bool
&& Char
ctrl Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '_'
then Char -> Parser Char Char
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 '@'))
else String -> Parser Char Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("literal char ctrl-escape malformed: \\^"
String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
ctrl])
escape d :: Char
d | Char -> Bool
isDigit Char
d
= (Int -> Char) -> Parser Char Int -> Parser Char Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
chr (Parser Char Int -> Parser Char Char)
-> Parser Char Int -> Parser Char Char
forall a b. (a -> b) -> a -> b
$ (String -> Parser Char ()
forall t. [t] -> Parser t ()
reparse [Char
d] Parser Char () -> Parser Char Int -> Parser Char Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Char Int
forall a. Integral a => TextParser a
parseDec)
escape 'o' = (Int -> Char) -> Parser Char Int -> Parser Char Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
chr (Parser Char Int -> Parser Char Char)
-> Parser Char Int -> Parser Char Char
forall a b. (a -> b) -> a -> b
$ Parser Char Int
forall a. Integral a => TextParser a
parseOct
escape 'x' = (Int -> Char) -> Parser Char Int -> Parser Char Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
chr (Parser Char Int -> Parser Char Char)
-> Parser Char Int -> Parser Char Char
forall a b. (a -> b) -> a -> b
$ Parser Char Int
forall a. Integral a => TextParser a
parseHex
escape c :: Char
c | Char -> Bool
isUpper Char
c
= Char -> Parser Char Char
mnemonic Char
c
escape c :: Char
c = String -> Parser Char Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("unrecognised escape sequence in literal char: \\"String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
c])
mnemonic :: Char -> Parser Char Char
mnemonic 'A' = do Char
'C' <- Parser Char Char
forall t. Parser t t
next; Char
'K' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\ACK'
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "'\\ACK'"
mnemonic 'B' = do Char
'E' <- Parser Char Char
forall t. Parser t t
next; Char
'L' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\BEL'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'S' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\BS'
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "'\\BEL' or '\\BS'"
mnemonic 'C' = do Char
'R' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\CR'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'A' <- Parser Char Char
forall t. Parser t t
next; Char
'N' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\CAN'
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "'\\CR' or '\\CAN'"
mnemonic 'D' = do Char
'E' <- Parser Char Char
forall t. Parser t t
next; Char
'L' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\DEL'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'L' <- Parser Char Char
forall t. Parser t t
next; Char
'E' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\DLE'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'C' <- Parser Char Char
forall t. Parser t t
next; ( do Char
'1' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\DC1'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'2' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\DC2'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'3' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\DC3'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'4' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\DC4' )
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "'\\DEL' or '\\DLE' or '\\DC[1..4]'"
mnemonic 'E' = do Char
'T' <- Parser Char Char
forall t. Parser t t
next; Char
'X' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\ETX'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'O' <- Parser Char Char
forall t. Parser t t
next; Char
'T' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\EOT'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'N' <- Parser Char Char
forall t. Parser t t
next; Char
'Q' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\ENQ'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'T' <- Parser Char Char
forall t. Parser t t
next; Char
'B' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\ETB'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'M' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\EM'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'S' <- Parser Char Char
forall t. Parser t t
next; Char
'C' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\ESC'
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "one of '\\ETX' '\\EOT' '\\ENQ' '\\ETB' '\\EM' or '\\ESC'"
mnemonic 'F' = do Char
'F' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\FF'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'S' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\FS'
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "'\\FF' or '\\FS'"
mnemonic 'G' = do Char
'S' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\GS'
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "'\\GS'"
mnemonic 'H' = do Char
'T' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\HT'
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "'\\HT'"
mnemonic 'L' = do Char
'F' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\LF'
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "'\\LF'"
mnemonic 'N' = do Char
'U' <- Parser Char Char
forall t. Parser t t
next; Char
'L' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\NUL'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'A' <- Parser Char Char
forall t. Parser t t
next; Char
'K' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\NAK'
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "'\\NUL' or '\\NAK'"
mnemonic 'R' = do Char
'S' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\RS'
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "'\\RS'"
mnemonic 'S' = do Char
'O' <- Parser Char Char
forall t. Parser t t
next; Char
'H' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\SOH'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'O' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\SO'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'T' <- Parser Char Char
forall t. Parser t t
next; Char
'X' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\STX'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'I' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\SI'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'Y' <- Parser Char Char
forall t. Parser t t
next; Char
'N' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\SYN'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'U' <- Parser Char Char
forall t. Parser t t
next; Char
'B' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\SUB'
Parser Char Char -> Parser Char Char -> Parser Char Char
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
do Char
'P' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\SP'
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "'\\SOH' '\\SO' '\\STX' '\\SI' '\\SYN' '\\SUB' or '\\SP'"
mnemonic 'U' = do Char
'S' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\US'
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "'\\US'"
mnemonic 'V' = do Char
'T' <- Parser Char Char
forall t. Parser t t
next; Char -> Parser Char Char
forall (m :: * -> *) a. Monad m => a -> m a
return '\VT'
Parser Char Char -> String -> Parser Char Char
forall t a. Parser t a -> String -> Parser t a
`wrap` "'\\VT'"
wrap :: Parser t a -> String -> Parser t a
wrap p :: Parser t a
p s :: String
s = Parser t a
p Parser t a -> Parser t a -> Parser t a
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` String -> Parser t a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("expected literal char "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s)
instance Parse Int where
parse :: Parser Char Int
parse = (Integer -> Int) -> Parser Char Integer -> Parser Char Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Parser Char Integer -> Parser Char Int)
-> Parser Char Integer -> Parser Char Int
forall a b. (a -> b) -> a -> b
$
do Parser Char Char -> TextParser String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Parser Char Char
forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isSpace); Parser Char Integer -> Parser Char Integer
forall a. Real a => TextParser a -> TextParser a
parseSigned Parser Char Integer
forall a. Integral a => TextParser a
parseDec
instance Parse Integer where
parse :: Parser Char Integer
parse = do Parser Char Char -> TextParser String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Parser Char Char
forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isSpace); Parser Char Integer -> Parser Char Integer
forall a. Real a => TextParser a -> TextParser a
parseSigned Parser Char Integer
forall a. Integral a => TextParser a
parseDec
instance Parse Float where
parse :: TextParser Float
parse = do Parser Char Char -> TextParser String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Parser Char Char
forall t. (t -> Bool) -> Parser t t
satisfy 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 Parser Char Char -> TextParser String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Parser Char Char
forall t. (t -> Bool) -> Parser t t
satisfy 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 Char
parse = do Parser Char Char -> TextParser String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Parser Char Char
forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isSpace); Parser Char Char
parseLitChar'
parseList :: TextParser String
parseList = do { String
w <- TextParser String
word; if String -> Char
forall a. [a] -> a
head String
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '"' then String -> TextParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
forall a. [a] -> [a]
init (String -> String
forall a. [a] -> [a]
tail String
w))
else String -> TextParser String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "not a string" }
instance Parse Bool where
parse :: TextParser Bool
parse = String -> [Bool] -> TextParser Bool
forall a. Show a => String -> [a] -> TextParser a
enumeration "Bool" [Bool
False,Bool
True]
instance Parse Ordering where
parse :: TextParser Ordering
parse = String -> [Ordering] -> TextParser Ordering
forall a. Show a => String -> [a] -> TextParser a
enumeration "Ordering" [Ordering
LT,Ordering
EQ,Ordering
GT]
instance Parse () where
parse :: Parser Char ()
parse = (String -> Result String ()) -> Parser Char ()
forall t a. ([t] -> Result [t] a) -> Parser t a
P String -> Result String ()
p
where p :: String -> Result String ()
p [] = String -> String -> Result String ()
forall z a. z -> String -> Result z a
Failure [] "no input: expected a ()"
p ('(':cs :: String
cs) = case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
cs of
(')':s :: String
s) -> String -> () -> Result String ()
forall z a. z -> a -> Result z a
Success String
s ()
_ -> String -> String -> Result String ()
forall z a. z -> String -> Result z a
Failure String
cs "Expected ) after ("
p (c :: Char
c:cs :: String
cs) | Char -> Bool
isSpace Char
c = String -> Result String ()
p String
cs
| Bool
otherwise = String -> String -> Result String ()
forall z a. z -> String -> Result z a
Failure (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs) ("Expected a (), got "String -> String -> String
forall a. [a] -> [a] -> [a]
++Char -> String
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 "(" TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("Opening a 2-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; a
x <- TextParser a
forall a. Parse a => TextParser a
parse TextParser a -> (String -> String) -> TextParser a
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("In 1st item of a 2-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; String -> TextParser String
isWord "," TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("Separating a 2-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; b
y <- TextParser b
forall a. Parse a => TextParser a
parse TextParser b -> (String -> String) -> TextParser b
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("In 2nd item of a 2-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; String -> TextParser String
isWord ")" TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("Closing a 2-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; (a, b) -> TextParser (a, b)
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 "(" TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("Opening a 3-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; a
x <- TextParser a
forall a. Parse a => TextParser a
parse TextParser a -> (String -> String) -> TextParser a
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("In 1st item of a 3-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; String -> TextParser String
isWord "," TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("Separating(1) a 3-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; b
y <- TextParser b
forall a. Parse a => TextParser a
parse TextParser b -> (String -> String) -> TextParser b
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("In 2nd item of a 3-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; String -> TextParser String
isWord "," TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("Separating(2) a 3-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; c
z <- TextParser c
forall a. Parse a => TextParser a
parse TextParser c -> (String -> String) -> TextParser c
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("In 3rd item of a 3-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; String -> TextParser String
isWord ")" TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` ("Closing a 3-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; (a, b, c) -> TextParser (a, b, c)
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 p :: Int
p =
TextParser (Maybe a) -> TextParser (Maybe a)
forall a. TextParser a -> TextParser a
optionalParens (do { String -> TextParser String
isWord "Nothing"; Maybe a -> TextParser (Maybe 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 t a. Parser t a -> Parser t a -> Parser t 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
>9) (do { String -> TextParser String
isWord "Just"
; (a -> Maybe a) -> Parser Char a -> TextParser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Parser Char a -> TextParser (Maybe a))
-> Parser Char a -> TextParser (Maybe a)
forall a b. (a -> b) -> a -> b
$ Int -> Parser Char a
forall a. Parse a => Int -> TextParser a
parsePrec 10
Parser Char a -> (String -> String) -> Parser Char a
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` ("but within Just, "String -> String -> String
forall a. [a] -> [a] -> [a]
++) })
TextParser (Maybe a) -> (String -> String) -> TextParser (Maybe a)
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (("expected a Maybe (Just or Nothing)\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> String -> String
indent 2)
instance (Parse a, Parse b) => Parse (Either a b) where
parsePrec :: Int -> TextParser (Either a b)
parsePrec p :: 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
>9) (TextParser (Either a b) -> TextParser (Either a b))
-> TextParser (Either a b) -> TextParser (Either a b)
forall a b. (a -> b) -> a -> b
$
[(String, TextParser (Either a b))] -> TextParser (Either a b)
forall a. [(String, TextParser a)] -> TextParser a
constructors [ ("Left", do { (a -> Either a b) -> Parser Char a -> TextParser (Either a 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 Char a -> TextParser (Either a b))
-> Parser Char a -> TextParser (Either a b)
forall a b. (a -> b) -> a -> b
$ Int -> Parser Char a
forall a. Parse a => Int -> TextParser a
parsePrec 10 } )
, ("Right", do { (b -> Either a b) -> Parser Char b -> TextParser (Either a 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 Char b -> TextParser (Either a b))
-> Parser Char b -> TextParser (Either a b)
forall a b. (a -> b) -> a -> b
$ Int -> Parser Char b
forall a. Parse a => Int -> TextParser a
parsePrec 10 } )
]
instance Parse a => Parse [a] where
parse :: TextParser [a]
parse = TextParser [a]
forall a. Parse a => TextParser [a]
parseList
allAsString :: TextParser String
allAsString :: TextParser String
allAsString = (String -> Result String String) -> TextParser String
forall t a. ([t] -> Result [t] a) -> Parser t a
P (\s :: String
s-> String -> String -> Result String String
forall z a. z -> a -> Result z a
Success [] String
s)