{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Types.Internal.AST.Value
  ( Value (..),
    ScalarValue (..),
    Object,
    GQLValue (..),
    replaceValue,
    decodeScientific,
    RawValue,
    ValidValue,
    RawObject,
    ValidObject,
    Variable (..),
    ResolvedValue,
    ResolvedObject,
    VariableContent (..),
    ObjectEntry (..),
    VariableDefinitions,
  )
where

-- MORPHEUS
import qualified Data.Aeson as A
  ( (.=),
    FromJSON (..),
    ToJSON (..),
    Value (..),
    object,
    pairs,
  )
import Data.Foldable (foldl1)
import qualified Data.HashMap.Lazy as M
import Data.Morpheus.Error.NameCollision
  ( NameCollision (..),
  )
import Data.Morpheus.Ext.OrdMap
  ( OrdMap,
    unsafeFromList,
  )
import Data.Morpheus.Internal.Utils
  ( KeyOf (..),
    elems,
    mapTuple,
  )
import Data.Morpheus.Rendering.RenderGQL
  ( RenderGQL (..),
    fromText,
    renderGQL,
    renderInputSeq,
    space,
  )
import Data.Morpheus.Types.Internal.AST.Base
  ( FieldName,
    FieldName (..),
    Msg (..),
    Position,
    Ref (..),
    TypeName (..),
    TypeRef,
    ValidationError (..),
    msgValidation,
  )
import Data.Morpheus.Types.Internal.AST.Stage
  ( CONST,
    CONST_OR_VALID,
    RAW,
    Stage,
    VALID,
  )
import Data.Scientific
  ( Scientific,
    floatingOrInteger,
  )
import qualified Data.Vector as V
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift (..))
import Relude

-- | Primitive Values for GQLScalar: 'Int', 'Float', 'String', 'Boolean'.
-- for performance reason type 'Text' represents GraphQl 'String' value
data ScalarValue
  = Int Int
  | Float Float
  | String Text
  | Boolean Bool
  | Value A.Value
  deriving (Int -> ScalarValue -> ShowS
[ScalarValue] -> ShowS
ScalarValue -> String
(Int -> ScalarValue -> ShowS)
-> (ScalarValue -> String)
-> ([ScalarValue] -> ShowS)
-> Show ScalarValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScalarValue] -> ShowS
$cshowList :: [ScalarValue] -> ShowS
show :: ScalarValue -> String
$cshow :: ScalarValue -> String
showsPrec :: Int -> ScalarValue -> ShowS
$cshowsPrec :: Int -> ScalarValue -> ShowS
Show, ScalarValue -> ScalarValue -> Bool
(ScalarValue -> ScalarValue -> Bool)
-> (ScalarValue -> ScalarValue -> Bool) -> Eq ScalarValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScalarValue -> ScalarValue -> Bool
$c/= :: ScalarValue -> ScalarValue -> Bool
== :: ScalarValue -> ScalarValue -> Bool
$c== :: ScalarValue -> ScalarValue -> Bool
Eq, (forall x. ScalarValue -> Rep ScalarValue x)
-> (forall x. Rep ScalarValue x -> ScalarValue)
-> Generic ScalarValue
forall x. Rep ScalarValue x -> ScalarValue
forall x. ScalarValue -> Rep ScalarValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScalarValue x -> ScalarValue
$cfrom :: forall x. ScalarValue -> Rep ScalarValue x
Generic, ScalarValue -> Q Exp
ScalarValue -> Q (TExp ScalarValue)
(ScalarValue -> Q Exp)
-> (ScalarValue -> Q (TExp ScalarValue)) -> Lift ScalarValue
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: ScalarValue -> Q (TExp ScalarValue)
$cliftTyped :: ScalarValue -> Q (TExp ScalarValue)
lift :: ScalarValue -> Q Exp
$clift :: ScalarValue -> Q Exp
Lift)

instance RenderGQL ScalarValue where
  render :: ScalarValue -> Rendering
render (Int Int
x) = Int -> Rendering
forall a. RenderGQL a => a -> Rendering
render Int
x
  render (Float Float
x) = Float -> Rendering
forall a. RenderGQL a => a -> Rendering
render Float
x
  render (String Text
x) = Text -> Rendering
forall a. RenderGQL a => a -> Rendering
render Text
x
  render (Boolean Bool
x) = Bool -> Rendering
forall a. RenderGQL a => a -> Rendering
render Bool
x
  render (Value Value
x) = Value -> Rendering
forall a. RenderGQL a => a -> Rendering
render Value
x

instance A.ToJSON ScalarValue where
  toJSON :: ScalarValue -> Value
toJSON (Float Float
x) = Float -> Value
forall a. ToJSON a => a -> Value
A.toJSON Float
x
  toJSON (Int Int
x) = Int -> Value
forall a. ToJSON a => a -> Value
A.toJSON Int
x
  toJSON (Boolean Bool
x) = Bool -> Value
forall a. ToJSON a => a -> Value
A.toJSON Bool
x
  toJSON (String Text
x) = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON Text
x
  toJSON (Value Value
x) = Value -> Value
forall a. ToJSON a => a -> Value
A.toJSON Value
x

instance A.FromJSON ScalarValue where
  parseJSON :: Value -> Parser ScalarValue
parseJSON (A.Bool Bool
v) = ScalarValue -> Parser ScalarValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarValue -> Parser ScalarValue)
-> ScalarValue -> Parser ScalarValue
forall a b. (a -> b) -> a -> b
$ Bool -> ScalarValue
Boolean Bool
v
  parseJSON (A.Number Scientific
v) = ScalarValue -> Parser ScalarValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarValue -> Parser ScalarValue)
-> ScalarValue -> Parser ScalarValue
forall a b. (a -> b) -> a -> b
$ Scientific -> ScalarValue
decodeScientific Scientific
v
  parseJSON (A.String Text
v) = ScalarValue -> Parser ScalarValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarValue -> Parser ScalarValue)
-> ScalarValue -> Parser ScalarValue
forall a b. (a -> b) -> a -> b
$ Text -> ScalarValue
String Text
v
  parseJSON Value
notScalar = String -> Parser ScalarValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ScalarValue) -> String -> Parser ScalarValue
forall a b. (a -> b) -> a -> b
$ String
"Expected Scalar got :" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall b a. (Show a, IsString b) => a -> b
show Value
notScalar

data VariableContent (stage :: Stage) where
  DefaultValue :: Maybe ResolvedValue -> VariableContent CONST
  ValidVariableValue :: {VariableContent VALID -> ValidValue
validVarContent :: ValidValue} -> VariableContent VALID

instance Lift (VariableContent a) where
  lift :: VariableContent a -> Q Exp
lift (DefaultValue Maybe ResolvedValue
x) = [|DefaultValue x|]
  lift (ValidVariableValue ValidValue
x) = [|ValidVariableValue x|]

#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: VariableContent a -> Q (TExp (VariableContent a))
liftTyped (DefaultValue Maybe ResolvedValue
x) = [||DefaultValue x||]
  liftTyped (ValidVariableValue ValidValue
x) = [||ValidVariableValue x||]
#endif
deriving instance Show (VariableContent a)

deriving instance Eq (VariableContent a)

data Variable (stage :: Stage) = Variable
  { Variable stage -> Position
variablePosition :: Position,
    Variable stage -> FieldName
variableName :: FieldName,
    Variable stage -> TypeRef
variableType :: TypeRef,
    Variable stage -> VariableContent (CONST_OR_VALID stage)
variableValue :: VariableContent (CONST_OR_VALID stage)
  }
  deriving (Int -> Variable stage -> ShowS
[Variable stage] -> ShowS
Variable stage -> String
(Int -> Variable stage -> ShowS)
-> (Variable stage -> String)
-> ([Variable stage] -> ShowS)
-> Show (Variable stage)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (stage :: Stage). Int -> Variable stage -> ShowS
forall (stage :: Stage). [Variable stage] -> ShowS
forall (stage :: Stage). Variable stage -> String
showList :: [Variable stage] -> ShowS
$cshowList :: forall (stage :: Stage). [Variable stage] -> ShowS
show :: Variable stage -> String
$cshow :: forall (stage :: Stage). Variable stage -> String
showsPrec :: Int -> Variable stage -> ShowS
$cshowsPrec :: forall (stage :: Stage). Int -> Variable stage -> ShowS
Show, Variable stage -> Variable stage -> Bool
(Variable stage -> Variable stage -> Bool)
-> (Variable stage -> Variable stage -> Bool)
-> Eq (Variable stage)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (stage :: Stage). Variable stage -> Variable stage -> Bool
/= :: Variable stage -> Variable stage -> Bool
$c/= :: forall (stage :: Stage). Variable stage -> Variable stage -> Bool
== :: Variable stage -> Variable stage -> Bool
$c== :: forall (stage :: Stage). Variable stage -> Variable stage -> Bool
Eq, Variable stage -> Q Exp
Variable stage -> Q (TExp (Variable stage))
(Variable stage -> Q Exp)
-> (Variable stage -> Q (TExp (Variable stage)))
-> Lift (Variable stage)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (stage :: Stage). Variable stage -> Q Exp
forall (stage :: Stage).
Variable stage -> Q (TExp (Variable stage))
liftTyped :: Variable stage -> Q (TExp (Variable stage))
$cliftTyped :: forall (stage :: Stage).
Variable stage -> Q (TExp (Variable stage))
lift :: Variable stage -> Q Exp
$clift :: forall (stage :: Stage). Variable stage -> Q Exp
Lift)

instance KeyOf FieldName (Variable s) where
  keyOf :: Variable s -> FieldName
keyOf = Variable s -> FieldName
forall (s :: Stage). Variable s -> FieldName
variableName

instance NameCollision (Variable s) where
  nameCollision :: Variable s -> ValidationError
nameCollision Variable {FieldName
variableName :: FieldName
variableName :: forall (s :: Stage). Variable s -> FieldName
variableName, Position
variablePosition :: Position
variablePosition :: forall (stage :: Stage). Variable stage -> Position
variablePosition} =
    ValidationError :: Message -> [Position] -> ValidationError
ValidationError
      { validationMessage :: Message
validationMessage = Message
"There can Be only One Variable Named " Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg FieldName
variableName,
        validationLocations :: [Position]
validationLocations = [Position
variablePosition]
      }

type VariableDefinitions s = OrdMap FieldName (Variable s)

data Value (stage :: Stage) where
  ResolvedVariable :: Ref -> Variable VALID -> Value CONST
  VariableValue :: Ref -> Value RAW
  Object :: Object stage -> Value stage
  List :: [Value stage] -> Value stage
  Enum :: TypeName -> Value stage
  Scalar :: ScalarValue -> Value stage
  Null :: Value stage

deriving instance Show (Value a)

deriving instance Eq (Value s)

data ObjectEntry (s :: Stage) = ObjectEntry
  { ObjectEntry s -> FieldName
entryName :: FieldName,
    ObjectEntry s -> Value s
entryValue :: Value s
  }
  deriving (ObjectEntry s -> ObjectEntry s -> Bool
(ObjectEntry s -> ObjectEntry s -> Bool)
-> (ObjectEntry s -> ObjectEntry s -> Bool) -> Eq (ObjectEntry s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Stage). ObjectEntry s -> ObjectEntry s -> Bool
/= :: ObjectEntry s -> ObjectEntry s -> Bool
$c/= :: forall (s :: Stage). ObjectEntry s -> ObjectEntry s -> Bool
== :: ObjectEntry s -> ObjectEntry s -> Bool
$c== :: forall (s :: Stage). ObjectEntry s -> ObjectEntry s -> Bool
Eq, Int -> ObjectEntry s -> ShowS
[ObjectEntry s] -> ShowS
ObjectEntry s -> String
(Int -> ObjectEntry s -> ShowS)
-> (ObjectEntry s -> String)
-> ([ObjectEntry s] -> ShowS)
-> Show (ObjectEntry s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> ObjectEntry s -> ShowS
forall (s :: Stage). [ObjectEntry s] -> ShowS
forall (s :: Stage). ObjectEntry s -> String
showList :: [ObjectEntry s] -> ShowS
$cshowList :: forall (s :: Stage). [ObjectEntry s] -> ShowS
show :: ObjectEntry s -> String
$cshow :: forall (s :: Stage). ObjectEntry s -> String
showsPrec :: Int -> ObjectEntry s -> ShowS
$cshowsPrec :: forall (s :: Stage). Int -> ObjectEntry s -> ShowS
Show)

instance RenderGQL (ObjectEntry a) where
  render :: ObjectEntry a -> Rendering
render (ObjectEntry (FieldName Text
name) Value a
value) = Text -> Rendering
fromText Text
name Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
": " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Value a -> Rendering
forall a. RenderGQL a => a -> Rendering
render Value a
value

instance NameCollision (ObjectEntry s) where
  nameCollision :: ObjectEntry s -> ValidationError
nameCollision ObjectEntry {FieldName
entryName :: FieldName
entryName :: forall (s :: Stage). ObjectEntry s -> FieldName
entryName} =
    ValidationError
"There can Be only One field Named " ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> FieldName -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation FieldName
entryName :: ValidationError

instance KeyOf FieldName (ObjectEntry s) where
  keyOf :: ObjectEntry s -> FieldName
keyOf = ObjectEntry s -> FieldName
forall (s :: Stage). ObjectEntry s -> FieldName
entryName

type Object a = OrdMap FieldName (ObjectEntry a)

type ValidObject = Object VALID

type RawObject = Object RAW

type ResolvedObject = Object CONST

type RawValue = Value RAW

type ValidValue = Value VALID

type ResolvedValue = Value CONST

deriving instance Lift (Value a)

deriving instance Lift (ObjectEntry a)

instance RenderGQL (Value a) where
  render :: Value a -> Rendering
render (ResolvedVariable Ref {FieldName
refName :: Ref -> FieldName
refName :: FieldName
refName} Variable VALID
_) = Rendering
"$" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldName -> Rendering
forall a. RenderGQL a => a -> Rendering
render FieldName
refName
  render (VariableValue Ref {FieldName
refName :: FieldName
refName :: Ref -> FieldName
refName}) = Rendering
"$" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldName -> Rendering
forall a. RenderGQL a => a -> Rendering
render FieldName
refName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
" "
  render Value a
Null = Rendering
"null"
  render (Enum TypeName
x) = TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
render TypeName
x
  render (Scalar ScalarValue
x) = ScalarValue -> Rendering
forall a. RenderGQL a => a -> Rendering
render ScalarValue
x
  render (Object Object a
xs) = Rendering
"{" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
entries Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
"}"
    where
      entries :: Rendering
entries
        | [ObjectEntry a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Object a -> [ObjectEntry a]
forall a coll. Elems a coll => coll -> [a]
elems Object a
xs) = Rendering
""
        | Bool
otherwise = Rendering
space Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> [ObjectEntry a] -> Rendering
forall (t :: * -> *) a.
(Foldable t, RenderGQL a) =>
t a -> Rendering
renderInputSeq (Object a -> [ObjectEntry a]
forall a coll. Elems a coll => coll -> [a]
elems Object a
xs) Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
space
  render (List [Value a]
list) = Rendering
"[" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> [Value a] -> Rendering
forall (t :: * -> *) a.
(Foldable t, RenderGQL a) =>
t a -> Rendering
renderInputSeq [Value a]
list Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
"]"

-- render = pack . BS.unpack . A.encode

instance Msg (Value a) where
  msg :: Value a -> Message
msg = ByteString -> Message
forall a. Msg a => a -> Message
msg (ByteString -> Message)
-> (Value a -> ByteString) -> Value a -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> ByteString
forall a. RenderGQL a => a -> ByteString
renderGQL

instance A.ToJSON (Value a) where
  toJSON :: Value a -> Value
toJSON (ResolvedVariable Ref
_ Variable {variableValue :: forall (stage :: Stage).
Variable stage -> VariableContent (CONST_OR_VALID stage)
variableValue = ValidVariableValue ValidValue
x}) =
    ValidValue -> Value
forall a. ToJSON a => a -> Value
A.toJSON ValidValue
x
  toJSON (VariableValue Ref {FieldName
refName :: FieldName
refName :: Ref -> FieldName
refName}) =
    Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"($ref:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldName -> Text
readName FieldName
refName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  toJSON Value a
Null = Value
A.Null
  toJSON (Enum (TypeName Text
x)) = Text -> Value
A.String Text
x
  toJSON (Scalar ScalarValue
x) = ScalarValue -> Value
forall a. ToJSON a => a -> Value
A.toJSON ScalarValue
x
  toJSON (List [Value a]
x) = [Value a] -> Value
forall a. ToJSON a => a -> Value
A.toJSON [Value a]
x
  toJSON (Object Object a
fields) = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (ObjectEntry a -> Pair) -> [ObjectEntry a] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ObjectEntry a -> Pair
forall kv (s :: Stage). KeyValue kv => ObjectEntry s -> kv
toEntry (Object a -> [ObjectEntry a]
forall a coll. Elems a coll => coll -> [a]
elems Object a
fields)
    where
      toEntry :: ObjectEntry s -> kv
toEntry (ObjectEntry (FieldName Text
name) Value s
value) = Text
name Text -> Value -> kv
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Value s -> Value
forall a. ToJSON a => a -> Value
A.toJSON Value s
value

  -------------------------------------------
  toEncoding :: Value a -> Encoding
toEncoding (ResolvedVariable Ref
_ Variable {variableValue :: forall (stage :: Stage).
Variable stage -> VariableContent (CONST_OR_VALID stage)
variableValue = ValidVariableValue ValidValue
x}) =
    ValidValue -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding ValidValue
x
  toEncoding (VariableValue Ref {FieldName
refName :: FieldName
refName :: Ref -> FieldName
refName}) =
    FieldName -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding (FieldName -> Encoding) -> FieldName -> Encoding
forall a b. (a -> b) -> a -> b
$ FieldName
"($ref:" FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
refName FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
")"
  toEncoding Value a
Null = Value -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding Value
A.Null
  toEncoding (Enum TypeName
x) = TypeName -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding TypeName
x
  toEncoding (Scalar ScalarValue
x) = ScalarValue -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding ScalarValue
x
  toEncoding (List [Value a]
x) = [Value a] -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding [Value a]
x
  toEncoding (Object Object a
ordmap)
    | Object a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Object a
ordmap = Value -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding (Value -> Encoding) -> Value -> Encoding
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object []
    | Bool
otherwise = Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ (Series -> Series -> Series) -> [Series] -> Series
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
(<>) ([Series] -> Series) -> [Series] -> Series
forall a b. (a -> b) -> a -> b
$ (ObjectEntry a -> Series) -> [ObjectEntry a] -> [Series]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ObjectEntry a -> Series
forall kv (s :: Stage). KeyValue kv => ObjectEntry s -> kv
encodeField (Object a -> [ObjectEntry a]
forall a coll. Elems a coll => coll -> [a]
elems Object a
ordmap)
    where
      encodeField :: ObjectEntry s -> kv
encodeField (ObjectEntry (FieldName Text
key) Value s
value) = Text
key Text -> Value s -> kv
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Value s
value

decodeScientific :: Scientific -> ScalarValue
decodeScientific :: Scientific -> ScalarValue
decodeScientific Scientific
v = case Scientific -> Either Float Int
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
v of
  Left Float
float -> Float -> ScalarValue
Float Float
float
  Right Int
int -> Int -> ScalarValue
Int Int
int

replaceValue :: A.Value -> Value a
replaceValue :: Value -> Value a
replaceValue (A.Bool Bool
v) = Bool -> Value a
forall a. GQLValue a => Bool -> a
gqlBoolean Bool
v
replaceValue (A.Number Scientific
v) = ScalarValue -> Value a
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value a) -> ScalarValue -> Value a
forall a b. (a -> b) -> a -> b
$ Scientific -> ScalarValue
decodeScientific Scientific
v
replaceValue (A.String Text
v) = Text -> Value a
forall a. GQLValue a => Text -> a
gqlString Text
v
replaceValue (A.Object Object
v) =
  [(FieldName, Value a)] -> Value a
forall a. GQLValue a => [(FieldName, a)] -> a
gqlObject ([(FieldName, Value a)] -> Value a)
-> [(FieldName, Value a)] -> Value a
forall a b. (a -> b) -> a -> b
$
    (Pair -> (FieldName, Value a)) -> [Pair] -> [(FieldName, Value a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ((Text -> FieldName)
-> (Value -> Value a) -> Pair -> (FieldName, Value a)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
mapTuple Text -> FieldName
FieldName Value -> Value a
forall (a :: Stage). Value -> Value a
replaceValue)
      (Object -> [Pair]
forall k v. HashMap k v -> [(k, v)]
M.toList Object
v)
replaceValue (A.Array Array
li) = [Value a] -> Value a
forall a. GQLValue a => [a] -> a
gqlList ((Value -> Value a) -> [Value] -> [Value a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value a
forall (a :: Stage). Value -> Value a
replaceValue (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
li))
replaceValue Value
A.Null = Value a
forall a. GQLValue a => a
gqlNull

instance A.FromJSON (Value a) where
  parseJSON :: Value -> Parser (Value a)
parseJSON = Value a -> Parser (Value a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value a -> Parser (Value a))
-> (Value -> Value a) -> Value -> Parser (Value a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value a
forall (a :: Stage). Value -> Value a
replaceValue

-- DEFAULT VALUES
class GQLValue a where
  gqlNull :: a
  gqlScalar :: ScalarValue -> a
  gqlBoolean :: Bool -> a
  gqlString :: Text -> a
  gqlList :: [a] -> a
  gqlObject :: [(FieldName, a)] -> a

-- build GQL Values for Subscription Resolver
instance GQLValue (Value a) where
  gqlNull :: Value a
gqlNull = Value a
forall (a :: Stage). Value a
Null
  gqlScalar :: ScalarValue -> Value a
gqlScalar = ScalarValue -> Value a
forall (stage :: Stage). ScalarValue -> Value stage
Scalar
  gqlBoolean :: Bool -> Value a
gqlBoolean = ScalarValue -> Value a
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value a)
-> (Bool -> ScalarValue) -> Bool -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ScalarValue
Boolean
  gqlString :: Text -> Value a
gqlString = ScalarValue -> Value a
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value a)
-> (Text -> ScalarValue) -> Text -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ScalarValue
String
  gqlList :: [Value a] -> Value a
gqlList = [Value a] -> Value a
forall (a :: Stage). [Value a] -> Value a
List
  gqlObject :: [(FieldName, Value a)] -> Value a
gqlObject = Object a -> Value a
forall (stage :: Stage). Object stage -> Value stage
Object (Object a -> Value a)
-> ([(FieldName, Value a)] -> Object a)
-> [(FieldName, Value a)]
-> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FieldName, ObjectEntry a)] -> Object a
forall k a. (Hashable k, Eq k) => [(k, a)] -> OrdMap k a
unsafeFromList ([(FieldName, ObjectEntry a)] -> Object a)
-> ([(FieldName, Value a)] -> [(FieldName, ObjectEntry a)])
-> [(FieldName, Value a)]
-> Object a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FieldName, Value a) -> (FieldName, ObjectEntry a))
-> [(FieldName, Value a)] -> [(FieldName, ObjectEntry a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldName, Value a) -> (FieldName, ObjectEntry a)
forall (s :: Stage).
(FieldName, Value s) -> (FieldName, ObjectEntry s)
toEntry
    where
      toEntry :: (FieldName, Value s) -> (FieldName, ObjectEntry s)
toEntry (FieldName
key, Value s
value) = (FieldName
key, FieldName -> Value s -> ObjectEntry s
forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry FieldName
key Value s
value)