module Text.JSON5.String
(
GetJSON
, runGetJSON
, readJSNull
, readJSBool
, readJSString
, readJSRational
, readJSInfNaN
, readJSArray
, readJSObject
, readJSValue
, readJSTopType
, showJSNull
, showJSBool
, showJSArray
, showJSObject
, showJSRational
, showJSInfNaN
, showJSValue
, showJSTopType
) where
import Text.JSON5.Types (JSValue(..),
JSNumber(..), fromJSInfNaN, fromJSRational,
JSString, toJSString, fromJSString,
JSObject, toJSObject, fromJSObject)
import Control.Monad (liftM, ap)
import Control.Applicative((<$>))
import qualified Control.Applicative as A
import Data.Char (isSpace, isDigit, isAlpha, isAlphaNum, digitToInt)
import Data.Ratio (numerator, denominator, (%))
import Numeric (readHex, readDec, showHex)
newtype GetJSON a = GetJSON { GetJSON a -> String -> Either String (a, String)
un :: String -> Either String (a,String) }
instance Functor GetJSON where
fmap :: (a -> b) -> GetJSON a -> GetJSON b
fmap = (a -> b) -> GetJSON a -> GetJSON b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance A.Applicative GetJSON where
pure :: a -> GetJSON a
pure = a -> GetJSON a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: GetJSON (a -> b) -> GetJSON a -> GetJSON b
(<*>) = GetJSON (a -> b) -> GetJSON a -> GetJSON b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad GetJSON where
return :: a -> GetJSON a
return a
x = (String -> Either String (a, String)) -> GetJSON a
forall a. (String -> Either String (a, String)) -> GetJSON a
GetJSON (\String
s -> (a, String) -> Either String (a, String)
forall a b. b -> Either a b
Right (a
x,String
s))
GetJSON String -> Either String (a, String)
m >>= :: GetJSON a -> (a -> GetJSON b) -> GetJSON b
>>= a -> GetJSON b
f = (String -> Either String (b, String)) -> GetJSON b
forall a. (String -> Either String (a, String)) -> GetJSON a
GetJSON (\String
s -> case String -> Either String (a, String)
m String
s of
Left String
err -> String -> Either String (b, String)
forall a b. a -> Either a b
Left String
err
Right (a
a,String
s1) -> GetJSON b -> String -> Either String (b, String)
forall a. GetJSON a -> String -> Either String (a, String)
un (a -> GetJSON b
f a
a) String
s1)
instance MonadFail GetJSON where
fail :: String -> GetJSON a
fail String
x = (String -> Either String (a, String)) -> GetJSON a
forall a. (String -> Either String (a, String)) -> GetJSON a
GetJSON (\String
_ -> String -> Either String (a, String)
forall a b. a -> Either a b
Left String
x)
runGetJSON :: GetJSON a -> String -> Either String a
runGetJSON :: GetJSON a -> String -> Either String a
runGetJSON (GetJSON String -> Either String (a, String)
m) String
s = case String -> Either String (a, String)
m String
s of
Left String
err -> String -> Either String a
forall a b. a -> Either a b
Left String
err
Right (a
a,String
t) -> case String
t of
[] -> a -> Either String a
forall a b. b -> Either a b
Right a
a
String
_ -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Invalid tokens at end of JSON5 string: "String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
t
getInput :: GetJSON String
getInput :: GetJSON String
getInput = (String -> Either String (String, String)) -> GetJSON String
forall a. (String -> Either String (a, String)) -> GetJSON a
GetJSON (\String
s -> (String, String) -> Either String (String, String)
forall a b. b -> Either a b
Right (String
s,String
s))
setInput :: String -> GetJSON ()
setInput :: String -> GetJSON ()
setInput String
s = (String -> Either String ((), String)) -> GetJSON ()
forall a. (String -> Either String (a, String)) -> GetJSON a
GetJSON (\String
_ -> ((), String) -> Either String ((), String)
forall a b. b -> Either a b
Right ((),String
s))
context :: String -> String
context :: String -> String
context String
s = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
8 String
s
readJSNull :: GetJSON JSValue
readJSNull :: GetJSON JSValue
readJSNull = do
String
xs <- GetJSON String
getInput
case String
xs of
Char
'n':Char
'u':Char
'l':Char
'l':String
xs1 -> String -> GetJSON ()
setInput String
xs1 GetJSON () -> GetJSON JSValue -> GetJSON JSValue
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JSValue -> GetJSON JSValue
forall (m :: * -> *) a. Monad m => a -> m a
return JSValue
JSNull
String
_ -> String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON JSValue) -> String -> GetJSON JSValue
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 null: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
xs
tryJSNull :: GetJSON JSValue -> GetJSON JSValue
tryJSNull :: GetJSON JSValue -> GetJSON JSValue
tryJSNull GetJSON JSValue
k = do
String
xs <- GetJSON String
getInput
case String
xs of
Char
'n':Char
'u':Char
'l':Char
'l':String
xs1 -> String -> GetJSON ()
setInput String
xs1 GetJSON () -> GetJSON JSValue -> GetJSON JSValue
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JSValue -> GetJSON JSValue
forall (m :: * -> *) a. Monad m => a -> m a
return JSValue
JSNull
String
_ -> GetJSON JSValue
k
readJSBool :: GetJSON JSValue
readJSBool :: GetJSON JSValue
readJSBool = do
String
xs <- GetJSON String
getInput
case String
xs of
Char
't':Char
'r':Char
'u':Char
'e':String
xs1 -> String -> GetJSON ()
setInput String
xs1 GetJSON () -> GetJSON JSValue -> GetJSON JSValue
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JSValue -> GetJSON JSValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> JSValue
JSBool Bool
True)
Char
'f':Char
'a':Char
'l':Char
's':Char
'e':String
xs1 -> String -> GetJSON ()
setInput String
xs1 GetJSON () -> GetJSON JSValue -> GetJSON JSValue
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JSValue -> GetJSON JSValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> JSValue
JSBool Bool
False)
String
_ -> String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON JSValue) -> String -> GetJSON JSValue
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 Bool: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
xs
readJSString :: Char -> GetJSON JSValue
readJSString :: Char -> GetJSON JSValue
readJSString Char
sep = do
String
x <- GetJSON String
getInput
case String
x of
Char
sep : String
cs -> String -> String -> GetJSON JSValue
parse [] String
cs
String
_ -> String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON JSValue) -> String -> GetJSON JSValue
forall a b. (a -> b) -> a -> b
$ String
"Malformed JSON5: expecting string: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
x
where
parse :: String -> String -> GetJSON JSValue
parse String
rs String
cs =
case String
cs of
Char
'\\': Char
c : String
ds -> String -> Char -> String -> GetJSON JSValue
esc String
rs Char
c String
ds
Char
c : String
ds
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
sep -> do String -> GetJSON ()
setInput String
ds
JSValue -> GetJSON JSValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JSString -> JSValue
JSString (String -> JSString
toJSString (String -> String
forall a. [a] -> [a]
reverse String
rs)))
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x20' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xff' -> String -> String -> GetJSON JSValue
parse (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
rs) String
ds
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x20' -> String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON JSValue) -> String -> GetJSON JSValue
forall a b. (a -> b) -> a -> b
$ String
"Illegal unescaped character in string: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
cs
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0x10ffff -> String -> String -> GetJSON JSValue
parse (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
rs) String
ds
| Bool
otherwise -> String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON JSValue) -> String -> GetJSON JSValue
forall a b. (a -> b) -> a -> b
$ String
"Illegal unescaped character in string: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
cs
where
i :: Integer
i = (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) :: Integer)
String
_ -> String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON JSValue) -> String -> GetJSON JSValue
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 String: unterminated String: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
cs
esc :: String -> Char -> String -> GetJSON JSValue
esc String
rs Char
c String
cs = case Char
c of
Char
'\n' -> String -> String -> GetJSON JSValue
parse String
rs String
cs
Char
'\\' -> String -> String -> GetJSON JSValue
parse (Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rs) String
cs
Char
'"' -> String -> String -> GetJSON JSValue
parse (Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rs) String
cs
Char
'\'' -> String -> String -> GetJSON JSValue
parse (Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rs) String
cs
Char
'n' -> String -> String -> GetJSON JSValue
parse (Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rs) String
cs
Char
'r' -> String -> String -> GetJSON JSValue
parse (Char
'\r' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rs) String
cs
Char
't' -> String -> String -> GetJSON JSValue
parse (Char
'\t' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rs) String
cs
Char
'f' -> String -> String -> GetJSON JSValue
parse (Char
'\f' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rs) String
cs
Char
'b' -> String -> String -> GetJSON JSValue
parse (Char
'\b' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rs) String
cs
Char
'/' -> String -> String -> GetJSON JSValue
parse (Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rs) String
cs
Char
'u' -> case String
cs of
Char
d1 : Char
d2 : Char
d3 : Char
d4 : String
cs' ->
case ReadS Int
forall a. (Eq a, Num a) => ReadS a
readHex [Char
d1,Char
d2,Char
d3,Char
d4] of
[(Int
n,String
"")] -> String -> String -> GetJSON JSValue
parse (Int -> Char
forall a. Enum a => Int -> a
toEnum Int
n Char -> String -> String
forall a. a -> [a] -> [a]
: String
rs) String
cs'
[(Int, String)]
x -> String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON JSValue) -> String -> GetJSON JSValue
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 String: invalid hex: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context ([(Int, String)] -> String
forall a. Show a => a -> String
show [(Int, String)]
x)
String
_ -> String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON JSValue) -> String -> GetJSON JSValue
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 String: invalid hex: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
cs
Char
_ -> String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON JSValue) -> String -> GetJSON JSValue
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 String: invalid escape char: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c
readJSRational :: GetJSON Rational
readJSRational :: GetJSON Rational
readJSRational = do
String
cs <- GetJSON String
getInput
case String
cs of
Char
'-' : String
ds -> Rational -> Rational
forall a. Num a => a -> a
negate (Rational -> Rational) -> GetJSON Rational -> GetJSON Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> GetJSON Rational
pos String
ds
Char
'+' : String
ds -> String -> GetJSON Rational
pos String
ds
Char
'.' : String
_ -> Rational -> String -> GetJSON Rational
frac Rational
0 String
cs
String
_ -> String -> GetJSON Rational
pos String
cs
where
pos :: String -> GetJSON Rational
pos [] = String -> GetJSON Rational
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON Rational) -> String -> GetJSON Rational
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 Rational: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context []
pos String
cs =
case String
cs of
Char
'.':String
ds -> Rational -> String -> GetJSON Rational
frac Rational
0 String
cs
Char
'0':Char
'x':String
ds -> String -> GetJSON Rational
forall b. Num b => String -> GetJSON b
hex String
ds
Char
c : String
ds
| Char -> Bool
isDigit Char
c -> Integer -> String -> GetJSON Rational
readDigits (Char -> Integer
digitToIntI Char
c) String
ds
| Bool
otherwise -> String -> GetJSON Rational
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON Rational) -> String -> GetJSON Rational
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 Rational: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
cs
readDigits :: Integer -> String -> GetJSON Rational
readDigits Integer
acc [] = Rational -> String -> GetJSON Rational
frac (Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
acc) []
readDigits Integer
acc (Char
x:String
xs)
| Char -> Bool
isDigit Char
x = let acc' :: Integer
acc' = Integer
10Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Char -> Integer
digitToIntI Char
x in
Integer
acc' Integer -> GetJSON Rational -> GetJSON Rational
`seq` Integer -> String -> GetJSON Rational
readDigits Integer
acc' String
xs
| Bool
otherwise = Rational -> String -> GetJSON Rational
frac (Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
acc) (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
hex :: String -> GetJSON b
hex String
cs = case ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readHex String
cs of
[(Integer
a,String
ds)] -> do String -> GetJSON ()
setInput String
ds
b -> GetJSON b
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a)
[(Integer, String)]
_ -> String -> GetJSON b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON b) -> String -> GetJSON b
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 hexadecimal: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
cs
frac :: Rational -> String -> GetJSON Rational
frac Rational
n (Char
'.' : String
ds) =
case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
ds of
([],String
_) -> String -> GetJSON ()
setInput String
ds GetJSON () -> GetJSON Rational -> GetJSON Rational
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rational -> GetJSON Rational
forall (m :: * -> *) a. Monad m => a -> m a
return Rational
n
(String
as,String
bs) -> let x :: Integer
x = String -> Integer
forall a. Read a => String -> a
read String
as :: Integer
y :: Integer
y = Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
as) :: Integer)
in Rational -> String -> GetJSON Rational
exponent' (Rational
n Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Integer
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
y)) String
bs
frac Rational
n String
cs = Rational -> String -> GetJSON Rational
exponent' Rational
n String
cs
exponent' :: Rational -> String -> GetJSON Rational
exponent' Rational
n (Char
c:String
cs)
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'E' = (Rational
nRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*) (Rational -> Rational) -> GetJSON Rational -> GetJSON Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> GetJSON Rational
exp_num String
cs
exponent' Rational
n String
cs = String -> GetJSON ()
setInput String
cs GetJSON () -> GetJSON Rational -> GetJSON Rational
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rational -> GetJSON Rational
forall (m :: * -> *) a. Monad m => a -> m a
return Rational
n
exp_num :: String -> GetJSON Rational
exp_num :: String -> GetJSON Rational
exp_num (Char
'+':String
cs) = String -> GetJSON Rational
exp_digs String
cs
exp_num (Char
'-':String
cs) = Rational -> Rational
forall a. Fractional a => a -> a
recip (Rational -> Rational) -> GetJSON Rational -> GetJSON Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> GetJSON Rational
exp_digs String
cs
exp_num String
cs = String -> GetJSON Rational
exp_digs String
cs
exp_digs :: String -> GetJSON Rational
exp_digs :: String -> GetJSON Rational
exp_digs String
cs = case ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readDec String
cs of
[(Integer
a,String
ds)] -> do String -> GetJSON ()
setInput String
ds
Rational -> GetJSON Rational
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Integer
10::Integer) Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
a::Integer)))
[(Integer, String)]
_ -> String -> GetJSON Rational
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON Rational) -> String -> GetJSON Rational
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 exponential: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
cs
digitToIntI :: Char -> Integer
digitToIntI :: Char -> Integer
digitToIntI = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> (Char -> Int) -> Char -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt
readJSInfNaN :: GetJSON Float
readJSInfNaN :: GetJSON Float
readJSInfNaN = do
String
cs <- GetJSON String
getInput
case String
cs of
Char
'-' : String
ds -> Float -> Float
forall a. Num a => a -> a
negate (Float -> Float) -> GetJSON Float -> GetJSON Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> GetJSON Float
forall a. Floating a => String -> GetJSON a
pos String
ds
Char
'+' : String
ds -> String -> GetJSON Float
forall a. Floating a => String -> GetJSON a
pos String
ds
String
_ -> String -> GetJSON Float
forall a. Floating a => String -> GetJSON a
pos String
cs
where
pos :: String -> GetJSON a
pos [] = String -> GetJSON a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON a) -> String -> GetJSON a
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 InfNaN: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context []
pos String
cs =
case String
cs of
Char
'I':Char
'n':Char
'f':Char
'i':Char
'n':Char
'i':Char
't':Char
'y':String
ds -> String -> GetJSON ()
setInput String
ds GetJSON () -> GetJSON a -> GetJSON a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> GetJSON a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0)
Char
'N':Char
'a':Char
'N':String
ds -> String -> GetJSON ()
setInput String
ds GetJSON () -> GetJSON a -> GetJSON a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> GetJSON a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a
forall a. Floating a => a -> a
acos a
2)
String
_ -> String -> GetJSON a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON a) -> String -> GetJSON a
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 InfNaN: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
cs
readJSArray :: GetJSON JSValue
readJSArray :: GetJSON JSValue
readJSArray = Char -> Char -> Char -> GetJSON [JSValue]
readSequence Char
'[' Char
']' Char
',' GetJSON [JSValue]
-> ([JSValue] -> GetJSON JSValue) -> GetJSON JSValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSValue -> GetJSON JSValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JSValue -> GetJSON JSValue)
-> ([JSValue] -> JSValue) -> [JSValue] -> GetJSON JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JSValue] -> JSValue
JSArray
readJSObject :: GetJSON JSValue
readJSObject :: GetJSON JSValue
readJSObject = Char -> Char -> Char -> GetJSON [(String, JSValue)]
readAssocs Char
'{' Char
'}' Char
',' GetJSON [(String, JSValue)]
-> ([(String, JSValue)] -> GetJSON JSValue) -> GetJSON JSValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSValue -> GetJSON JSValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JSValue -> GetJSON JSValue)
-> ([(String, JSValue)] -> JSValue)
-> [(String, JSValue)]
-> GetJSON JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSObject JSValue -> JSValue
JSObject (JSObject JSValue -> JSValue)
-> ([(String, JSValue)] -> JSObject JSValue)
-> [(String, JSValue)]
-> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, JSValue)] -> JSObject JSValue
forall a. [(String, a)] -> JSObject a
toJSObject
readSequence :: Char -> Char -> Char -> GetJSON [JSValue]
readSequence :: Char -> Char -> Char -> GetJSON [JSValue]
readSequence Char
start Char
end Char
sep = do
String
zs <- GetJSON String
getInput
case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
zs of
Char
c : String
cs | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
start ->
case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
cs of
Char
d : String
ds | Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
end -> String -> GetJSON ()
setInput ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
ds) GetJSON () -> GetJSON [JSValue] -> GetJSON [JSValue]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [JSValue] -> GetJSON [JSValue]
forall (m :: * -> *) a. Monad m => a -> m a
return []
String
ds -> String -> GetJSON ()
setInput String
ds GetJSON () -> GetJSON [JSValue] -> GetJSON [JSValue]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [JSValue] -> GetJSON [JSValue]
parse []
String
_ -> String -> GetJSON [JSValue]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON [JSValue]) -> String -> GetJSON [JSValue]
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 sequence: sequence stars with invalid character: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
zs
where
parse :: [JSValue] -> GetJSON [JSValue]
parse [JSValue]
rs = [JSValue]
rs [JSValue] -> GetJSON [JSValue] -> GetJSON [JSValue]
`seq` do
JSValue
a <- GetJSON JSValue
readJSValue
String
ds <- GetJSON String
getInput
case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
ds of
Char
e : String
es
| Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
sep -> case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
es of
Char
']':String
cs -> String -> GetJSON ()
setInput String
cs GetJSON () -> GetJSON [JSValue] -> GetJSON [JSValue]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [JSValue] -> GetJSON [JSValue]
forall (m :: * -> *) a. Monad m => a -> m a
return ([JSValue] -> [JSValue]
forall a. [a] -> [a]
reverse (JSValue
aJSValue -> [JSValue] -> [JSValue]
forall a. a -> [a] -> [a]
:[JSValue]
rs))
String
cs -> String -> GetJSON ()
setInput String
cs GetJSON () -> GetJSON [JSValue] -> GetJSON [JSValue]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [JSValue] -> GetJSON [JSValue]
parse (JSValue
aJSValue -> [JSValue] -> [JSValue]
forall a. a -> [a] -> [a]
:[JSValue]
rs)
| Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
end -> do String -> GetJSON ()
setInput ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
es)
[JSValue] -> GetJSON [JSValue]
forall (m :: * -> *) a. Monad m => a -> m a
return ([JSValue] -> [JSValue]
forall a. [a] -> [a]
reverse (JSValue
aJSValue -> [JSValue] -> [JSValue]
forall a. a -> [a] -> [a]
:[JSValue]
rs))
String
_ -> String -> GetJSON [JSValue]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON [JSValue]) -> String -> GetJSON [JSValue]
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 array: unterminated array: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
ds
readAssocs :: Char -> Char -> Char -> GetJSON [(String,JSValue)]
readAssocs :: Char -> Char -> Char -> GetJSON [(String, JSValue)]
readAssocs Char
start Char
end Char
sep = do
String
zs <- GetJSON String
getInput
case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
zs of
Char
c:String
cs | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
start -> case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
cs of
Char
d:String
ds | Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
end -> String -> GetJSON ()
setInput ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
ds) GetJSON ()
-> GetJSON [(String, JSValue)] -> GetJSON [(String, JSValue)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(String, JSValue)] -> GetJSON [(String, JSValue)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
String
ds -> String -> GetJSON ()
setInput String
ds GetJSON ()
-> GetJSON [(String, JSValue)] -> GetJSON [(String, JSValue)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(String, JSValue)] -> GetJSON [(String, JSValue)]
parsePairs []
String
_ -> String -> GetJSON [(String, JSValue)]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse JSON5 object: unterminated object"
where parsePairs :: [(String, JSValue)] -> GetJSON [(String, JSValue)]
parsePairs [(String, JSValue)]
rs = [(String, JSValue)]
rs [(String, JSValue)]
-> GetJSON [(String, JSValue)] -> GetJSON [(String, JSValue)]
`seq` do
(String, JSValue)
a <- do String
k <- do JSValue
x <- GetJSON JSValue
readJSKey
case JSValue
x of
JSString JSString
s -> String -> GetJSON String
forall (m :: * -> *) a. Monad m => a -> m a
return (JSString -> String
fromJSString JSString
s)
JSValue
_ -> String -> GetJSON String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
""
String
ds <- GetJSON String
getInput
case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
ds of
Char
':':String
es -> do String -> GetJSON ()
setInput ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
es)
JSValue
v <- GetJSON JSValue
readJSValue
(String, JSValue) -> GetJSON (String, JSValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
k,JSValue
v)
String
_ -> String -> GetJSON (String, JSValue)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON (String, JSValue))
-> String -> GetJSON (String, JSValue)
forall a b. (a -> b) -> a -> b
$ String
"Malformed JSON5 labelled field: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
ds
String
ds <- GetJSON String
getInput
case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
ds of
Char
e : String
es
| Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
sep -> case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
es of
Char
'}':String
cs -> String -> GetJSON ()
setInput String
cs GetJSON ()
-> GetJSON [(String, JSValue)] -> GetJSON [(String, JSValue)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(String, JSValue)] -> GetJSON [(String, JSValue)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, JSValue)] -> [(String, JSValue)]
forall a. [a] -> [a]
reverse ((String, JSValue)
a(String, JSValue) -> [(String, JSValue)] -> [(String, JSValue)]
forall a. a -> [a] -> [a]
:[(String, JSValue)]
rs))
String
cs -> String -> GetJSON ()
setInput String
cs GetJSON ()
-> GetJSON [(String, JSValue)] -> GetJSON [(String, JSValue)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(String, JSValue)] -> GetJSON [(String, JSValue)]
parsePairs ((String, JSValue)
a(String, JSValue) -> [(String, JSValue)] -> [(String, JSValue)]
forall a. a -> [a] -> [a]
:[(String, JSValue)]
rs)
| Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
end -> do String -> GetJSON ()
setInput ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
es)
[(String, JSValue)] -> GetJSON [(String, JSValue)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, JSValue)] -> [(String, JSValue)]
forall a. [a] -> [a]
reverse ((String, JSValue)
a(String, JSValue) -> [(String, JSValue)] -> [(String, JSValue)]
forall a. a -> [a] -> [a]
:[(String, JSValue)]
rs))
String
_ -> String -> GetJSON [(String, JSValue)]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON [(String, JSValue)])
-> String -> GetJSON [(String, JSValue)]
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse JSON5 object: unterminated sequence: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
ds
readJSKey :: GetJSON JSValue
readJSKey :: GetJSON JSValue
readJSKey = do
String
zs <- GetJSON String
getInput
case String
zs of
Char
'"' : String
_ -> Char -> GetJSON JSValue
readJSString Char
'"'
Char
'\'' : String
_ -> Char -> GetJSON JSValue
readJSString Char
'\''
String
_ -> String -> GetJSON JSValue
readSymbol String
zs
where
readSymbol :: String -> GetJSON JSValue
readSymbol [] = String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON JSValue) -> String -> GetJSON JSValue
forall a b. (a -> b) -> a -> b
$ String
"Malformed JSON5 object key-value pairs: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context []
readSymbol xs :: String
xs@(Char
c:String
cs)
| Char -> Bool
isStart Char
c = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSymbol String
xs of
([],String
_) -> String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON JSValue) -> String -> GetJSON JSValue
forall a b. (a -> b) -> a -> b
$ String
"Malformed JSON5 object key-value pairs: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
cs
(String
k,String
ds) -> do String -> GetJSON ()
setInput String
ds
JSValue -> GetJSON JSValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JSString -> JSValue
JSString (String -> JSString
toJSString String
k))
| Bool
otherwise = String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON JSValue) -> String -> GetJSON JSValue
forall a b. (a -> b) -> a -> b
$ String
"Malformed JSON5 object key: started with illegal character: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
xs
isStart :: Char -> Bool
isStart Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"_$"
isSymbol :: Char -> Bool
isSymbol 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
"-_"
readJSValue :: GetJSON JSValue
readJSValue :: GetJSON JSValue
readJSValue = do
String
cs <- GetJSON String
getInput
case String
cs of
Char
'"' : String
_ -> Char -> GetJSON JSValue
readJSString Char
'"'
Char
'\'': String
_ -> Char -> GetJSON JSValue
readJSString Char
'\''
Char
'[' : String
_ -> GetJSON JSValue
readJSArray
Char
'{' : String
_ -> GetJSON JSValue
readJSObject
Char
't' : String
_ -> GetJSON JSValue
readJSBool
Char
'f' : String
_ -> GetJSON JSValue
readJSBool
(Char
x:String
xs)
| Char -> Bool
isSpace Char
x -> String -> GetJSON ()
setInput String
xs GetJSON () -> GetJSON JSValue -> GetJSON JSValue
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GetJSON JSValue
readJSValue
| Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' -> Rational -> JSValue
fromJSRational (Rational -> JSValue) -> GetJSON Rational -> GetJSON JSValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetJSON Rational
readJSRational
| Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"NI" -> Float -> JSValue
fromJSInfNaN (Float -> JSValue) -> GetJSON Float -> GetJSON JSValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetJSON Float
readJSInfNaN
| Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"+-" -> case String
xs of
Char
'I' : String
_ -> Float -> JSValue
fromJSInfNaN (Float -> JSValue) -> GetJSON Float -> GetJSON JSValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetJSON Float
readJSInfNaN
String
_ -> Rational -> JSValue
fromJSRational (Rational -> JSValue) -> GetJSON Rational -> GetJSON JSValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetJSON Rational
readJSRational
String
_ -> GetJSON JSValue -> GetJSON JSValue
tryJSNull
(String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GetJSON JSValue) -> String -> GetJSON JSValue
forall a b. (a -> b) -> a -> b
$ String
"Malformed JSON5: invalid token in this context " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
context String
cs)
readJSTopType :: GetJSON JSValue
readJSTopType :: GetJSON JSValue
readJSTopType = do
String
cs <- GetJSON String
getInput
case String
cs of
Char
'[' : String
_ -> GetJSON JSValue
readJSArray
Char
'{' : String
_ -> GetJSON JSValue
readJSObject
String
_ -> String -> GetJSON JSValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid JSON5: expecting a serialized object or array at the top level."
showJSTopType :: JSValue -> ShowS
showJSTopType :: JSValue -> String -> String
showJSTopType (JSArray [JSValue]
a) = [JSValue] -> String -> String
showJSArray [JSValue]
a
showJSTopType (JSObject JSObject JSValue
o) = JSObject JSValue -> String -> String
showJSObject JSObject JSValue
o
showJSTopType JSValue
x = JSValue -> String -> String
showJSTopType (JSValue -> String -> String) -> JSValue -> String -> String
forall a b. (a -> b) -> a -> b
$ [JSValue] -> JSValue
JSArray [JSValue
x]
showJSValue :: JSValue -> ShowS
showJSValue :: JSValue -> String -> String
showJSValue JSValue
v =
case JSValue
v of
JSNull{} -> String -> String
showJSNull
JSBool Bool
b -> Bool -> String -> String
showJSBool Bool
b
JSNumber JSNumber
jsn -> JSNumber -> String -> String
showJSNumber JSNumber
jsn
JSArray [JSValue]
a -> [JSValue] -> String -> String
showJSArray [JSValue]
a
JSString JSString
s -> JSString -> String -> String
showJSString JSString
s
JSObject JSObject JSValue
o -> JSObject JSValue -> String -> String
showJSObject JSObject JSValue
o
showJSNull :: ShowS
showJSNull :: String -> String
showJSNull = String -> String -> String
showString String
"null"
showJSBool :: Bool -> ShowS
showJSBool :: Bool -> String -> String
showJSBool Bool
True = String -> String -> String
showString String
"true"
showJSBool Bool
False = String -> String -> String
showString String
"false"
showJSString :: JSString -> ShowS
showJSString :: JSString -> String -> String
showJSString JSString
x String
xs = String -> String
quote (JSString -> String -> String
encJSString JSString
x (String -> String
quote String
xs))
where
quote :: String -> String
quote = Char -> String -> String
showChar Char
'"'
showJSNumber :: JSNumber -> ShowS
showJSNumber :: JSNumber -> String -> String
showJSNumber (JSRational Rational
r) = Rational -> String -> String
showJSRational Rational
r
showJSNumber (JSInfNaN Float
n) = Float -> String -> String
showJSInfNaN Float
n
showJSRational :: Rational -> ShowS
showJSRational :: Rational -> String -> String
showJSRational Rational
r
| Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Integer -> String -> String
forall a. Show a => a -> String -> String
shows (Integer -> String -> String) -> Integer -> String -> String
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r
| Bool
otherwise = Double -> String -> String
forall a. Show a => a -> String -> String
shows (Double -> String -> String) -> Double -> String -> String
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Rational
r
showJSInfNaN :: Float -> ShowS
showJSInfNaN :: Float -> String -> String
showJSInfNaN Float
n
| Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
n = String -> String -> String
showString String
"NaN"
| Float
n Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 = String -> String -> String
showString String
"Infinity"
| Float
n Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 = String -> String -> String
showString String
"-Infinity"
showJSArray :: [JSValue] -> ShowS
showJSArray :: [JSValue] -> String -> String
showJSArray = Char -> Char -> Char -> [JSValue] -> String -> String
showSequence Char
'[' Char
']' Char
','
showJSObject :: JSObject JSValue -> ShowS
showJSObject :: JSObject JSValue -> String -> String
showJSObject = Char -> Char -> Char -> [(String, JSValue)] -> String -> String
showAssocs Char
'{' Char
'}' Char
',' ([(String, JSValue)] -> String -> String)
-> (JSObject JSValue -> [(String, JSValue)])
-> JSObject JSValue
-> String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSObject JSValue -> [(String, JSValue)]
forall a. JSObject a -> [(String, a)]
fromJSObject
showAssocs :: Char -> Char -> Char -> [(String,JSValue)] -> ShowS
showAssocs :: Char -> Char -> Char -> [(String, JSValue)] -> String -> String
showAssocs Char
start Char
end Char
sep [(String, JSValue)]
xs String
rest = Char
start Char -> String -> String
forall a. a -> [a] -> [a]
: [(String, JSValue)] -> String
go [(String, JSValue)]
xs
where
go :: [(String, JSValue)] -> String
go [(String
k,JSValue
v)] = Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: JSString -> String -> String
encJSString (String -> JSString
toJSString String
k)
(Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: JSValue -> String -> String
showJSValue JSValue
v ([(String, JSValue)] -> String
go []))
go ((String
k,JSValue
v):[(String, JSValue)]
kvs) = Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: JSString -> String -> String
encJSString (String -> JSString
toJSString String
k)
(Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: JSValue -> String -> String
showJSValue JSValue
v (Char
sep Char -> String -> String
forall a. a -> [a] -> [a]
: [(String, JSValue)] -> String
go [(String, JSValue)]
kvs))
go [] = Char
end Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
showSequence :: Char -> Char -> Char -> [JSValue] -> ShowS
showSequence :: Char -> Char -> Char -> [JSValue] -> String -> String
showSequence Char
start Char
end Char
sep [JSValue]
xs String
rest = Char
start Char -> String -> String
forall a. a -> [a] -> [a]
: [JSValue] -> String
go [JSValue]
xs
where
go :: [JSValue] -> String
go [JSValue
y] = JSValue -> String -> String
showJSValue JSValue
y ([JSValue] -> String
go [])
go (JSValue
y:[JSValue]
ys) = JSValue -> String -> String
showJSValue JSValue
y (Char
sep Char -> String -> String
forall a. a -> [a] -> [a]
: [JSValue] -> String
go [JSValue]
ys)
go [] = Char
end Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
encJSString :: JSString -> ShowS
encJSString :: JSString -> String -> String
encJSString JSString
jss String
ss = String -> String
go (JSString -> String
fromJSString JSString
jss)
where
go :: String -> String
go String
s1 =
case String
s1 of
(Char
x :String
xs) | Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x20' -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char -> String -> String
encControl Char
x (String -> String
go String
xs)
(Char
'"' :String
xs) -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
xs
(Char
'\\':String
xs) -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
xs
(Char
x :String
xs) -> Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
xs
String
"" -> String
ss
encControl :: Char -> String -> String
encControl Char
x String
xs = case Char
x of
Char
'\b' -> Char
'b' Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
Char
'\f' -> Char
'f' Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
Char
'\n' -> Char
'n' Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
Char
'\r' -> Char
'r' Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
Char
'\t' -> Char
't' Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
Char
_ | Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x10' -> Char
'u' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: String
hexxs
| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x100' -> Char
'u' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: String
hexxs
| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x1000' -> Char
'u' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: String
hexxs
| Bool
otherwise -> Char
'u' Char -> String -> String
forall a. a -> [a] -> [a]
: String
hexxs
where hexxs :: String
hexxs = Int -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
x) String
xs