{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Deriving.Kinded.Value
  ( KindedValue (..),
  )
where

import Control.Monad.Except (MonadError (throwError))
import Data.Morpheus.App.Internal.Resolving
  ( ResolverState,
  )
import Data.Morpheus.Generic
  ( GRep,
    GRepField (..),
    GRepFun (..),
    GRepValue (..),
    deriveValue,
    symbolName,
  )
import Data.Morpheus.Internal.Ext (GQLResult, unsafeFromList)
import Data.Morpheus.Internal.Utils
  ( IsMap (toAssoc),
    fromElems,
  )
import Data.Morpheus.Server.Deriving.Internal.Directive
  ( visitEnumName,
    visitFieldName,
  )
import Data.Morpheus.Server.Deriving.Internal.Value
  ( Context (..),
    DecodeRep (..),
  )
import Data.Morpheus.Server.Deriving.Utils.Kinded
  ( CatType (..),
    Kinded (..),
    inputType,
  )
import Data.Morpheus.Server.Deriving.Utils.Types
  ( coerceInputObject,
    coerceScalar,
    getField,
    handleEither,
  )
import Data.Morpheus.Server.Deriving.Utils.Use
  ( UseDeriving (..),
    UseGQLType (..),
    UseGQLValue (..),
  )
import Data.Morpheus.Server.Types.Kind
  ( CUSTOM,
    DIRECTIVE,
    DerivingKind,
    SCALAR,
    TYPE,
    WRAPPER,
  )
import Data.Morpheus.Server.Types.Types (Arg (Arg))
import Data.Morpheus.Types.GQLScalar
  ( DecodeScalar (..),
    EncodeScalar (..),
  )
import Data.Morpheus.Types.GQLWrapper
  ( DecodeWrapper (..),
    DecodeWrapperConstraint,
    EncodeWrapperValue (encodeWrapperValue),
  )
import Data.Morpheus.Types.Internal.AST
  ( CONST,
    IN,
    ObjectEntry (..),
    VALID,
    ValidValue,
    Value (..),
    internal,
  )
import GHC.Generics
import GHC.TypeLits (KnownSymbol)
import Relude

class KindedValue ctx (k :: DerivingKind) (a :: Type) where
  encodeKindedValue :: (UseDeriving gql args ~ ctx) => ctx -> Kinded k a -> GQLResult (Value CONST)
  decodeKindedValue :: (UseDeriving gql args ~ ctx) => ctx -> Proxy k -> ValidValue -> ResolverState a

instance (EncodeScalar a, DecodeScalar a, ctx ~ UseDeriving gql args, gql a) => KindedValue ctx SCALAR a where
  encodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Kinded SCALAR a -> GQLResult (Value CONST)
encodeKindedValue ctx
_ = Value CONST -> GQLResult (Value CONST)
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value CONST -> GQLResult (Value CONST))
-> (Kinded SCALAR a -> Value CONST)
-> Kinded SCALAR a
-> GQLResult (Value CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarValue -> Value CONST
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value CONST)
-> (Kinded SCALAR a -> ScalarValue)
-> Kinded SCALAR a
-> Value CONST
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ScalarValue
forall a. EncodeScalar a => a -> ScalarValue
encodeScalar (a -> ScalarValue)
-> (Kinded SCALAR a -> a) -> Kinded SCALAR a -> ScalarValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kinded SCALAR a -> a
forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind
  decodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Proxy SCALAR -> ValidValue -> ResolverState a
decodeKindedValue ctx
ctx Proxy SCALAR
_ = TypeName -> ValidValue -> ResolverStateT () Identity ScalarValue
forall (m :: * -> *).
MonadError GQLError m =>
TypeName -> ValidValue -> m ScalarValue
coerceScalar (ctx -> CatType IN a -> TypeName
forall a (c :: TypeCategory).
gql a =>
ctx -> CatType c a -> TypeName
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeName
useTypename ctx
ctx (CatType IN a
forall {k} (a :: k). CatType IN a
InputType :: CatType IN a)) (ValidValue -> ResolverStateT () Identity ScalarValue)
-> (ScalarValue -> ResolverState a)
-> ValidValue
-> ResolverState a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either Text a -> ResolverState a
forall (m :: * -> *) t a.
(MonadError GQLError m, Msg t) =>
Either t a -> m a
handleEither (Either Text a -> ResolverState a)
-> (ScalarValue -> Either Text a) -> ScalarValue -> ResolverState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarValue -> Either Text a
forall a. DecodeScalar a => ScalarValue -> Either Text a
decodeScalar

instance (ctx ~ UseDeriving gql args, DecodeWrapperConstraint f a, DecodeWrapper f, EncodeWrapperValue f, args a) => KindedValue ctx WRAPPER (f a) where
  encodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Kinded WRAPPER (f a) -> GQLResult (Value CONST)
encodeKindedValue ctx
ctx = (a -> GQLResult (Value CONST)) -> f a -> GQLResult (Value CONST)
forall (f :: * -> *) (m :: * -> *) a.
(EncodeWrapperValue f, Monad m) =>
(a -> m (Value CONST)) -> f a -> m (Value CONST)
forall (m :: * -> *) a.
Monad m =>
(a -> m (Value CONST)) -> f a -> m (Value CONST)
encodeWrapperValue (ctx -> a -> GQLResult (Value CONST)
forall a. args a => ctx -> a -> GQLResult (Value CONST)
forall ctx (con :: * -> Constraint) a.
(UseGQLValue ctx con, con a) =>
ctx -> a -> GQLResult (Value CONST)
useEncodeValue ctx
ctx) (f a -> GQLResult (Value CONST))
-> (Kinded WRAPPER (f a) -> f a)
-> Kinded WRAPPER (f a)
-> GQLResult (Value CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kinded WRAPPER (f a) -> f a
forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind
  decodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Proxy WRAPPER -> ValidValue -> ResolverState (f a)
decodeKindedValue ctx
ctx Proxy WRAPPER
_ ValidValue
value =
    ExceptT GQLError (ResolverStateT () Identity) (f a)
-> ResolverStateT () Identity (Either GQLError (f a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ((ValidValue -> ResolverStateT () Identity a)
-> ValidValue
-> ExceptT GQLError (ResolverStateT () Identity) (f a)
forall (f :: * -> *) (m :: * -> *) a.
(DecodeWrapper f, Monad m, DecodeWrapperConstraint f a) =>
(ValidValue -> m a) -> ValidValue -> ExceptT GQLError m (f a)
forall (m :: * -> *) a.
(Monad m, DecodeWrapperConstraint f a) =>
(ValidValue -> m a) -> ValidValue -> ExceptT GQLError m (f a)
decodeWrapper (ctx -> ValidValue -> ResolverStateT () Identity a
forall a. args a => ctx -> ValidValue -> ResolverState a
forall ctx (con :: * -> Constraint) a.
(UseGQLValue ctx con, con a) =>
ctx -> ValidValue -> ResolverState a
useDecodeValue ctx
ctx) ValidValue
value)
      ResolverStateT () Identity (Either GQLError (f a))
-> (Either GQLError (f a) -> ResolverState (f a))
-> ResolverState (f a)
forall a b.
ResolverStateT () Identity a
-> (a -> ResolverStateT () Identity b)
-> ResolverStateT () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either GQLError (f a) -> ResolverState (f a)
forall (m :: * -> *) t a.
(MonadError GQLError m, Msg t) =>
Either t a -> m a
handleEither

instance (ctx ~ UseDeriving gql args, gql a, Generic a, DecodeRep ctx (Rep a), GRep gql args (GQLResult (Value CONST)) (Rep a)) => KindedValue ctx TYPE a where
  encodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Kinded TYPE a -> GQLResult (Value CONST)
encodeKindedValue ctx
ctx =
    GRepValue (GQLResult (Value CONST)) -> GQLResult (Value CONST)
repToValue
      (GRepValue (GQLResult (Value CONST)) -> GQLResult (Value CONST))
-> (Kinded TYPE a -> GRepValue (GQLResult (Value CONST)))
-> Kinded TYPE a
-> GQLResult (Value CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRepFun gql args Identity (GQLResult (Value CONST))
-> a -> GRepValue (GQLResult (Value CONST))
forall a (gql :: * -> Constraint) (constraint :: * -> Constraint)
       value.
(Generic a, GRep gql constraint value (Rep a), gql a) =>
GRepFun gql constraint Identity value -> a -> GRepValue value
deriveValue
        ( GRepFun
            { grepFun :: forall a. args a => Identity a -> GQLResult (Value CONST)
grepFun = ctx -> a -> GQLResult (Value CONST)
forall a. args a => ctx -> a -> GQLResult (Value CONST)
forall ctx (con :: * -> Constraint) a.
(UseGQLValue ctx con, con a) =>
ctx -> a -> GQLResult (Value CONST)
useEncodeValue ctx
ctx (a -> GQLResult (Value CONST))
-> (Identity a -> a) -> Identity a -> GQLResult (Value CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity,
              grepTypename :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
grepTypename = ctx -> CatType IN a -> TypeName
forall a (c :: TypeCategory).
gql a =>
ctx -> CatType c a -> TypeName
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeName
useTypename ctx
ctx (CatType IN a -> TypeName)
-> (proxy a -> CatType IN a) -> proxy a -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy a -> CatType IN a
forall {k} (f :: k -> *) (a :: k). f a -> CatType IN a
inputType,
              grepWrappers :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeWrapper
grepWrappers = ctx -> CatType IN a -> TypeWrapper
forall a (c :: TypeCategory).
gql a =>
ctx -> CatType c a -> TypeWrapper
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeWrapper
useWrappers ctx
ctx (CatType IN a -> TypeWrapper)
-> (proxy a -> CatType IN a) -> proxy a -> TypeWrapper
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy a -> CatType IN a
forall {k} (f :: k -> *) (a :: k). f a -> CatType IN a
inputType
            } ::
            GRepFun gql args Identity (GQLResult (Value CONST))
        )
      (a -> GRepValue (GQLResult (Value CONST)))
-> (Kinded TYPE a -> a)
-> Kinded TYPE a
-> GRepValue (GQLResult (Value CONST))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kinded TYPE a -> a
forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind
  decodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Proxy TYPE -> ValidValue -> ResolverState a
decodeKindedValue ctx
ctx Proxy TYPE
_ = (Rep a Any -> a)
-> ResolverStateT () Identity (Rep a Any) -> ResolverState a
forall a b.
(a -> b)
-> ResolverStateT () Identity a -> ResolverStateT () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (ResolverStateT () Identity (Rep a Any) -> ResolverState a)
-> (ValidValue -> ResolverStateT () Identity (Rep a Any))
-> ValidValue
-> ResolverState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT Context (ResolverStateT () Identity) (Rep a Any)
-> Context -> ResolverStateT () Identity (Rep a Any)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Context
context) (ReaderT Context (ResolverStateT () Identity) (Rep a Any)
 -> ResolverStateT () Identity (Rep a Any))
-> (ValidValue
    -> ReaderT Context (ResolverStateT () Identity) (Rep a Any))
-> ValidValue
-> ResolverStateT () Identity (Rep a Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx
-> ValidValue
-> ReaderT Context (ResolverStateT () Identity) (Rep a Any)
forall a. ctx -> ValidValue -> DecoderT (Rep a a)
forall ctx (f :: * -> *) a.
DecodeRep ctx f =>
ctx -> ValidValue -> DecoderT (f a)
decodeRep ctx
ctx
    where
      context :: Context
context =
        Context
          { isVariantRef :: Bool
isVariantRef = Bool
False,
            typeName :: TypeName
typeName = ctx -> CatType IN a -> TypeName
forall a (c :: TypeCategory).
gql a =>
ctx -> CatType c a -> TypeName
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeName
useTypename ctx
ctx (CatType IN a
forall {k} (a :: k). CatType IN a
InputType :: CatType IN a),
            enumVisitor :: TypeName -> TypeName
enumVisitor = UseDeriving gql args -> Proxy a -> TypeName -> TypeName
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> TypeName -> TypeName
visitEnumName ctx
UseDeriving gql args
ctx Proxy a
proxy,
            fieldVisitor :: FieldName -> FieldName
fieldVisitor = UseDeriving gql args -> Proxy a -> FieldName -> FieldName
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> FieldName -> FieldName
visitFieldName ctx
UseDeriving gql args
ctx Proxy a
proxy
          }
        where
          proxy :: Proxy a
proxy = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a

instance (ctx ~ UseDeriving gql args, gql a, Generic a, DecodeRep ctx (Rep a), GRep gql args (GQLResult (Value CONST)) (Rep a)) => KindedValue ctx DIRECTIVE a where
  encodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Kinded DIRECTIVE a -> GQLResult (Value CONST)
encodeKindedValue ctx
ctx =
    GRepValue (GQLResult (Value CONST)) -> GQLResult (Value CONST)
repToValue
      (GRepValue (GQLResult (Value CONST)) -> GQLResult (Value CONST))
-> (Kinded DIRECTIVE a -> GRepValue (GQLResult (Value CONST)))
-> Kinded DIRECTIVE a
-> GQLResult (Value CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRepFun gql args Identity (GQLResult (Value CONST))
-> a -> GRepValue (GQLResult (Value CONST))
forall a (gql :: * -> Constraint) (constraint :: * -> Constraint)
       value.
(Generic a, GRep gql constraint value (Rep a), gql a) =>
GRepFun gql constraint Identity value -> a -> GRepValue value
deriveValue
        ( GRepFun
            { grepFun :: forall a. args a => Identity a -> GQLResult (Value CONST)
grepFun = ctx -> a -> GQLResult (Value CONST)
forall a. args a => ctx -> a -> GQLResult (Value CONST)
forall ctx (con :: * -> Constraint) a.
(UseGQLValue ctx con, con a) =>
ctx -> a -> GQLResult (Value CONST)
useEncodeValue ctx
ctx (a -> GQLResult (Value CONST))
-> (Identity a -> a) -> Identity a -> GQLResult (Value CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity,
              grepTypename :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
grepTypename = ctx -> CatType IN a -> TypeName
forall a (c :: TypeCategory).
gql a =>
ctx -> CatType c a -> TypeName
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeName
useTypename ctx
ctx (CatType IN a -> TypeName)
-> (proxy a -> CatType IN a) -> proxy a -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy a -> CatType IN a
forall {k} (f :: k -> *) (a :: k). f a -> CatType IN a
inputType,
              grepWrappers :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeWrapper
grepWrappers = ctx -> CatType IN a -> TypeWrapper
forall a (c :: TypeCategory).
gql a =>
ctx -> CatType c a -> TypeWrapper
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeWrapper
useWrappers ctx
ctx (CatType IN a -> TypeWrapper)
-> (proxy a -> CatType IN a) -> proxy a -> TypeWrapper
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy a -> CatType IN a
forall {k} (f :: k -> *) (a :: k). f a -> CatType IN a
inputType
            } ::
            GRepFun gql args Identity (GQLResult (Value CONST))
        )
      (a -> GRepValue (GQLResult (Value CONST)))
-> (Kinded DIRECTIVE a -> a)
-> Kinded DIRECTIVE a
-> GRepValue (GQLResult (Value CONST))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kinded DIRECTIVE a -> a
forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind
  decodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Proxy DIRECTIVE -> ValidValue -> ResolverState a
decodeKindedValue ctx
ctx Proxy DIRECTIVE
_ = (Rep a Any -> a)
-> ResolverStateT () Identity (Rep a Any) -> ResolverState a
forall a b.
(a -> b)
-> ResolverStateT () Identity a -> ResolverStateT () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (ResolverStateT () Identity (Rep a Any) -> ResolverState a)
-> (ValidValue -> ResolverStateT () Identity (Rep a Any))
-> ValidValue
-> ResolverState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT Context (ResolverStateT () Identity) (Rep a Any)
-> Context -> ResolverStateT () Identity (Rep a Any)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Context
context) (ReaderT Context (ResolverStateT () Identity) (Rep a Any)
 -> ResolverStateT () Identity (Rep a Any))
-> (ValidValue
    -> ReaderT Context (ResolverStateT () Identity) (Rep a Any))
-> ValidValue
-> ResolverStateT () Identity (Rep a Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx
-> ValidValue
-> ReaderT Context (ResolverStateT () Identity) (Rep a Any)
forall a. ctx -> ValidValue -> DecoderT (Rep a a)
forall ctx (f :: * -> *) a.
DecodeRep ctx f =>
ctx -> ValidValue -> DecoderT (f a)
decodeRep ctx
ctx
    where
      context :: Context
context =
        Context
          { isVariantRef :: Bool
isVariantRef = Bool
False,
            typeName :: TypeName
typeName = ctx -> CatType IN a -> TypeName
forall a (c :: TypeCategory).
gql a =>
ctx -> CatType c a -> TypeName
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeName
useTypename ctx
ctx (CatType IN a
forall {k} (a :: k). CatType IN a
InputType :: CatType IN a),
            enumVisitor :: TypeName -> TypeName
enumVisitor = UseDeriving gql args -> Proxy a -> TypeName -> TypeName
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> TypeName -> TypeName
visitEnumName ctx
UseDeriving gql args
ctx Proxy a
proxy,
            fieldVisitor :: FieldName -> FieldName
fieldVisitor = UseDeriving gql args -> Proxy a -> FieldName -> FieldName
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> FieldName -> FieldName
visitFieldName ctx
UseDeriving gql args
ctx Proxy a
proxy
          }
        where
          proxy :: Proxy a
proxy = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a

instance KindedValue ctx CUSTOM (Value CONST) where
  encodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Kinded CUSTOM (Value CONST) -> GQLResult (Value CONST)
encodeKindedValue ctx
_ = Value CONST -> GQLResult (Value CONST)
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value CONST -> GQLResult (Value CONST))
-> (Kinded CUSTOM (Value CONST) -> Value CONST)
-> Kinded CUSTOM (Value CONST)
-> GQLResult (Value CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kinded CUSTOM (Value CONST) -> Value CONST
forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind
  decodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Proxy CUSTOM -> ValidValue -> ResolverState (Value CONST)
decodeKindedValue ctx
_ Proxy CUSTOM
_ = Value CONST -> ResolverState (Value CONST)
forall a. a -> ResolverStateT () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value CONST -> ResolverState (Value CONST))
-> (ValidValue -> Value CONST)
-> ValidValue
-> ResolverState (Value CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidValue -> Value CONST
toConstValue

toConstValue :: ValidValue -> Value CONST
toConstValue :: ValidValue -> Value CONST
toConstValue ValidValue
Null = Value CONST
forall (stage :: Stage). Value stage
Null
toConstValue (Enum TypeName
x) = TypeName -> Value CONST
forall (stage :: Stage). TypeName -> Value stage
Enum TypeName
x
toConstValue (Scalar ScalarValue
x) = ScalarValue -> Value CONST
forall (stage :: Stage). ScalarValue -> Value stage
Scalar ScalarValue
x
toConstValue (List [ValidValue]
xs) = [Value CONST] -> Value CONST
forall (stage :: Stage). [Value stage] -> Value stage
List ((ValidValue -> Value CONST) -> [ValidValue] -> [Value CONST]
forall a b. (a -> b) -> [a] -> [b]
map ValidValue -> Value CONST
toConstValue [ValidValue]
xs)
toConstValue (Object Object VALID
fields) = Object CONST -> Value CONST
forall (stage :: Stage). Object stage -> Value stage
Object ((ObjectEntry VALID -> ObjectEntry CONST)
-> Object VALID -> Object CONST
forall a b. (a -> b) -> OrdMap FieldName a -> OrdMap FieldName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ObjectEntry VALID -> ObjectEntry CONST
toEntry Object VALID
fields)
  where
    toEntry :: ObjectEntry VALID -> ObjectEntry CONST
    toEntry :: ObjectEntry VALID -> ObjectEntry CONST
toEntry ObjectEntry {FieldName
ValidValue
entryName :: FieldName
entryValue :: ValidValue
entryName :: forall (s :: Stage). ObjectEntry s -> FieldName
entryValue :: forall (s :: Stage). ObjectEntry s -> Value s
..} = ObjectEntry {entryValue :: Value CONST
entryValue = ValidValue -> Value CONST
toConstValue ValidValue
entryValue, FieldName
entryName :: FieldName
entryName :: FieldName
..}

instance (ctx ~ UseDeriving gql args, KnownSymbol name, args a) => KindedValue ctx CUSTOM (Arg name a) where
  encodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Kinded CUSTOM (Arg name a) -> GQLResult (Value CONST)
encodeKindedValue ctx
_ Kinded CUSTOM (Arg name a)
_ = GQLError -> GQLResult (Value CONST)
forall a. GQLError -> Result GQLError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"directives cant be tagged arguments"
  decodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Proxy CUSTOM -> ValidValue -> ResolverState (Arg name a)
decodeKindedValue ctx
ctx Proxy CUSTOM
_ ValidValue
value = a -> Arg name a
forall (name :: Symbol) a. a -> Arg name a
Arg (a -> Arg name a)
-> ResolverStateT () Identity a -> ResolverState (Arg name a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ValidValue -> ResolverStateT () Identity (Object VALID)
forall (m :: * -> *).
MonadError GQLError m =>
ValidValue -> m (Object VALID)
coerceInputObject ValidValue
value ResolverStateT () Identity (Object VALID)
-> (Object VALID -> ResolverStateT () Identity a)
-> ResolverStateT () Identity a
forall a b.
ResolverStateT () Identity a
-> (a -> ResolverStateT () Identity b)
-> ResolverStateT () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object VALID -> ResolverStateT () Identity a
fieldDecoder)
    where
      fieldDecoder :: Object VALID -> ResolverStateT () Identity a
fieldDecoder = ctx -> ValidValue -> ResolverStateT () Identity a
forall a. args a => ctx -> ValidValue -> ResolverState a
forall ctx (con :: * -> Constraint) a.
(UseGQLValue ctx con, con a) =>
ctx -> ValidValue -> ResolverState a
useDecodeValue ctx
ctx (ValidValue -> ResolverStateT () Identity a)
-> (Object VALID -> ValidValue)
-> Object VALID
-> ResolverStateT () Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Object VALID -> ValidValue
getField FieldName
fieldName
      fieldName :: FieldName
fieldName = Proxy name -> FieldName
forall (a :: Symbol) t (f :: Symbol -> *).
(KnownSymbol a, IsString t) =>
f a -> t
symbolName (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name)

--  Map
instance (ctx ~ UseDeriving gql args, Ord k, args [(k, v)]) => KindedValue ctx CUSTOM (Map k v) where
  decodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Proxy CUSTOM -> ValidValue -> ResolverState (Map k v)
decodeKindedValue ctx
ctx Proxy CUSTOM
_ ValidValue
v = [(k, v)] -> Map k v
forall a. [(k, a)] -> Map k a
forall k (m :: * -> *) a. IsMap k m => [(k, a)] -> m a
unsafeFromList ([(k, v)] -> Map k v)
-> ResolverStateT () Identity [(k, v)] -> ResolverState (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ctx -> ValidValue -> ResolverStateT () Identity [(k, v)]
forall a. args a => ctx -> ValidValue -> ResolverState a
forall ctx (con :: * -> Constraint) a.
(UseGQLValue ctx con, con a) =>
ctx -> ValidValue -> ResolverState a
useDecodeValue ctx
ctx ValidValue
v :: ResolverState [(k, v)])
  encodeKindedValue :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ ctx) =>
ctx -> Kinded CUSTOM (Map k v) -> GQLResult (Value CONST)
encodeKindedValue ctx
ctx = ctx -> [(k, v)] -> GQLResult (Value CONST)
forall a. args a => ctx -> a -> GQLResult (Value CONST)
forall ctx (con :: * -> Constraint) a.
(UseGQLValue ctx con, con a) =>
ctx -> a -> GQLResult (Value CONST)
useEncodeValue ctx
ctx ([(k, v)] -> GQLResult (Value CONST))
-> (Kinded CUSTOM (Map k v) -> [(k, v)])
-> Kinded CUSTOM (Map k v)
-> GQLResult (Value CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall a. Map k a -> [(k, a)]
forall k (m :: * -> *) a. IsMap k m => m a -> [(k, a)]
toAssoc (Map k v -> [(k, v)])
-> (Kinded CUSTOM (Map k v) -> Map k v)
-> Kinded CUSTOM (Map k v)
-> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kinded CUSTOM (Map k v) -> Map k v
forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind

--
repToValue :: GRepValue (GQLResult (Value CONST)) -> GQLResult (Value CONST)
repToValue :: GRepValue (GQLResult (Value CONST)) -> GQLResult (Value CONST)
repToValue GRepValueEnum {TypeName
enumTypeName :: TypeName
enumVariantName :: TypeName
enumTypeName :: forall v. GRepValue v -> TypeName
enumVariantName :: forall v. GRepValue v -> TypeName
..} = Value CONST -> GQLResult (Value CONST)
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value CONST -> GQLResult (Value CONST))
-> Value CONST -> GQLResult (Value CONST)
forall a b. (a -> b) -> a -> b
$ TypeName -> Value CONST
forall (stage :: Stage). TypeName -> Value stage
Enum TypeName
enumVariantName
repToValue GRepValueObject {[GRepField (GQLResult (Value CONST))]
TypeName
objectTypeName :: TypeName
objectFields :: [GRepField (GQLResult (Value CONST))]
objectTypeName :: forall v. GRepValue v -> TypeName
objectFields :: forall v. GRepValue v -> [GRepField v]
..} = Object CONST -> Value CONST
forall (stage :: Stage). Object stage -> Value stage
Object (Object CONST -> Value CONST)
-> Result GQLError (Object CONST) -> GQLResult (Value CONST)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((GRepField (GQLResult (Value CONST))
 -> Result GQLError (ObjectEntry CONST))
-> [GRepField (GQLResult (Value CONST))]
-> Result GQLError [ObjectEntry CONST]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse GRepField (GQLResult (Value CONST))
-> Result GQLError (ObjectEntry CONST)
forall {m :: * -> *} {s :: Stage}.
Monad m =>
GRepField (m (Value s)) -> m (ObjectEntry s)
fromField [GRepField (GQLResult (Value CONST))]
objectFields Result GQLError [ObjectEntry CONST]
-> ([ObjectEntry CONST] -> Result GQLError (Object CONST))
-> Result GQLError (Object CONST)
forall a b.
Result GQLError a -> (a -> Result GQLError b) -> Result GQLError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ObjectEntry CONST] -> Result GQLError (Object CONST)
forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems)
  where
    fromField :: GRepField (m (Value s)) -> m (ObjectEntry s)
fromField GRepField {FieldName
fieldSelector :: FieldName
fieldSelector :: forall a. GRepField a -> FieldName
fieldSelector, m (Value s)
fieldValue :: m (Value s)
fieldValue :: forall a. GRepField a -> a
fieldValue} = do
      Value s
entryValue <- m (Value s)
fieldValue
      ObjectEntry s -> m (ObjectEntry s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ObjectEntry {entryName :: FieldName
entryName = FieldName
fieldSelector, Value s
entryValue :: Value s
entryValue :: Value s
entryValue}
repToValue GRepValue (GQLResult (Value CONST))
_ = GQLError -> GQLResult (Value CONST)
forall a. GQLError -> Result GQLError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal GQLError
"input unions are not supported")