{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}

module Argo.Json.Value where

import Control.Applicative ((<|>))

import qualified Argo.Json.Array as Array
import qualified Argo.Json.Boolean as Boolean
import qualified Argo.Json.Null as Null
import qualified Argo.Json.Number as Number
import qualified Argo.Json.Object as Object
import qualified Argo.Json.String as String
import qualified Argo.Type.Decoder as Decoder
import qualified Argo.Type.Encoder as Encoder
import qualified Argo.Vendor.DeepSeq as DeepSeq
import qualified Argo.Vendor.TemplateHaskell as TH
import qualified Data.String
import qualified GHC.Generics as Generics

-- | A JSON (JavaScript Object Notation) value, as described by RFC 8259.
-- <https://datatracker.ietf.org/doc/html/rfc8259>
data Value
    = Null Null.Null
    | Boolean Boolean.Boolean
    | Number Number.Number
    | String String.String
    | Array (Array.Array Value)
    | Object (Object.Object Value)
    deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, (forall x. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Value x -> Value
$cfrom :: forall x. Value -> Rep Value x
Generics.Generic, Value -> Q Exp
Value -> Q (TExp Value)
(Value -> Q Exp) -> (Value -> Q (TExp Value)) -> Lift Value
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Value -> Q (TExp Value)
$cliftTyped :: Value -> Q (TExp Value)
lift :: Value -> Q Exp
$clift :: Value -> Q Exp
TH.Lift, Value -> ()
(Value -> ()) -> NFData Value
forall a. (a -> ()) -> NFData a
rnf :: Value -> ()
$crnf :: Value -> ()
DeepSeq.NFData, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)

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

encode :: Value -> Encoder.Encoder ()
encode :: Value -> Encoder ()
encode Value
x = case Value
x of
    Null Null
y -> Null -> Encoder ()
Null.encode Null
y
    Boolean Boolean
y -> Boolean -> Encoder ()
Boolean.encode Boolean
y
    Number Number
y -> Number -> Encoder ()
Number.encode Number
y
    String String
y -> String -> Encoder ()
String.encode String
y
    Array Array Value
y -> (Value -> Encoder ()) -> Array Value -> Encoder ()
forall value. (value -> Encoder ()) -> Array value -> Encoder ()
Array.encode Value -> Encoder ()
encode Array Value
y
    Object Object Value
y -> (Value -> Encoder ()) -> Object Value -> Encoder ()
forall value. (value -> Encoder ()) -> Object value -> Encoder ()
Object.encode Value -> Encoder ()
encode Object Value
y

decode :: Decoder.Decoder Value
decode :: Decoder Value
decode =
    (Null -> Value
Null (Null -> Value)
-> StateT ByteString (ExceptT String Identity) Null
-> Decoder Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT ByteString (ExceptT String Identity) Null
Null.decode)
        Decoder Value -> Decoder Value -> Decoder Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Boolean -> Value
Boolean (Boolean -> Value)
-> StateT ByteString (ExceptT String Identity) Boolean
-> Decoder Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT ByteString (ExceptT String Identity) Boolean
Boolean.decode)
        Decoder Value -> Decoder Value -> Decoder Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Number -> Value
Number (Number -> Value)
-> StateT ByteString (ExceptT String Identity) Number
-> Decoder Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT ByteString (ExceptT String Identity) Number
Number.decode)
        Decoder Value -> Decoder Value -> Decoder Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> Value
String (String -> Value)
-> StateT ByteString (ExceptT String Identity) String
-> Decoder Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT ByteString (ExceptT String Identity) String
String.decode)
        Decoder Value -> Decoder Value -> Decoder Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Array Value -> Value
Array (Array Value -> Value)
-> StateT ByteString (ExceptT String Identity) (Array Value)
-> Decoder Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Value
-> StateT ByteString (ExceptT String Identity) (Array Value)
forall value. Decoder value -> Decoder (Array value)
Array.decode Decoder Value
decode)
        Decoder Value -> Decoder Value -> Decoder Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Object Value -> Value
Object (Object Value -> Value)
-> StateT ByteString (ExceptT String Identity) (Object Value)
-> Decoder Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Value
-> StateT ByteString (ExceptT String Identity) (Object Value)
forall value. Decoder value -> Decoder (Object value)
Object.decode Decoder Value
decode)