-- | Parse JSON values using the ReadP combinators.

module Text.JSON.ReadP
  ( p_value
  , p_null
  , p_boolean
  , p_array
  , p_string
  , p_object
  , p_number
  , p_js_string
  , p_js_object
  , module Text.ParserCombinators.ReadP
  ) where

import Text.JSON.Types
import Text.ParserCombinators.ReadP
import Control.Monad
import Data.Char
import Numeric

token            :: ReadP a -> ReadP a
token :: forall a. ReadP a -> ReadP a
token ReadP a
p           = ReadP ()
skipSpaces forall a b. ReadP a -> ReadP b -> ReadP b
**> ReadP a
p

p_value          :: ReadP JSValue
p_value :: ReadP JSValue
p_value           =  (JSValue
JSNull      forall a b. a -> ReadP b -> ReadP a
<$$  ReadP ()
p_null)
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> (Bool -> JSValue
JSBool      forall a b. (a -> b) -> ReadP a -> ReadP b
<$$> ReadP Bool
p_boolean)
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> ([JSValue] -> JSValue
JSArray     forall a b. (a -> b) -> ReadP a -> ReadP b
<$$> ReadP [JSValue]
p_array)
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> (JSString -> JSValue
JSString    forall a b. (a -> b) -> ReadP a -> ReadP b
<$$> ReadP JSString
p_js_string)
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> (JSObject JSValue -> JSValue
JSObject    forall a b. (a -> b) -> ReadP a -> ReadP b
<$$> ReadP (JSObject JSValue)
p_js_object)
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> (Bool -> Rational -> JSValue
JSRational Bool
False forall a b. (a -> b) -> ReadP a -> ReadP b
<$$> ReadP Rational
p_number)

p_null           :: ReadP ()
p_null :: ReadP ()
p_null            = forall a. ReadP a -> ReadP a
token (String -> ReadP String
string String
"null") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

p_boolean        :: ReadP Bool
p_boolean :: ReadP Bool
p_boolean         = forall a. ReadP a -> ReadP a
token
                      (  (Bool
True  forall a b. a -> ReadP b -> ReadP a
<$$ String -> ReadP String
string String
"true")
                     forall a. ReadP a -> ReadP a -> ReadP a
<||> (Bool
False forall a b. a -> ReadP b -> ReadP a
<$$ String -> ReadP String
string String
"false")
                      )

p_array          :: ReadP [JSValue]
p_array :: ReadP [JSValue]
p_array           = forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between (forall a. ReadP a -> ReadP a
token (Char -> ReadP Char
char Char
'[')) (forall a. ReadP a -> ReadP a
token (Char -> ReadP Char
char Char
']'))
                  forall a b. (a -> b) -> a -> b
$ ReadP JSValue
p_value forall a sep. ReadP a -> ReadP sep -> ReadP [a]
`sepBy` forall a. ReadP a -> ReadP a
token (Char -> ReadP Char
char Char
',')

p_string         :: ReadP String
p_string :: ReadP String
p_string          = forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between (forall a. ReadP a -> ReadP a
token (Char -> ReadP Char
char Char
'"')) (Char -> ReadP Char
char Char
'"') (forall a. ReadP a -> ReadP [a]
many ReadP Char
p_char)
  where p_char :: ReadP Char
p_char    =  (Char -> ReadP Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Char
p_esc)
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> ((Char -> Bool) -> ReadP Char
satisfy (\Char
x -> Char
x forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
'\\'))

        p_esc :: ReadP Char
p_esc     =  (Char
'"'   forall a b. a -> ReadP b -> ReadP a
<$$ Char -> ReadP Char
char Char
'"')
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> (Char
'\\'  forall a b. a -> ReadP b -> ReadP a
<$$ Char -> ReadP Char
char Char
'\\')
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> (Char
'/'   forall a b. a -> ReadP b -> ReadP a
<$$ Char -> ReadP Char
char Char
'/')
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> (Char
'\b'  forall a b. a -> ReadP b -> ReadP a
<$$ Char -> ReadP Char
char Char
'b')
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> (Char
'\f'  forall a b. a -> ReadP b -> ReadP a
<$$ Char -> ReadP Char
char Char
'f')
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> (Char
'\n'  forall a b. a -> ReadP b -> ReadP a
<$$ Char -> ReadP Char
char Char
'n')
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> (Char
'\r'  forall a b. a -> ReadP b -> ReadP a
<$$ Char -> ReadP Char
char Char
'r')
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> (Char
'\t'  forall a b. a -> ReadP b -> ReadP a
<$$ Char -> ReadP Char
char Char
't')
                 forall a. ReadP a -> ReadP a -> ReadP a
<||> (Char -> ReadP Char
char Char
'u' forall a b. ReadP a -> ReadP b -> ReadP b
**> ReadP Char
p_uni)

        p_uni :: ReadP Char
p_uni     = forall {a}. Enum a => String -> ReadP a
check forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Int -> ReadP a -> ReadP [a]
count Int
4 ((Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isHexDigit)
          where check :: String -> ReadP a
check String
x | Int
code forall a. Ord a => a -> a -> Bool
<= Int
max_char  = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Enum a => Int -> a
toEnum Int
code)
                        | Bool
otherwise         = forall a. ReadP a
pfail
                  where code :: Int
code      = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => ReadS a
readHex String
x
                        max_char :: Int
max_char  = forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: Char)

p_object         :: ReadP [(String,JSValue)]
p_object :: ReadP [(String, JSValue)]
p_object          = forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between (forall a. ReadP a -> ReadP a
token (Char -> ReadP Char
char Char
'{')) (forall a. ReadP a -> ReadP a
token (Char -> ReadP Char
char Char
'}'))
                  forall a b. (a -> b) -> a -> b
$ ReadP (String, JSValue)
p_field forall a sep. ReadP a -> ReadP sep -> ReadP [a]
`sepBy` forall a. ReadP a -> ReadP a
token (Char -> ReadP Char
char Char
',')
  where p_field :: ReadP (String, JSValue)
p_field   = (,) forall a b. (a -> b) -> ReadP a -> ReadP b
<$$> (ReadP String
p_string forall a b. ReadP a -> ReadP b -> ReadP a
<** forall a. ReadP a -> ReadP a
token (Char -> ReadP Char
char Char
':')) forall a b. ReadP (a -> b) -> ReadP a -> ReadP b
<**> ReadP JSValue
p_value

p_number         :: ReadP Rational
p_number :: ReadP Rational
p_number          = forall a. ReadS a -> ReadP a
readS_to_P ReadS Rational
safeRationalReads

-- reading into a Double with reads is safe for huge floating-point literals
-- this will allow all floating-point literals that are small enough to fit
-- into a Double (and are thus compatible with most other json implementations)
-- to be parsed here without opening us to oversized Rational allocations
safeRationalReads :: ReadS Rational
safeRationalReads :: ReadS Rational
safeRationalReads String
str =
  case forall a. Read a => ReadS a
reads String
str of
    [(Double
d,String
_)] | Bool -> Bool
not (forall a. RealFloat a => a -> Bool
isInfinite (Double
d :: Double)) -> forall a. Real a => ReadS a -> ReadS a
readSigned forall a. RealFrac a => ReadS a
readFloat String
str
    [(Double, String)]
_ -> []

p_js_string      :: ReadP JSString
p_js_string :: ReadP JSString
p_js_string       = String -> JSString
toJSString forall a b. (a -> b) -> ReadP a -> ReadP b
<$$> ReadP String
p_string

p_js_object      :: ReadP (JSObject JSValue)
p_js_object :: ReadP (JSObject JSValue)
p_js_object       = forall a. [(String, a)] -> JSObject a
toJSObject forall a b. (a -> b) -> ReadP a -> ReadP b
<$$> ReadP [(String, JSValue)]
p_object

--------------------------------------------------------------------------------
-- XXX: Because ReadP is not Applicative yet...

(<**>)  :: ReadP (a -> b) -> ReadP a -> ReadP b
<**> :: forall a b. ReadP (a -> b) -> ReadP a -> ReadP b
(<**>)   = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

(**>)   :: ReadP a -> ReadP b -> ReadP b
**> :: forall a b. ReadP a -> ReadP b -> ReadP b
(**>)    = forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)

(<**)   :: ReadP a -> ReadP b -> ReadP a
ReadP a
m <** :: forall a b. ReadP a -> ReadP b -> ReadP a
<** ReadP b
n  = do a
x <- ReadP a
m; b
_ <- ReadP b
n; forall (m :: * -> *) a. Monad m => a -> m a
return a
x

(<||>)  :: ReadP a -> ReadP a -> ReadP a
<||> :: forall a. ReadP a -> ReadP a -> ReadP a
(<||>)   = forall a. ReadP a -> ReadP a -> ReadP a
(+++)

(<$$>)  :: (a -> b) -> ReadP a -> ReadP b
<$$> :: forall a b. (a -> b) -> ReadP a -> ReadP b
(<$$>)   = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

(<$$)   :: a -> ReadP b -> ReadP a
a
x <$$ :: forall a b. a -> ReadP b -> ReadP a
<$$ ReadP b
m  = ReadP b
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
x