module Text.JSON.Parsec
( p_value
, p_null
, p_boolean
, p_array
, p_string
, p_object
, p_number
, p_js_string
, p_js_object
, p_jvalue
, module Text.ParserCombinators.Parsec
) where
import Text.JSON.Types
import Text.ParserCombinators.Parsec
import Control.Monad
import Data.Char
import Numeric
p_value :: CharParser () JSValue
p_value :: CharParser () JSValue
p_value = ParsecT [Char] () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT [Char] () Identity ()
-> CharParser () JSValue -> CharParser () JSValue
forall a b. CharParser () a -> CharParser () b -> CharParser () b
**> CharParser () JSValue
p_jvalue
tok :: CharParser () a -> CharParser () a
tok :: CharParser () a -> CharParser () a
tok p :: CharParser () a
p = CharParser () a
p CharParser () a -> ParsecT [Char] () Identity () -> CharParser () a
forall a b. CharParser () a -> CharParser () b -> CharParser () a
<** ParsecT [Char] () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
p_jvalue :: CharParser () JSValue
p_jvalue :: CharParser () JSValue
p_jvalue = (JSValue
JSNull JSValue -> ParsecT [Char] () Identity () -> CharParser () JSValue
forall a b. a -> CharParser () b -> CharParser () a
<$$ ParsecT [Char] () Identity ()
p_null)
CharParser () JSValue
-> CharParser () JSValue -> CharParser () JSValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Bool -> JSValue
JSBool (Bool -> JSValue) -> CharParser () Bool -> CharParser () JSValue
forall a b. (a -> b) -> CharParser () a -> CharParser () b
<$$> CharParser () Bool
p_boolean)
CharParser () JSValue
-> CharParser () JSValue -> CharParser () JSValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([JSValue] -> JSValue
JSArray ([JSValue] -> JSValue)
-> CharParser () [JSValue] -> CharParser () JSValue
forall a b. (a -> b) -> CharParser () a -> CharParser () b
<$$> CharParser () [JSValue]
p_array)
CharParser () JSValue
-> CharParser () JSValue -> CharParser () JSValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (JSString -> JSValue
JSString (JSString -> JSValue)
-> CharParser () JSString -> CharParser () JSValue
forall a b. (a -> b) -> CharParser () a -> CharParser () b
<$$> CharParser () JSString
p_js_string)
CharParser () JSValue
-> CharParser () JSValue -> CharParser () JSValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (JSObject JSValue -> JSValue
JSObject (JSObject JSValue -> JSValue)
-> CharParser () (JSObject JSValue) -> CharParser () JSValue
forall a b. (a -> b) -> CharParser () a -> CharParser () b
<$$> CharParser () (JSObject JSValue)
p_js_object)
CharParser () JSValue
-> CharParser () JSValue -> CharParser () JSValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Bool -> Rational -> JSValue
JSRational Bool
False (Rational -> JSValue)
-> CharParser () Rational -> CharParser () JSValue
forall a b. (a -> b) -> CharParser () a -> CharParser () b
<$$> CharParser () Rational
p_number)
CharParser () JSValue -> [Char] -> CharParser () JSValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "JSON value"
p_null :: CharParser () ()
p_null :: ParsecT [Char] () Identity ()
p_null = CharParser () [Char] -> CharParser () [Char]
forall a. CharParser () a -> CharParser () a
tok ([Char] -> CharParser () [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string "null") CharParser () [Char]
-> ParsecT [Char] () Identity () -> ParsecT [Char] () Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT [Char] () Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
p_boolean :: CharParser () Bool
p_boolean :: CharParser () Bool
p_boolean = CharParser () Bool -> CharParser () Bool
forall a. CharParser () a -> CharParser () a
tok
( (Bool
True Bool -> CharParser () [Char] -> CharParser () Bool
forall a b. a -> CharParser () b -> CharParser () a
<$$ [Char] -> CharParser () [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string "true")
CharParser () Bool -> CharParser () Bool -> CharParser () Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Bool
False Bool -> CharParser () [Char] -> CharParser () Bool
forall a b. a -> CharParser () b -> CharParser () a
<$$ [Char] -> CharParser () [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string "false")
)
p_array :: CharParser () [JSValue]
p_array :: CharParser () [JSValue]
p_array = ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> CharParser () [JSValue]
-> CharParser () [JSValue]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '[')) (ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ']'))
(CharParser () [JSValue] -> CharParser () [JSValue])
-> CharParser () [JSValue] -> CharParser () [JSValue]
forall a b. (a -> b) -> a -> b
$ CharParser () JSValue
p_jvalue CharParser () JSValue
-> ParsecT [Char] () Identity Char -> CharParser () [JSValue]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ',')
p_string :: CharParser () String
p_string :: CharParser () [Char]
p_string = ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> CharParser () [Char]
-> CharParser () [Char]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '"')) (ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '"')) (ParsecT [Char] () Identity Char -> CharParser () [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Char] () Identity Char
p_char)
where p_char :: ParsecT [Char] () Identity Char
p_char = (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\\' ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity Char
p_esc)
ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((Char -> Bool) -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\x :: Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '"' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\\'))
p_esc :: ParsecT [Char] () Identity Char
p_esc = ('"' Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b. a -> CharParser () b -> CharParser () a
<$$ Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '"')
ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ('\\' Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b. a -> CharParser () b -> CharParser () a
<$$ Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\\')
ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ('/' Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b. a -> CharParser () b -> CharParser () a
<$$ Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/')
ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ('\b' Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b. a -> CharParser () b -> CharParser () a
<$$ Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'b')
ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ('\f' Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b. a -> CharParser () b -> CharParser () a
<$$ Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'f')
ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ('\n' Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b. a -> CharParser () b -> CharParser () a
<$$ Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'n')
ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ('\r' Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b. a -> CharParser () b -> CharParser () a
<$$ Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'r')
ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ('\t' Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b. a -> CharParser () b -> CharParser () a
<$$ Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 't')
ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'u' ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b. CharParser () a -> CharParser () b -> CharParser () b
**> ParsecT [Char] () Identity Char
forall u. ParsecT [Char] u Identity Char
p_uni)
ParsecT [Char] () Identity Char
-> [Char] -> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> "escape character"
p_uni :: ParsecT [Char] u Identity Char
p_uni = [Char] -> ParsecT [Char] u Identity Char
forall (m :: * -> *) a. (Enum a, MonadPlus m) => [Char] -> m a
check ([Char] -> ParsecT [Char] u Identity Char)
-> ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Char
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int
-> ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count 4 ((Char -> Bool) -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isHexDigit)
where check :: [Char] -> m a
check x :: [Char]
x | Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
max_char = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> a
forall a. Enum a => Int -> a
toEnum Int
code)
| Bool
otherwise = m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
where code :: Int
code = (Int, [Char]) -> Int
forall a b. (a, b) -> a
fst ((Int, [Char]) -> Int) -> (Int, [Char]) -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, [Char])] -> (Int, [Char])
forall a. [a] -> a
head ([(Int, [Char])] -> (Int, [Char]))
-> [(Int, [Char])] -> (Int, [Char])
forall a b. (a -> b) -> a -> b
$ ReadS Int
forall a. (Eq a, Num a) => ReadS a
readHex [Char]
x
max_char :: Int
max_char = Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char
forall a. Bounded a => a
maxBound :: Char)
p_object :: CharParser () [(String,JSValue)]
p_object :: CharParser () [([Char], JSValue)]
p_object = ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> CharParser () [([Char], JSValue)]
-> CharParser () [([Char], JSValue)]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '{')) (ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '}'))
(CharParser () [([Char], JSValue)]
-> CharParser () [([Char], JSValue)])
-> CharParser () [([Char], JSValue)]
-> CharParser () [([Char], JSValue)]
forall a b. (a -> b) -> a -> b
$ CharParser () ([Char], JSValue)
p_field CharParser () ([Char], JSValue)
-> ParsecT [Char] () Identity Char
-> CharParser () [([Char], JSValue)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ',')
where p_field :: CharParser () ([Char], JSValue)
p_field = (,) ([Char] -> JSValue -> ([Char], JSValue))
-> CharParser () [Char]
-> CharParser () (JSValue -> ([Char], JSValue))
forall a b. (a -> b) -> CharParser () a -> CharParser () b
<$$> (CharParser () [Char]
p_string CharParser () [Char]
-> ParsecT [Char] () Identity Char -> CharParser () [Char]
forall a b. CharParser () a -> CharParser () b -> CharParser () a
<** ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall a. CharParser () a -> CharParser () a
tok (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':')) CharParser () (JSValue -> ([Char], JSValue))
-> CharParser () JSValue -> CharParser () ([Char], JSValue)
forall a b.
CharParser () (a -> b) -> CharParser () a -> CharParser () b
<**> CharParser () JSValue
p_jvalue
p_number :: CharParser () Rational
p_number :: CharParser () Rational
p_number = CharParser () Rational -> CharParser () Rational
forall a. CharParser () a -> CharParser () a
tok
(CharParser () Rational -> CharParser () Rational)
-> CharParser () Rational -> CharParser () Rational
forall a b. (a -> b) -> a -> b
$ do [Char]
s <- CharParser () [Char]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
case ReadS Rational -> ReadS Rational
forall a. Real a => ReadS a -> ReadS a
readSigned ReadS Rational
forall a. RealFrac a => ReadS a
readFloat [Char]
s of
[(n :: Rational
n,s1 :: [Char]
s1)] -> Rational
n Rational -> ParsecT [Char] () Identity () -> CharParser () Rational
forall a b. a -> CharParser () b -> CharParser () a
<$$ [Char] -> ParsecT [Char] () Identity ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput [Char]
s1
_ -> CharParser () Rational
forall (m :: * -> *) a. MonadPlus m => m a
mzero
p_js_string :: CharParser () JSString
p_js_string :: CharParser () JSString
p_js_string = [Char] -> JSString
toJSString ([Char] -> JSString)
-> CharParser () [Char] -> CharParser () JSString
forall a b. (a -> b) -> CharParser () a -> CharParser () b
<$$> CharParser () [Char]
p_string
p_js_object :: CharParser () (JSObject JSValue)
p_js_object :: CharParser () (JSObject JSValue)
p_js_object = [([Char], JSValue)] -> JSObject JSValue
forall a. [([Char], a)] -> JSObject a
toJSObject ([([Char], JSValue)] -> JSObject JSValue)
-> CharParser () [([Char], JSValue)]
-> CharParser () (JSObject JSValue)
forall a b. (a -> b) -> CharParser () a -> CharParser () b
<$$> CharParser () [([Char], JSValue)]
p_object
(<**>) :: CharParser () (a -> b) -> CharParser () a -> CharParser () b
<**> :: CharParser () (a -> b) -> CharParser () a -> CharParser () b
(<**>) = CharParser () (a -> b) -> CharParser () a -> CharParser () b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
(**>) :: CharParser () a -> CharParser () b -> CharParser () b
**> :: CharParser () a -> CharParser () b -> CharParser () b
(**>) = CharParser () a -> CharParser () b -> CharParser () b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)
(<**) :: CharParser () a -> CharParser () b -> CharParser () a
m :: CharParser () a
m <** :: CharParser () a -> CharParser () b -> CharParser () a
<** n :: CharParser () b
n = do a
x <- CharParser () a
m; b
_ <- CharParser () b
n; a -> CharParser () a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
(<$$>) :: (a -> b) -> CharParser () a -> CharParser () b
<$$> :: (a -> b) -> CharParser () a -> CharParser () b
(<$$>) = (a -> b) -> CharParser () a -> CharParser () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(<$$) :: a -> CharParser () b -> CharParser () a
x :: a
x <$$ :: a -> CharParser () b -> CharParser () a
<$$ m :: CharParser () b
m = CharParser () b
m CharParser () b -> CharParser () a -> CharParser () a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> CharParser () a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x