{-# LANGUAGE DeriveAnyClass #-}

module Hasura.Backends.DataConnector.IR.Scalar.Value
  ( Value (..),
    Literal (..),
    parseValue,
  )
where

--------------------------------------------------------------------------------

import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.Types qualified as J
import Data.Scientific
import Hasura.Backends.DataConnector.API qualified as API
import Hasura.Backends.DataConnector.IR.Scalar.Type qualified as IR.S.T
import Hasura.Incremental (Cacheable)
import Hasura.Prelude
import Witch qualified

--------------------------------------------------------------------------------

-- | Literal scalar values that can appear as leaf nodes in expressions
--
-- NOTE: This type shouldn't _need_ ser/de instances, but they're imposed by
-- the 'Backend' class.
data Value
  = String Text
  | Number Scientific
  | Boolean Bool
  | Null
  deriving stock (Typeable Value
DataType
Constr
Typeable Value
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Value -> c Value)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Value)
-> (Value -> Constr)
-> (Value -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Value))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value))
-> ((forall b. Data b => b -> b) -> Value -> Value)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r)
-> (forall u. (forall d. Data d => d -> u) -> Value -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Value -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Value -> m Value)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Value -> m Value)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Value -> m Value)
-> Data Value
Value -> DataType
Value -> Constr
(forall b. Data b => b -> b) -> Value -> Value
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
forall u. (forall d. Data d => d -> u) -> Value -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
$cNull :: Constr
$cBoolean :: Constr
$cNumber :: Constr
$cString :: Constr
$tValue :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Value -> m Value
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapMp :: (forall d. Data d => d -> m d) -> Value -> m Value
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapM :: (forall d. Data d => d -> m d) -> Value -> m Value
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapQi :: Int -> (forall d. Data d => d -> u) -> Value -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
gmapQ :: (forall d. Data d => d -> u) -> Value -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Value -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
gmapT :: (forall b. Data b => b -> b) -> Value -> Value
$cgmapT :: (forall b. Data b => b -> b) -> Value -> Value
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Value)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
dataTypeOf :: Value -> DataType
$cdataTypeOf :: Value -> DataType
toConstr :: Value -> Constr
$ctoConstr :: Value -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
$cp1Data :: Typeable Value
Data, 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
Generic, Eq Value
Eq Value
-> (Value -> Value -> Ordering)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Value)
-> (Value -> Value -> Value)
-> Ord Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
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 :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmax :: Value -> Value -> Value
>= :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c< :: Value -> Value -> Bool
compare :: Value -> Value -> Ordering
$ccompare :: Value -> Value -> Ordering
$cp1Ord :: Eq Value
Ord, 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)
  deriving anyclass (Eq Value
Eq Value -> (Accesses -> Value -> Value -> Bool) -> Cacheable Value
Accesses -> Value -> Value -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> Value -> Value -> Bool
$cunchanged :: Accesses -> Value -> Value -> Bool
$cp1Cacheable :: Eq Value
Cacheable, Value -> Parser [Value]
Value -> Parser Value
(Value -> Parser Value)
-> (Value -> Parser [Value]) -> FromJSON Value
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Value]
$cparseJSONList :: Value -> Parser [Value]
parseJSON :: Value -> Parser Value
$cparseJSON :: Value -> Parser Value
FromJSON, Int -> Value -> Int
Value -> Int
(Int -> Value -> Int) -> (Value -> Int) -> Hashable Value
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Value -> Int
$chash :: Value -> Int
hashWithSalt :: Int -> Value -> Int
$chashWithSalt :: Int -> Value -> Int
Hashable, Value -> ()
(Value -> ()) -> NFData Value
forall a. (a -> ()) -> NFData a
rnf :: Value -> ()
$crnf :: Value -> ()
NFData, [Value] -> Value
[Value] -> Encoding
Value -> Value
Value -> Encoding
(Value -> Value)
-> (Value -> Encoding)
-> ([Value] -> Value)
-> ([Value] -> Encoding)
-> ToJSON Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Value] -> Encoding
$ctoEncodingList :: [Value] -> Encoding
toJSONList :: [Value] -> Value
$ctoJSONList :: [Value] -> Value
toEncoding :: Value -> Encoding
$ctoEncoding :: Value -> Encoding
toJSON :: Value -> Value
$ctoJSON :: Value -> Value
ToJSON)

instance Witch.From API.Value Value where
  from :: Value -> Value
from = \case
    API.String Text
txt -> Text -> Value
String Text
txt
    API.Number Scientific
x -> Scientific -> Value
Number Scientific
x
    API.Boolean Bool
p -> Bool -> Value
Boolean Bool
p
    Value
API.Null -> Value
Null

instance Witch.From Value API.Value where
  from :: Value -> Value
from = \case
    String Text
txt -> Text -> Value
API.String Text
txt
    Number Scientific
x -> Scientific -> Value
API.Number Scientific
x
    Boolean Bool
p -> Bool -> Value
API.Boolean Bool
p
    Value
Null -> Value
API.Null

data Literal
  = ValueLiteral Value
  | ArrayLiteral [Value]
  deriving stock (Literal -> Literal -> Bool
(Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool) -> Eq Literal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Literal -> Literal -> Bool
$c/= :: Literal -> Literal -> Bool
== :: Literal -> Literal -> Bool
$c== :: Literal -> Literal -> Bool
Eq, Int -> Literal -> ShowS
[Literal] -> ShowS
Literal -> String
(Int -> Literal -> ShowS)
-> (Literal -> String) -> ([Literal] -> ShowS) -> Show Literal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Literal] -> ShowS
$cshowList :: [Literal] -> ShowS
show :: Literal -> String
$cshow :: Literal -> String
showsPrec :: Int -> Literal -> ShowS
$cshowsPrec :: Int -> Literal -> ShowS
Show, (forall x. Literal -> Rep Literal x)
-> (forall x. Rep Literal x -> Literal) -> Generic Literal
forall x. Rep Literal x -> Literal
forall x. Literal -> Rep Literal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Literal x -> Literal
$cfrom :: forall x. Literal -> Rep Literal x
Generic, Eq Literal
Eq Literal
-> (Literal -> Literal -> Ordering)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Literal)
-> (Literal -> Literal -> Literal)
-> Ord Literal
Literal -> Literal -> Bool
Literal -> Literal -> Ordering
Literal -> Literal -> Literal
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 :: Literal -> Literal -> Literal
$cmin :: Literal -> Literal -> Literal
max :: Literal -> Literal -> Literal
$cmax :: Literal -> Literal -> Literal
>= :: Literal -> Literal -> Bool
$c>= :: Literal -> Literal -> Bool
> :: Literal -> Literal -> Bool
$c> :: Literal -> Literal -> Bool
<= :: Literal -> Literal -> Bool
$c<= :: Literal -> Literal -> Bool
< :: Literal -> Literal -> Bool
$c< :: Literal -> Literal -> Bool
compare :: Literal -> Literal -> Ordering
$ccompare :: Literal -> Literal -> Ordering
$cp1Ord :: Eq Literal
Ord)
  deriving anyclass (Eq Literal
Eq Literal
-> (Accesses -> Literal -> Literal -> Bool) -> Cacheable Literal
Accesses -> Literal -> Literal -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> Literal -> Literal -> Bool
$cunchanged :: Accesses -> Literal -> Literal -> Bool
$cp1Cacheable :: Eq Literal
Cacheable, Int -> Literal -> Int
Literal -> Int
(Int -> Literal -> Int) -> (Literal -> Int) -> Hashable Literal
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Literal -> Int
$chash :: Literal -> Int
hashWithSalt :: Int -> Literal -> Int
$chashWithSalt :: Int -> Literal -> Int
Hashable, Literal -> ()
(Literal -> ()) -> NFData Literal
forall a. (a -> ()) -> NFData a
rnf :: Literal -> ()
$crnf :: Literal -> ()
NFData, [Literal] -> Value
[Literal] -> Encoding
Literal -> Value
Literal -> Encoding
(Literal -> Value)
-> (Literal -> Encoding)
-> ([Literal] -> Value)
-> ([Literal] -> Encoding)
-> ToJSON Literal
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Literal] -> Encoding
$ctoEncodingList :: [Literal] -> Encoding
toJSONList :: [Literal] -> Value
$ctoJSONList :: [Literal] -> Value
toEncoding :: Literal -> Encoding
$ctoEncoding :: Literal -> Encoding
toJSON :: Literal -> Value
$ctoJSON :: Literal -> Value
ToJSON)

parseValue :: IR.S.T.Type -> J.Value -> J.Parser Value
parseValue :: Type -> Value -> Parser Value
parseValue Type
type' Value
val =
  case (Type
type', Value
val) of
    (Type
_, Value
J.Null) -> Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
    (Type
IR.S.T.String, Value
value) -> Text -> Value
String (Text -> Value) -> Parser Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
value
    (Type
IR.S.T.Bool, Value
value) -> Bool -> Value
Boolean (Bool -> Value) -> Parser Bool -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Bool
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
value
    (Type
IR.S.T.Number, Value
value) -> Scientific -> Value
Number (Scientific -> Value) -> Parser Scientific -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Scientific
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
value