{-# LANGUAGE DeriveDataTypeable #-}
-- | Basic support for working with JSON values.

module Text.JSON.Types (

    -- * JSON Types
    JSValue(..)

    -- * Wrapper Types
  , JSString({-fromJSString-}..)
  , toJSString

  , JSObject({-fromJSObject-}..)
  , toJSObject

  , get_field
  , set_field

  ) where

import Data.Typeable ( Typeable )
import Data.String(IsString(..))

--
-- | JSON values
--
-- The type to which we encode Haskell values. There's a set
-- of primitives, and a couple of heterogenous collection types.
--
-- Objects:
--
-- An object structure is represented as a pair of curly brackets
-- surrounding zero or more name\/value pairs (or members).  A name is a
-- string.  A single colon comes after each name, separating the name
-- from the value.  A single comma separates a value from a
-- following name.
--
-- Arrays:
--
-- An array structure is represented as square brackets surrounding
-- zero or more values (or elements).  Elements are separated by commas.
--
-- Only valid JSON can be constructed this way
--
data JSValue
    = JSNull
    | JSBool     !Bool
    | JSRational Bool{-as Float?-} !Rational
    | JSString   JSString
    | JSArray    [JSValue]
    | JSObject   (JSObject JSValue)
    deriving (Int -> JSValue -> ShowS
[JSValue] -> ShowS
JSValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSValue] -> ShowS
$cshowList :: [JSValue] -> ShowS
show :: JSValue -> String
$cshow :: JSValue -> String
showsPrec :: Int -> JSValue -> ShowS
$cshowsPrec :: Int -> JSValue -> ShowS
Show, ReadPrec [JSValue]
ReadPrec JSValue
Int -> ReadS JSValue
ReadS [JSValue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JSValue]
$creadListPrec :: ReadPrec [JSValue]
readPrec :: ReadPrec JSValue
$creadPrec :: ReadPrec JSValue
readList :: ReadS [JSValue]
$creadList :: ReadS [JSValue]
readsPrec :: Int -> ReadS JSValue
$creadsPrec :: Int -> ReadS JSValue
Read, JSValue -> JSValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSValue -> JSValue -> Bool
$c/= :: JSValue -> JSValue -> Bool
== :: JSValue -> JSValue -> Bool
$c== :: JSValue -> JSValue -> Bool
Eq, Eq JSValue
JSValue -> JSValue -> Bool
JSValue -> JSValue -> Ordering
JSValue -> JSValue -> JSValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JSValue -> JSValue -> JSValue
$cmin :: JSValue -> JSValue -> JSValue
max :: JSValue -> JSValue -> JSValue
$cmax :: JSValue -> JSValue -> JSValue
>= :: JSValue -> JSValue -> Bool
$c>= :: JSValue -> JSValue -> Bool
> :: JSValue -> JSValue -> Bool
$c> :: JSValue -> JSValue -> Bool
<= :: JSValue -> JSValue -> Bool
$c<= :: JSValue -> JSValue -> Bool
< :: JSValue -> JSValue -> Bool
$c< :: JSValue -> JSValue -> Bool
compare :: JSValue -> JSValue -> Ordering
$ccompare :: JSValue -> JSValue -> Ordering
Ord, Typeable)

-- | Strings can be represented a little more efficiently in JSON
newtype JSString   = JSONString { JSString -> String
fromJSString :: String }
    deriving (JSString -> JSString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSString -> JSString -> Bool
$c/= :: JSString -> JSString -> Bool
== :: JSString -> JSString -> Bool
$c== :: JSString -> JSString -> Bool
Eq, Eq JSString
JSString -> JSString -> Bool
JSString -> JSString -> Ordering
JSString -> JSString -> JSString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JSString -> JSString -> JSString
$cmin :: JSString -> JSString -> JSString
max :: JSString -> JSString -> JSString
$cmax :: JSString -> JSString -> JSString
>= :: JSString -> JSString -> Bool
$c>= :: JSString -> JSString -> Bool
> :: JSString -> JSString -> Bool
$c> :: JSString -> JSString -> Bool
<= :: JSString -> JSString -> Bool
$c<= :: JSString -> JSString -> Bool
< :: JSString -> JSString -> Bool
$c< :: JSString -> JSString -> Bool
compare :: JSString -> JSString -> Ordering
$ccompare :: JSString -> JSString -> Ordering
Ord, Int -> JSString -> ShowS
[JSString] -> ShowS
JSString -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSString] -> ShowS
$cshowList :: [JSString] -> ShowS
show :: JSString -> String
$cshow :: JSString -> String
showsPrec :: Int -> JSString -> ShowS
$cshowsPrec :: Int -> JSString -> ShowS
Show, ReadPrec [JSString]
ReadPrec JSString
Int -> ReadS JSString
ReadS [JSString]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JSString]
$creadListPrec :: ReadPrec [JSString]
readPrec :: ReadPrec JSString
$creadPrec :: ReadPrec JSString
readList :: ReadS [JSString]
$creadList :: ReadS [JSString]
readsPrec :: Int -> ReadS JSString
$creadsPrec :: Int -> ReadS JSString
Read, Typeable)

-- | Turn a Haskell string into a JSON string.
toJSString :: String -> JSString
toJSString :: String -> JSString
toJSString = String -> JSString
JSONString
  -- Note: we don't encode the string yet, that's done when serializing.

instance IsString JSString where
  fromString :: String -> JSString
fromString = String -> JSString
toJSString

instance IsString JSValue where
  fromString :: String -> JSValue
fromString = JSString -> JSValue
JSString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

-- | As can association lists
newtype JSObject e = JSONObject { forall e. JSObject e -> [(String, e)]
fromJSObject :: [(String, e)] }
    deriving (JSObject e -> JSObject e -> Bool
forall e. Eq e => JSObject e -> JSObject e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSObject e -> JSObject e -> Bool
$c/= :: forall e. Eq e => JSObject e -> JSObject e -> Bool
== :: JSObject e -> JSObject e -> Bool
$c== :: forall e. Eq e => JSObject e -> JSObject e -> Bool
Eq, JSObject e -> JSObject e -> Bool
JSObject e -> JSObject e -> Ordering
JSObject e -> JSObject e -> JSObject e
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {e}. Ord e => Eq (JSObject e)
forall e. Ord e => JSObject e -> JSObject e -> Bool
forall e. Ord e => JSObject e -> JSObject e -> Ordering
forall e. Ord e => JSObject e -> JSObject e -> JSObject e
min :: JSObject e -> JSObject e -> JSObject e
$cmin :: forall e. Ord e => JSObject e -> JSObject e -> JSObject e
max :: JSObject e -> JSObject e -> JSObject e
$cmax :: forall e. Ord e => JSObject e -> JSObject e -> JSObject e
>= :: JSObject e -> JSObject e -> Bool
$c>= :: forall e. Ord e => JSObject e -> JSObject e -> Bool
> :: JSObject e -> JSObject e -> Bool
$c> :: forall e. Ord e => JSObject e -> JSObject e -> Bool
<= :: JSObject e -> JSObject e -> Bool
$c<= :: forall e. Ord e => JSObject e -> JSObject e -> Bool
< :: JSObject e -> JSObject e -> Bool
$c< :: forall e. Ord e => JSObject e -> JSObject e -> Bool
compare :: JSObject e -> JSObject e -> Ordering
$ccompare :: forall e. Ord e => JSObject e -> JSObject e -> Ordering
Ord, Int -> JSObject e -> ShowS
forall e. Show e => Int -> JSObject e -> ShowS
forall e. Show e => [JSObject e] -> ShowS
forall e. Show e => JSObject e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSObject e] -> ShowS
$cshowList :: forall e. Show e => [JSObject e] -> ShowS
show :: JSObject e -> String
$cshow :: forall e. Show e => JSObject e -> String
showsPrec :: Int -> JSObject e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> JSObject e -> ShowS
Show, ReadPrec [JSObject e]
ReadPrec (JSObject e)
ReadS [JSObject e]
forall e. Read e => ReadPrec [JSObject e]
forall e. Read e => ReadPrec (JSObject e)
forall e. Read e => Int -> ReadS (JSObject e)
forall e. Read e => ReadS [JSObject e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JSObject e]
$creadListPrec :: forall e. Read e => ReadPrec [JSObject e]
readPrec :: ReadPrec (JSObject e)
$creadPrec :: forall e. Read e => ReadPrec (JSObject e)
readList :: ReadS [JSObject e]
$creadList :: forall e. Read e => ReadS [JSObject e]
readsPrec :: Int -> ReadS (JSObject e)
$creadsPrec :: forall e. Read e => Int -> ReadS (JSObject e)
Read, Typeable )

-- | Make JSON object out of an association list.
toJSObject :: [(String,a)] -> JSObject a
toJSObject :: forall a. [(String, a)] -> JSObject a
toJSObject = forall a. [(String, a)] -> JSObject a
JSONObject

-- | Get the value of a field, if it exist.
get_field :: JSObject a -> String -> Maybe a
get_field :: forall a. JSObject a -> String -> Maybe a
get_field (JSONObject [(String, a)]
xs) String
x = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
x [(String, a)]
xs

-- | Set the value of a field.  Previous values are overwritten.
set_field :: JSObject a -> String -> a -> JSObject a
set_field :: forall a. JSObject a -> String -> a -> JSObject a
set_field (JSONObject [(String, a)]
xs) String
k a
v = forall a. [(String, a)] -> JSObject a
JSONObject ((String
k,a
v) forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= String
k)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) [(String, a)]
xs)