module Text.Parse.ByteString
(
TextParser
, Parse(..)
, parseByRead
, readByParse
, readsPrecByParsePrec
, word
, isWord
, literal
, optionalParens
, parens
, field
, constructors
, enumeration
, parseSigned
, parseInt
, parseDec
, parseOct
, parseHex
, parseUnsignedInteger
, parseFloat
, parseLitChar
, parseLitChar'
, module Text.ParserCombinators.Poly.ByteStringChar
, 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
type TextParser a = Parser a
class Parse a where
parse :: TextParser a
parse = Int -> TextParser a
forall a. Parse a => Int -> TextParser a
parsePrec Int
0
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
parseList :: TextParser [a]
parseList = do { String -> TextParser String
isWord String
"[]"; [a] -> TextParser [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 { String -> TextParser String
isWord String
"["; String -> TextParser String
isWord String
"]"; [a] -> TextParser [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 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
"[") (String -> TextParser String
isWord String
",") (String -> TextParser String
isWord String
"]")
(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` (String
"Expected a list, but\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
parseByRead :: Read a => String -> TextParser a
parseByRead :: String -> TextParser a
parseByRead String
name =
(ByteString -> Result ByteString a) -> TextParser a
forall a. (ByteString -> Result ByteString a) -> Parser a
P (\ByteString
s-> case ReadS a
forall a. Read a => ReadS a
reads (ByteString -> String
BS.unpack ByteString
s) of
[] -> ByteString -> String -> Result ByteString a
forall z a. z -> String -> Result z a
Failure ByteString
s (String
"no parse, expected a "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name)
[(a
a,String
s')] -> ByteString -> a -> Result ByteString a
forall z a. z -> a -> Result z a
Success (String -> ByteString
BS.pack String
s') a
a
[(a, String)]
_ -> ByteString -> String -> Result ByteString a
forall z a. z -> String -> Result z a
Failure ByteString
s (String
"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 TextParser a
p = \String
inp->
case TextParser a -> ByteString -> (Either String a, ByteString)
forall a. Parser a -> ByteString -> (Either String a, ByteString)
runParser TextParser a
p (String -> ByteString
BS.pack String
inp) of
(Left String
err, ByteString
rest) -> []
(Right a
val, ByteString
rest) -> [(a
val, ByteString -> String
BS.unpack ByteString
rest)]
readsPrecByParsePrec :: (Int -> TextParser a) -> Int -> ReadS a
readsPrecByParsePrec :: (Int -> TextParser a) -> Int -> ReadS a
readsPrecByParsePrec Int -> TextParser a
p = \Int
prec String
inp->
case TextParser a -> ByteString -> (Either String a, ByteString)
forall a. Parser a -> ByteString -> (Either String a, ByteString)
runParser (Int -> TextParser a
p Int
prec) (String -> ByteString
BS.pack String
inp) of
(Left String
err, ByteString
rest) -> []
(Right a
val, ByteString
rest) -> [(a
val, ByteString -> String
BS.unpack ByteString
rest)]
word :: TextParser String
word :: TextParser String
word = (ByteString -> Result ByteString String) -> TextParser String
forall a. (ByteString -> Result ByteString a) -> Parser a
P (ByteString -> Result ByteString String
p (ByteString -> Result ByteString String)
-> (ByteString -> ByteString)
-> ByteString
-> Result ByteString String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile Char -> Bool
isSpace)
where
p :: ByteString -> Result ByteString String
p ByteString
s | ByteString -> Bool
BS.null ByteString
s = ByteString -> String -> Result ByteString String
forall z a. z -> String -> Result z a
Failure ByteString
BS.empty String
"end of input"
| Bool
otherwise =
case (ByteString -> Char
BS.head ByteString
s, ByteString -> ByteString
BS.tail ByteString
s) of
(Char
'\'',ByteString
t) -> let (P ByteString -> Result ByteString Char
lit) = Parser Char
parseLitChar' in (Char -> String)
-> Result ByteString Char -> Result ByteString String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> String
forall a. Show a => a -> String
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 -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\\\"")) ByteString
t
in String -> ByteString -> Result ByteString String
litString (Char
'\"'Char -> String -> String
forall a. a -> [a] -> [a]
: ByteString -> String
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 -> String -> Result ByteString String
forall z a. z -> a -> Result z a
Success ByteString
t (String
"0x"String -> String -> String
forall a. [a] -> [a] -> [a]
++ByteString -> String
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 -> String -> Result ByteString String
forall z a. z -> a -> Result z a
Success ByteString
t (String
"0X"String -> String -> String
forall a. [a] -> [a] -> [a]
++ByteString -> String
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 -> String -> Result ByteString String
forall z a. z -> a -> Result z a
Success ByteString
t (String
"0o"String -> String -> String
forall a. [a] -> [a] -> [a]
++ByteString -> String
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 -> String -> Result ByteString String
forall z a. z -> a -> Result z a
Success ByteString
t (String
"0O"String -> String -> String
forall a. [a] -> [a] -> [a]
++ByteString -> String
BS.unpack ByteString
ds)
where (ByteString
ds,ByteString
t) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
isOctDigit ByteString
r
Maybe (Char, ByteString)
_ -> String -> ByteString -> Result ByteString String
lexFracExp (Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
: ByteString -> String
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 -> String -> Result ByteString String
forall z a. z -> a -> Result z a
Success ByteString
t (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
: ByteString -> String
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
String -> ByteString -> Result ByteString String
lexFracExp (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
: ByteString -> String
BS.unpack ByteString
ds) ByteString
t
| Char -> Bool
isSingle Char
c -> ByteString -> String -> Result ByteString String
forall z a. z -> a -> Result z a
Success ByteString
s (Char
cChar -> String -> String
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 -> String -> Result ByteString String
forall z a. z -> a -> Result z a
Success ByteString
t (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
: ByteString -> String
BS.unpack ByteString
sym)
| Bool
otherwise -> ByteString -> String -> Result ByteString String
forall z a. z -> String -> Result z a
Failure (Char -> ByteString -> ByteString
BS.cons Char
c ByteString
s) (String
"Bad character: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Char -> String
forall a. Show a => a -> String
show Char
c)
isSingle :: Char -> Bool
isSingle Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
",;()[]{}`"
isSym :: Char -> Bool
isSym Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"!@#$%&*+./<=>?\\^|:-~"
isIdInit :: Char -> Bool
isIdInit Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c 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 -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"_'"
lexFracExp :: String -> ByteString -> Result ByteString String
lexFracExp String
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
String -> ByteString -> Result ByteString String
lexExp (String
accString -> String -> String
forall a. [a] -> [a] -> [a]
++Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
dChar -> String -> String
forall a. a -> [a] -> [a]
: ByteString -> String
BS.unpack ByteString
ds) ByteString
t
Maybe (Char, ByteString)
_ -> String -> ByteString -> Result ByteString String
lexExp String
acc ByteString
s'
Maybe (Char, ByteString)
_ -> String -> ByteString -> Result ByteString String
lexExp String
acc ByteString
s
lexExp :: String -> ByteString -> Result ByteString String
lexExp String
acc ByteString
s = case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
s of
Just (Char
e,ByteString
s') | Char
e Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"eE" ->
case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
s' of
Just (Char
sign,ByteString
dt)
| Char
sign Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"+-" ->
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 -> String -> Result ByteString String
forall z a. z -> a -> Result z a
Success ByteString
u (String
accString -> String -> String
forall a. [a] -> [a] -> [a]
++Char
'e'Char -> String -> String
forall a. a -> [a] -> [a]
: Char
signChar -> String -> String
forall a. a -> [a] -> [a]
: Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:
ByteString -> String
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 -> String -> Result ByteString String
forall z a. z -> a -> Result z a
Success ByteString
u (String
accString -> String -> String
forall a. [a] -> [a] -> [a]
++Char
'e'Char -> String -> String
forall a. a -> [a] -> [a]
: Char
signChar -> String -> String
forall a. a -> [a] -> [a]
: ByteString -> String
BS.unpack ByteString
ds)
Maybe (Char, ByteString)
_ -> ByteString -> String -> Result ByteString String
forall z a. z -> String -> Result z a
Failure ByteString
s' (String
"missing +/-/digit "
String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"after e in float 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]
++Char
'e'Char -> String -> String
forall a. a -> [a] -> [a]
:String
"..."))
Maybe (Char, ByteString)
_ -> ByteString -> String -> Result ByteString String
forall z a. z -> a -> Result z a
Success ByteString
s String
acc
litString :: String -> ByteString -> Result ByteString String
litString String
acc ByteString
s = case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
s of
Maybe (Char, ByteString)
Nothing -> ByteString -> String -> Result ByteString String
forall z a. z -> String -> Result z a
Failure (ByteString
BS.empty)
(String
"end of input in string literal "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
acc)
Just (Char
'\"',ByteString
r) -> ByteString -> String -> Result ByteString String
forall z a. z -> a -> Result z a
Success ByteString
r (String
accString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\"")
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 String
b -> ByteString -> String -> Result ByteString String
forall z a. z -> String -> Result z a
Failure ByteString
a String
b
Success ByteString
t Char
char ->
let (ByteString
u,ByteString
v) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`String
"\\\"") ByteString
t
in String -> ByteString -> Result ByteString String
litString (String
accString -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
char]String -> String -> String
forall a. [a] -> [a] -> [a]
++ByteString -> String
BS.unpack ByteString
u) ByteString
v
Just (Char
_,ByteString
r) -> String -> Result ByteString String
forall a. HasCallStack => String -> a
error String
"Text.Parse.word(litString) - can't happen"
isWord :: String -> TextParser String
isWord :: String -> TextParser String
isWord 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 (String
"expected "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
wString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" got "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
w')
}
literal :: String -> TextParser String
literal :: String -> TextParser String
literal String
w = do { String
w' <- Int -> Parser Char -> TextParser String
forall (p :: * -> *) a. PolyParse p => Int -> p a -> p [a]
exactly (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w) Parser Char
next
; 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 (String
"expected "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
wString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" got "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
w')
}
optionalParens :: TextParser a -> TextParser a
optionalParens :: 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
parens :: Bool -> TextParser a -> TextParser a
parens :: Bool -> TextParser a -> TextParser a
parens Bool
True 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
"(") (String -> TextParser String
isWord String
")") (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
field :: Parse a => String -> TextParser a
field :: String -> TextParser a
field 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 String
"="; TextParser a
forall a. Parse a => TextParser a
parse } }
constructors :: [(String,TextParser a)] -> TextParser a
constructors :: [(String, TextParser a)] -> TextParser a
constructors [(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 b) -> (String, Parser b)
cons [(String, TextParser a)]
cs)
where cons :: (String, Parser b) -> (String, Parser b)
cons (String
name,Parser b
p) =
( String
name
, do { String -> TextParser String
isWord String
name
; Parser b
p Parser b -> (String -> String) -> Parser b
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` ((String
"got constructor, but within "
String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
",\n")String -> String -> String
forall a. [a] -> [a] -> [a]
++)
}
)
enumeration :: (Show a) => String -> [a] -> TextParser a
enumeration :: String -> [a] -> TextParser a
enumeration String
typ [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 (\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]
++(String
"\n expected "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
typString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" value ("String -> String -> String
forall a. [a] -> [a] -> [a]
++String
eString -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"))
where e :: String
e = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
", " ((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]
++ String
", 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 TextParser a
p = do Char
'-' <- Parser Char
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 a. Parser a -> Parser a -> Parser 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 String
base a
radix Char -> Bool
isDigit Char -> Int
digitToInt =
do String
cs <- Parser Char -> TextParser String
forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 ((Char -> Bool) -> Parser Char
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 (\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) -> 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]
++(String
"\nexpected one or more "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
baseString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" 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 String
"decimal" a
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 String
"octal" a
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 String
"hex" a
16 Char -> Bool
Char.isHexDigit Char -> Int
Char.digitToInt
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 -> String -> Result ByteString Integer
forall a. HasCallStack => String -> a
error String
"XXX Can't happen"
Maybe (Char, ByteString)
_ -> ByteString -> String -> Result ByteString Integer
forall z a. z -> String -> Result z a
Failure ByteString
bs String
"parsing Integer: not a digit")
TextParser Integer -> (String -> String) -> TextParser Integer
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String -> String -> String
forall a. [a] -> [a] -> [a]
++(String
"\nexpected one or more decimal digits"))
parseFloat :: (RealFrac a) => TextParser a
parseFloat :: 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 -> (String -> String) -> Parser ByteString
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"expected digit after .")
Parser ByteString -> Parser ByteString -> Parser ByteString
forall a. Parser a -> Parser a -> Parser a
`onFail` ByteString -> Parser ByteString
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 (m :: * -> *) a. Monad m => a -> m a
return Int64
0
( a -> TextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> TextParser a)
-> (ByteString -> a) -> ByteString -> TextParser 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 String Integer -> Integer)
-> (ByteString -> Either String Integer) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String Integer, ByteString) -> Either String Integer
forall a b. (a, b) -> a
fst
((Either String Integer, ByteString) -> Either String Integer)
-> (ByteString -> (Either String Integer, ByteString))
-> ByteString
-> Either String Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextParser Integer
-> ByteString -> (Either String Integer, ByteString)
forall a. Parser a -> ByteString -> (Either String a, ByteString)
runParser TextParser Integer
forall a. Integral a => TextParser a
parseDec ) (ByteString
ds ByteString -> ByteString -> ByteString
`BS.append` ByteString
frac)
TextParser a -> TextParser a -> TextParser a
forall a. Parser a -> Parser a -> Parser a
`onFail`
do ByteString
w <- (Char -> Bool) -> Parser ByteString
manySatisfy Char -> Bool
isAlpha
case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (ByteString -> String
BS.unpack ByteString
w) of
String
"nan" -> a -> TextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
0a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0)
String
"infinity" -> a -> TextParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0)
String
_ -> String -> TextParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected a floating point number"
where exponent :: Parser Int64
exponent = do Char
'e' <- (Char -> Char) -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower Parser Char
next
Parser Int64 -> Parser Int64
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 )
parseLitChar' :: TextParser Char
parseLitChar' :: Parser Char
parseLitChar' = do Char
'\'' <- Parser Char
next Parser Char -> (String -> String) -> Parser Char
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"expected a literal char")
Char
char <- Parser Char
parseLitChar
Char
'\'' <- Parser Char
next Parser Char -> (String -> String) -> Parser Char
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"literal char has no final '")
Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
char
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Parser Char
escape
Char
'\'' -> String -> Parser Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected a literal char, got ''"
Char
_ -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
char
where
escape :: Char -> Parser Char
escape Char
'a' = Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\a'
escape Char
'b' = Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\b'
escape Char
'f' = Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f'
escape Char
'n' = Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'
escape Char
'r' = Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r'
escape Char
't' = Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t'
escape Char
'v' = Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\v'
escape Char
'\\' = Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\\'
escape Char
'"' = Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'"'
escape Char
'\'' = Char -> Parser Char
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 (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 String -> Parser Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"literal char ctrl-escape malformed: \\^"
String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
ctrl])
escape Char
d | Char -> Bool
isDigit Char
d
= (Int -> Char) -> Parser Int -> Parser Char
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 (String -> ByteString
BS.pack [Char
d]) Parser () -> Parser Int -> Parser Int
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 (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 (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 = String -> Parser Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unrecognised escape sequence in literal char: \\"String -> String -> String
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 (m :: * -> *) a. Monad m => a -> m a
return Char
'\ACK'
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"'\\ACK'"
mnemonic Char
'B' = do Char
'E' <- Parser Char
next; Char
'L' <- Parser Char
next; Char -> Parser Char
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 (m :: * -> *) a. Monad m => a -> m a
return Char
'\BS'
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"'\\BEL' or '\\BS'"
mnemonic Char
'C' = do Char
'R' <- Parser Char
next; Char -> Parser Char
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 (m :: * -> *) a. Monad m => a -> m a
return Char
'\CAN'
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"'\\CR' or '\\CAN'"
mnemonic Char
'D' = do Char
'E' <- Parser Char
next; Char
'L' <- Parser Char
next; Char -> Parser Char
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 (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 (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC4' )
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"'\\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 (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 (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 (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Char
'\ESC'
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"one of '\\ETX' '\\EOT' '\\ENQ' '\\ETB' '\\EM' or '\\ESC'"
mnemonic Char
'F' = do Char
'F' <- Parser Char
next; Char -> Parser Char
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 (m :: * -> *) a. Monad m => a -> m a
return Char
'\FS'
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"'\\FF' or '\\FS'"
mnemonic Char
'G' = do Char
'S' <- Parser Char
next; Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\GS'
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"'\\GS'"
mnemonic Char
'H' = do Char
'T' <- Parser Char
next; Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\HT'
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"'\\HT'"
mnemonic Char
'L' = do Char
'F' <- Parser Char
next; Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\LF'
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"'\\LF'"
mnemonic Char
'N' = do Char
'U' <- Parser Char
next; Char
'L' <- Parser Char
next; Char -> Parser Char
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 (m :: * -> *) a. Monad m => a -> m a
return Char
'\NAK'
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"'\\NUL' or '\\NAK'"
mnemonic Char
'R' = do Char
'S' <- Parser Char
next; Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\RS'
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"'\\RS'"
mnemonic Char
'S' = do Char
'O' <- Parser Char
next; Char
'H' <- Parser Char
next; Char -> Parser Char
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 (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 (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 (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Char
'\SP'
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"'\\SOH' '\\SO' '\\STX' '\\SI' '\\SYN' '\\SUB' or '\\SP'"
mnemonic Char
'U' = do Char
'S' <- Parser Char
next; Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\US'
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"'\\US'"
mnemonic Char
'V' = do Char
'T' <- Parser Char
next; Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\VT'
Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
`wrap` String
"'\\VT'"
wrap :: Parser a -> String -> Parser a
wrap Parser a
p String
s = Parser a
p Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
`onFail` String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expected literal char "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s)
instance Parse Int where
parse :: Parser Int
parse = (Integer -> Int) -> TextParser Integer -> Parser Int
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
$
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'
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
== Char
'"' 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 String
"not a string" }
instance Parse Bool where
parse :: TextParser Bool
parse = String -> [Bool] -> TextParser Bool
forall a. Show a => String -> [a] -> TextParser a
enumeration String
"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 String
"Ordering" [Ordering
LT,Ordering
EQ,Ordering
GT]
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 -> String -> Result ByteString ()
forall z a. z -> String -> Result z a
Failure ByteString
BS.empty String
"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 -> String -> Result ByteString ()
forall z a. z -> String -> Result z a
Failure ByteString
cs String
"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 -> String -> Result ByteString ()
forall z a. z -> String -> Result z a
Failure (Char -> ByteString -> ByteString
BS.cons Char
c ByteString
cs)
(String
"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 String
"(" TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"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` (String
"In 1st item of a 2-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; String -> TextParser String
isWord String
"," TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"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` (String
"In 2nd item of a 2-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; String -> TextParser String
isWord String
")" TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"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 String
"(" TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"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` (String
"In 1st item of a 3-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; String -> TextParser String
isWord String
"," TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"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` (String
"In 2nd item of a 3-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; String -> TextParser String
isWord String
"," TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"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` (String
"In 3rd item of a 3-tuple\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
; String -> TextParser String
isWord String
")" TextParser String -> (String -> String) -> TextParser String
forall (p :: * -> *) a.
Commitment p =>
p a -> (String -> String) -> p a
`adjustErr` (String
"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 Int
p =
TextParser (Maybe a) -> TextParser (Maybe a)
forall a. TextParser a -> TextParser a
optionalParens (do { String -> TextParser String
isWord String
"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 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 { String -> TextParser String
isWord String
"Just"
; (a -> Maybe a) -> Parser 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 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 -> (String -> String) -> Parser a
forall (p :: * -> *) a.
PolyParse p =>
p a -> (String -> String) -> p a
`adjustErrBad` (String
"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` ((String
"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 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
$
[(String, TextParser (Either a b))] -> TextParser (Either a b)
forall a. [(String, TextParser a)] -> TextParser a
constructors [ (String
"Left", do { (a -> Either a b) -> Parser 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 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 } )
, (String
"Right", do { (b -> Either a b) -> Parser 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 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
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)
allAsString :: TextParser String
allAsString :: TextParser String
allAsString = (ByteString -> String) -> Parser ByteString -> TextParser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
BS.unpack Parser ByteString
allAsByteString