{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# 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.Types.GQLType
  ( GQLType (..),
    GQLValue (..),
    InputTypeNamespace (..),
    GQLResolver (..),
    ignoreUndefined,
    withGQL,
    withDir,
    withValue,
    withRes,
    kindedProxy,
    IgnoredResolver,
    enumDirective,
    enumDirective',
    fieldDirective,
    fieldDirective',
    typeDirective,
  )
where

-- MORPHEUS

{- ORMOLU_DISABLE -}
import qualified Data.HashMap.Strict as M
import qualified Language.Haskell.TH as TH
{- ORMOLU_ENABLE -}

import Control.Monad.Except (MonadError (throwError))
import Data.Morpheus.App.Internal.Resolving
  ( MonadResolver,
    Resolver,
    ResolverState,
    ResolverValue,
    SubscriptionField,
  )
import Data.Morpheus.Generic
  ( Gmap,
    symbolName,
  )
import Data.Morpheus.Internal.Ext (GQLResult)
import Data.Morpheus.Internal.Utils (empty, singleton)
import Data.Morpheus.Server.Deriving.Internal.Type
  ( deriveInterfaceDefinition,
    toTypeDefinition,
  )
import Data.Morpheus.Server.Deriving.Kinded.Arguments
  ( DeriveFieldArguments (..),
    HasArguments,
  )
import Data.Morpheus.Server.Deriving.Kinded.Resolver (KindedResolver (..))
import Data.Morpheus.Server.Deriving.Kinded.Type
  ( DERIVE_TYPE,
    DeriveKindedType (..),
    deriveScalarDefinition,
    deriveTypeGuardUnions,
    scanNode,
  )
import Data.Morpheus.Server.Deriving.Kinded.Value (KindedValue (..))
import Data.Morpheus.Server.Deriving.Utils.GScan
  ( FreeCatType,
    ScanRef,
    freeLeaf,
  )
import Data.Morpheus.Server.Deriving.Utils.Kinded
  ( CatType (..),
    Kinded (..),
    inputType,
    isIN,
    mapCat,
  )
import Data.Morpheus.Server.Deriving.Utils.Types (GQLTypeNode (..), GQLTypeNodeExtension (..))
import Data.Morpheus.Server.Deriving.Utils.Use
  ( GQLTypeCTX (..),
    GQLValueCTX (..),
    UseDeriving (..),
    UseGQLType (..),
    UseResolver (..),
  )
import Data.Morpheus.Server.Types.Directives
  ( GDirectiveUsage (..),
    GDirectiveUsages (..),
    GQLDirective (..),
    allUsages,
    applyTypeName,
  )
import Data.Morpheus.Server.Types.Internal
  ( TypeData (..),
    mkTypeData,
  )
import Data.Morpheus.Server.Types.Kind
  ( CUSTOM,
    DIRECTIVE,
    DerivingKind,
    SCALAR,
    TYPE,
    WRAPPER,
  )
import Data.Morpheus.Server.Types.NamedResolvers (NamedResolverT (..))
import Data.Morpheus.Server.Types.TypeName
  ( TypeFingerprint (..),
    typeableFingerprint,
    typeableTypename,
  )
import Data.Morpheus.Server.Types.Types
  ( Arg,
    Pair,
    TypeGuard,
    Undefined (..),
    __typenameUndefined,
  )
import Data.Morpheus.Server.Types.Visitors (VisitType (..))
import Data.Morpheus.Types.ID (ID)
import Data.Morpheus.Types.Internal.AST
  ( ArgumentsDefinition,
    CONST,
    DirectiveLocation (..),
    FieldDefinition,
    FieldName,
    GQLError,
    IN,
    Msg (msg),
    OUT,
    QUERY,
    ScalarDefinition (..),
    TRUE,
    TypeContent (..),
    TypeName,
    TypeRef (..),
    TypeWrapper (..),
    VALID,
    Value (..),
    internal,
    mkBaseType,
    mkField,
    packName,
    toNullable,
    unitTypeName,
  )
import Data.Sequence (Seq)
import Data.Vector (Vector)
import GHC.Generics
import GHC.TypeLits (KnownSymbol)
import Relude hiding (Seq, Undefined, empty, fromList, intercalate)

ignoreUndefined :: forall f a. (GQLType a) => f a -> Maybe (f a)
ignoreUndefined :: forall (f :: * -> *) a. GQLType a => f a -> Maybe (f a)
ignoreUndefined f a
proxy
  | TypeData -> TypeFingerprint
gqlFingerprint (CatType OUT a -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat a -> TypeData
__type (CatType OUT a
forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT a)) TypeFingerprint -> TypeFingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== TypeName -> TypeFingerprint
InternalFingerprint TypeName
__typenameUndefined = Maybe (f a)
forall a. Maybe a
Nothing
  | Bool
otherwise = f a -> Maybe (f a)
forall a. a -> Maybe a
Just f a
proxy

deriveTypeData ::
  forall c (a :: Type).
  (Typeable a) =>
  CatType c a ->
  DirectiveUsages ->
  TypeData
deriveTypeData :: forall (c :: TypeCategory) a.
Typeable a =>
CatType c a -> DirectiveUsages -> TypeData
deriveTypeData CatType c a
proxy GDirectiveUsages {[GDirectiveUsage GQLType GQLValue]
typeDirectives :: [GDirectiveUsage GQLType GQLValue]
typeDirectives :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsages gql args -> [GDirectiveUsage gql args]
typeDirectives} =
  TypeData
    { gqlTypeName :: TypeName
gqlTypeName = (GDirectiveUsage GQLType GQLValue -> TypeName -> TypeName)
-> TypeName -> [GDirectiveUsage GQLType GQLValue] -> TypeName
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (GDirectiveUsage GQLType GQLValue -> Bool -> TypeName -> TypeName
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Bool -> TypeName -> TypeName
`applyTypeName` CatType c a -> Bool
forall {k} (c :: TypeCategory) (a :: k). CatType c a -> Bool
isIN CatType c a
proxy) (Proxy a -> TypeName
forall {k} (a :: k) (f :: k -> *). Typeable a => f a -> TypeName
typeableTypename (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)) [GDirectiveUsage GQLType GQLValue]
typeDirectives,
      gqlWrappers :: TypeWrapper
gqlWrappers = TypeWrapper
mkBaseType,
      gqlFingerprint :: TypeFingerprint
gqlFingerprint = CatType c a -> TypeFingerprint
forall {k} (a :: k) (c :: TypeCategory).
Typeable a =>
CatType c a -> TypeFingerprint
typeableFingerprint CatType c a
proxy
    }

list :: TypeWrapper -> TypeWrapper
list :: TypeWrapper -> TypeWrapper
list = (TypeWrapper -> Bool -> TypeWrapper)
-> Bool -> TypeWrapper -> TypeWrapper
forall a b c. (a -> b -> c) -> b -> a -> c
flip TypeWrapper -> Bool -> TypeWrapper
TypeList Bool
True

wrapper :: (TypeWrapper -> TypeWrapper) -> TypeData -> TypeData
wrapper :: (TypeWrapper -> TypeWrapper) -> TypeData -> TypeData
wrapper TypeWrapper -> TypeWrapper
f TypeData {TypeName
TypeWrapper
TypeFingerprint
gqlFingerprint :: TypeData -> TypeFingerprint
gqlTypeName :: TypeData -> TypeName
gqlWrappers :: TypeData -> TypeWrapper
gqlTypeName :: TypeName
gqlWrappers :: TypeWrapper
gqlFingerprint :: TypeFingerprint
..} = TypeData {gqlWrappers :: TypeWrapper
gqlWrappers = TypeWrapper -> TypeWrapper
f TypeWrapper
gqlWrappers, TypeName
TypeFingerprint
gqlFingerprint :: TypeFingerprint
gqlTypeName :: TypeName
gqlTypeName :: TypeName
gqlFingerprint :: TypeFingerprint
..}

type Lifted a = (PARAM (KIND a) a)

kindedProxy :: f a -> Proxy (f' (KIND a) a)
kindedProxy :: forall (f :: * -> *) a (f' :: DerivingKind -> * -> *).
f a -> Proxy (f' (KIND a) a)
kindedProxy f a
_ = Proxy (f' (KIND a) a)
forall {k} (t :: k). Proxy t
Proxy

kindedCatType :: CatType cat a -> CatType cat (f (KIND a) (Lifted a))
kindedCatType :: forall (cat :: TypeCategory) a (f :: DerivingKind -> * -> *).
CatType cat a -> CatType cat (f (KIND a) (Lifted a))
kindedCatType CatType cat a
InputType = CatType cat (f (KIND a) (PARAM (KIND a) a))
CatType 'IN (f (KIND a) (PARAM (KIND a) a))
forall {k} (a :: k). CatType 'IN a
InputType
kindedCatType CatType cat a
OutputType = CatType cat (f (KIND a) (PARAM (KIND a) a))
CatType OUT (f (KIND a) (PARAM (KIND a) a))
forall {k} (a :: k). CatType OUT a
OutputType

type IgnoredResolver = (Resolver QUERY () Identity)

-- lifts monadic object types with specific monad
type family PARAM k a where
  PARAM TYPE (t m) = t IgnoredResolver
  PARAM k a = a

type DERIVE_T a = (DeriveKindedType WITH_DERIVING (KIND a) (Lifted a))

cantBeInputType :: (MonadError GQLError m, GQLType a) => CatType cat a -> m b
cantBeInputType :: forall (m :: * -> *) a (cat :: TypeCategory) b.
(MonadError GQLError m, GQLType a) =>
CatType cat a -> m b
cantBeInputType CatType cat a
proxy = GQLError -> m b
forall a. GQLError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> m b) -> GQLError -> m b
forall a b. (a -> b) -> a -> b
$ GQLError -> GQLError
internal (GQLError -> GQLError) -> GQLError -> GQLError
forall a b. (a -> b) -> a -> b
$ GQLError
"type " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> TypeName -> GQLError
forall a. Msg a => a -> GQLError
msg (TypeData -> TypeName
gqlTypeName (TypeData -> TypeName) -> TypeData -> TypeName
forall a b. (a -> b) -> a -> b
$ CatType cat a -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat a -> TypeData
__type CatType cat a
proxy) GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
"can't be a input type"

-- | GraphQL type, every graphQL type should have an instance of 'GHC.Generics.Generic' and 'GQLType'.
--
--  @
--    ... deriving (Generic, GQLType)
--  @
--
-- if you want to add description
--
--  @
--       ... deriving (Generic)
--
--     instance GQLType ... where
--        directives _ = typeDirective (Describe "some text")
--  @
class GQLType a where
  type KIND a :: DerivingKind
  type KIND a = TYPE

  directives :: f a -> DirectiveUsages
  directives f a
_ = DirectiveUsages
forall a. Monoid a => a
mempty

  __type :: CatType cat a -> TypeData
  default __type :: (Typeable a) => CatType cat a -> TypeData
  __type CatType cat a
proxy = CatType cat a -> DirectiveUsages -> TypeData
forall (c :: TypeCategory) a.
Typeable a =>
CatType c a -> DirectiveUsages -> TypeData
deriveTypeData CatType cat a
proxy (CatType cat a -> DirectiveUsages
forall a (f :: * -> *). GQLType a => f a -> DirectiveUsages
forall (f :: * -> *). f a -> DirectiveUsages
directives CatType cat a
proxy)

  __deriveType :: CatType c a -> GQLResult (GQLTypeNode c)
  default __deriveType :: (DERIVE_T a) => CatType c a -> GQLResult (GQLTypeNode c)
  __deriveType = WITH_DERIVING
-> CatType c (Any (KIND a) (PARAM (KIND a) a))
-> GQLResult (GQLTypeNode c)
forall {k} ctx (k1 :: DerivingKind) (a :: k) {k2}
       (gql :: * -> Constraint) (v :: * -> Constraint)
       (cat :: TypeCategory) (f :: DerivingKind -> k -> k2).
(DeriveKindedType ctx k1 a, ctx ~ UseDeriving gql v) =>
ctx -> CatType cat (f k1 a) -> GQLResult (GQLTypeNode cat)
forall {k2} (gql :: * -> Constraint) (v :: * -> Constraint)
       (cat :: TypeCategory) (f :: DerivingKind -> * -> k2).
(WITH_DERIVING ~ UseDeriving gql v) =>
WITH_DERIVING
-> CatType cat (f (KIND a) (PARAM (KIND a) a))
-> GQLResult (GQLTypeNode cat)
deriveKindedType WITH_DERIVING
withDir (CatType c (Any (KIND a) (PARAM (KIND a) a))
 -> GQLResult (GQLTypeNode c))
-> (CatType c a -> CatType c (Any (KIND a) (PARAM (KIND a) a)))
-> CatType c a
-> GQLResult (GQLTypeNode c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CatType c a -> CatType c (Any (KIND a) (PARAM (KIND a) a))
forall (cat :: TypeCategory) a (f :: DerivingKind -> * -> *).
CatType cat a -> CatType cat (f (KIND a) (Lifted a))
kindedCatType

  __exploreRef :: CatType c a -> [ScanRef FreeCatType GQLType]
  default __exploreRef :: (DERIVE_T a) => CatType c a -> [ScanRef FreeCatType GQLType]
  __exploreRef = WITH_DERIVING
-> CatType c (Any (KIND a) (PARAM (KIND a) a))
-> [ScanRef FreeCatType GQLType]
forall {k} ctx (k1 :: DerivingKind) (a :: k) {k2}
       (gql :: * -> Constraint) (v :: * -> Constraint)
       (cat :: TypeCategory) (f :: DerivingKind -> k -> k2).
(DeriveKindedType ctx k1 a, ctx ~ UseDeriving gql v) =>
ctx -> CatType cat (f k1 a) -> [ScanRef FreeCatType gql]
forall {k2} (gql :: * -> Constraint) (v :: * -> Constraint)
       (cat :: TypeCategory) (f :: DerivingKind -> * -> k2).
(WITH_DERIVING ~ UseDeriving gql v) =>
WITH_DERIVING
-> CatType cat (f (KIND a) (PARAM (KIND a) a))
-> [ScanRef FreeCatType gql]
exploreKindedRefs WITH_DERIVING
withDir (CatType c (Any (KIND a) (PARAM (KIND a) a))
 -> [ScanRef FreeCatType GQLType])
-> (CatType c a -> CatType c (Any (KIND a) (PARAM (KIND a) a)))
-> CatType c a
-> [ScanRef FreeCatType GQLType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CatType c a -> CatType c (Any (KIND a) (PARAM (KIND a) a))
forall (cat :: TypeCategory) a (f :: DerivingKind -> * -> *).
CatType cat a -> CatType cat (f (KIND a) (Lifted a))
kindedCatType

  __deriveFieldArguments :: CatType c a -> GQLResult (ArgumentsDefinition CONST)
  default __deriveFieldArguments :: (DeriveFieldArguments WITH_GQL (HasArguments a)) => CatType c a -> GQLResult (ArgumentsDefinition CONST)
  __deriveFieldArguments CatType c a
OutputType = WITH_GQL
-> Proxy (HasArguments a) -> GQLResult (ArgumentsDefinition CONST)
forall {k} ctx (a :: k) (f :: k -> *).
DeriveFieldArguments ctx a =>
ctx -> f a -> GQLResult (ArgumentsDefinition CONST)
forall (f :: * -> *).
WITH_GQL
-> f (HasArguments a) -> GQLResult (ArgumentsDefinition CONST)
deriveFieldArguments WITH_GQL
withGQL (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(HasArguments a))
  __deriveFieldArguments CatType c a
InputType = ArgumentsDefinition CONST -> GQLResult (ArgumentsDefinition CONST)
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ArgumentsDefinition CONST
forall coll. Empty coll => coll
empty

instance GQLType Int where
  type KIND Int = SCALAR
  __type :: forall (cat :: TypeCategory). CatType cat Int -> TypeData
__type = TypeName -> CatType cat Int -> TypeData
forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"Int"

instance GQLType Double where
  type KIND Double = SCALAR
  __type :: forall (cat :: TypeCategory). CatType cat Double -> TypeData
__type = TypeName -> CatType cat Double -> TypeData
forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"Float"

instance GQLType Float where
  type KIND Float = SCALAR
  __type :: forall (cat :: TypeCategory). CatType cat Float -> TypeData
__type = TypeName -> CatType cat Float -> TypeData
forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"Float32"

instance GQLType Text where
  type KIND Text = SCALAR
  __type :: forall (cat :: TypeCategory). CatType cat Text -> TypeData
__type = TypeName -> CatType cat Text -> TypeData
forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"String"

instance GQLType Bool where
  type KIND Bool = SCALAR
  __type :: forall (cat :: TypeCategory). CatType cat Bool -> TypeData
__type = TypeName -> CatType cat Bool -> TypeData
forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"Boolean"

instance GQLType ID where
  type KIND ID = SCALAR
  __type :: forall (cat :: TypeCategory). CatType cat ID -> TypeData
__type = TypeName -> CatType cat ID -> TypeData
forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"ID"

instance GQLType (Value CONST) where
  type KIND (Value CONST) = CUSTOM
  __type :: forall (cat :: TypeCategory). CatType cat (Value CONST) -> TypeData
__type = TypeName -> CatType cat (Value CONST) -> TypeData
forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"INTERNAL_VALUE"
  __deriveType :: forall (c :: TypeCategory).
CatType c (Value CONST) -> GQLResult (GQLTypeNode c)
__deriveType = (CatType c (Value CONST) -> ScalarDefinition)
-> WITH_DERIVING
-> CatType c (Value CONST)
-> GQLResult (GQLTypeNode c)
forall (gql :: * -> Constraint) a (cat :: TypeCategory)
       (args :: * -> Constraint).
gql a =>
(CatType cat a -> ScalarDefinition)
-> UseDeriving gql args
-> CatType cat a
-> GQLResult (GQLTypeNode cat)
deriveScalarDefinition (ScalarDefinition -> CatType c (Value CONST) -> ScalarDefinition
forall a b. a -> b -> a
const (ScalarDefinition -> CatType c (Value CONST) -> ScalarDefinition)
-> ScalarDefinition -> CatType c (Value CONST) -> ScalarDefinition
forall a b. (a -> b) -> a -> b
$ (Value VALID -> Either Text (Value VALID)) -> ScalarDefinition
ScalarDefinition Value VALID -> Either Text (Value VALID)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) WITH_DERIVING
withDir
  __exploreRef :: forall (c :: TypeCategory).
CatType c (Value CONST) -> [ScanRef FreeCatType GQLType]
__exploreRef CatType c (Value CONST)
_ = []

-- WRAPPERS
instance GQLType () where
  __type :: forall (cat :: TypeCategory). CatType cat () -> TypeData
__type = TypeName -> CatType cat () -> TypeData
forall a. TypeName -> a -> TypeData
mkTypeData TypeName
unitTypeName

instance (Typeable m) => GQLType (Undefined m) where
  __type :: forall (cat :: TypeCategory). CatType cat (Undefined m) -> TypeData
__type = TypeName -> CatType cat (Undefined m) -> TypeData
forall a. TypeName -> a -> TypeData
mkTypeData TypeName
__typenameUndefined

instance (GQLType a) => GQLType (Maybe a) where
  type KIND (Maybe a) = WRAPPER
  __type :: forall (cat :: TypeCategory). CatType cat (Maybe a) -> TypeData
__type = (TypeWrapper -> TypeWrapper) -> TypeData -> TypeData
wrapper TypeWrapper -> TypeWrapper
forall a. Nullable a => a -> a
toNullable (TypeData -> TypeData)
-> (CatType cat (Maybe a) -> TypeData)
-> CatType cat (Maybe a)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CatType cat a -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat a -> TypeData
__type (CatType cat a -> TypeData)
-> (CatType cat (Maybe a) -> CatType cat a)
-> CatType cat (Maybe a)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> CatType cat (Maybe a) -> CatType cat a
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)

instance (GQLType a) => GQLType [a] where
  type KIND [a] = WRAPPER
  __type :: forall (cat :: TypeCategory). CatType cat [a] -> TypeData
__type = (TypeWrapper -> TypeWrapper) -> TypeData -> TypeData
wrapper TypeWrapper -> TypeWrapper
list (TypeData -> TypeData)
-> (CatType cat [a] -> TypeData) -> CatType cat [a] -> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CatType cat a -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat a -> TypeData
__type (CatType cat a -> TypeData)
-> (CatType cat [a] -> CatType cat a)
-> CatType cat [a]
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> CatType cat [a] -> CatType cat a
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)

instance (GQLType a) => GQLType (Set a) where
  type KIND (Set a) = WRAPPER
  __type :: forall (cat :: TypeCategory). CatType cat (Set a) -> TypeData
__type = CatType cat [a] -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat [a] -> TypeData
__type (CatType cat [a] -> TypeData)
-> (CatType cat (Set a) -> CatType cat [a])
-> CatType cat (Set a)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy [a] -> CatType cat (Set a) -> CatType cat [a]
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @[a])

instance (GQLType a) => GQLType (NonEmpty a) where
  type KIND (NonEmpty a) = WRAPPER
  __type :: forall (cat :: TypeCategory). CatType cat (NonEmpty a) -> TypeData
__type = CatType cat [a] -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat [a] -> TypeData
__type (CatType cat [a] -> TypeData)
-> (CatType cat (NonEmpty a) -> CatType cat [a])
-> CatType cat (NonEmpty a)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy [a] -> CatType cat (NonEmpty a) -> CatType cat [a]
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @[a])

instance (GQLType a) => GQLType (Seq a) where
  type KIND (Seq a) = WRAPPER
  __type :: forall (cat :: TypeCategory). CatType cat (Seq a) -> TypeData
__type = CatType cat [a] -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat [a] -> TypeData
__type (CatType cat [a] -> TypeData)
-> (CatType cat (Seq a) -> CatType cat [a])
-> CatType cat (Seq a)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy [a] -> CatType cat (Seq a) -> CatType cat [a]
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @[a])

instance (GQLType a) => GQLType (Vector a) where
  type KIND (Vector a) = WRAPPER
  __type :: forall (cat :: TypeCategory). CatType cat (Vector a) -> TypeData
__type = CatType cat [a] -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat [a] -> TypeData
__type (CatType cat [a] -> TypeData)
-> (CatType cat (Vector a) -> CatType cat [a])
-> CatType cat (Vector a)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy [a] -> CatType cat (Vector a) -> CatType cat [a]
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @[a])

instance (GQLType a) => GQLType (SubscriptionField a) where
  type KIND (SubscriptionField a) = WRAPPER
  __type :: forall (cat :: TypeCategory).
CatType cat (SubscriptionField a) -> TypeData
__type = CatType cat a -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat a -> TypeData
__type (CatType cat a -> TypeData)
-> (CatType cat (SubscriptionField a) -> CatType cat a)
-> CatType cat (SubscriptionField a)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> CatType cat (SubscriptionField a) -> CatType cat a
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
  __exploreRef :: forall (c :: TypeCategory).
CatType c (SubscriptionField a) -> [ScanRef FreeCatType GQLType]
__exploreRef = CatType c a -> [ScanRef FreeCatType GQLType]
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> [ScanRef FreeCatType GQLType]
forall (c :: TypeCategory).
CatType c a -> [ScanRef FreeCatType GQLType]
__exploreRef (CatType c a -> [ScanRef FreeCatType GQLType])
-> (CatType c (SubscriptionField a) -> CatType c a)
-> CatType c (SubscriptionField a)
-> [ScanRef FreeCatType GQLType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> CatType c (SubscriptionField a) -> CatType c a
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)

instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (Pair a b) where
  directives :: forall (f :: * -> *). f (Pair a b) -> DirectiveUsages
directives f (Pair a b)
_ = InputTypeNamespace -> DirectiveUsages
forall a. DirectiveConstraint a => a -> DirectiveUsages
typeDirective InputTypeNamespace {inputTypeNamespace :: Text
inputTypeNamespace = Text
"Input"}

-- Manual

instance (GQLType b, GQLType a, Gmap GQLType (Rep a)) => GQLType (a -> b) where
  type KIND (a -> b) = CUSTOM
  __type :: forall (cat :: TypeCategory). CatType cat (a -> b) -> TypeData
__type = CatType cat b -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat b -> TypeData
__type (CatType cat b -> TypeData)
-> (CatType cat (a -> b) -> CatType cat b)
-> CatType cat (a -> b)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy b -> CatType cat (a -> b) -> CatType cat b
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
  __deriveType :: forall (c :: TypeCategory).
CatType c (a -> b) -> GQLResult (GQLTypeNode c)
__deriveType CatType c (a -> b)
OutputType = CatType c b -> GQLResult (GQLTypeNode c)
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> GQLResult (GQLTypeNode c)
forall (c :: TypeCategory).
CatType c b -> GQLResult (GQLTypeNode c)
__deriveType (CatType OUT b
forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT b)
  __deriveType CatType c (a -> b)
proxy = CatType c (a -> b) -> GQLResult (GQLTypeNode c)
forall (m :: * -> *) a (cat :: TypeCategory) b.
(MonadError GQLError m, GQLType a) =>
CatType cat a -> m b
cantBeInputType CatType c (a -> b)
proxy
  __exploreRef :: forall (c :: TypeCategory).
CatType c (a -> b) -> [ScanRef FreeCatType GQLType]
__exploreRef CatType c (a -> b)
_ =
    Bool -> WITH_GQL -> CatType 'IN a -> [ScanRef FreeCatType GQLType]
forall (c :: * -> Constraint) a (gql :: * -> Constraint) ctx
       (k :: TypeCategory).
(c a, gql a, UseGQLType ctx gql, Gmap c (Rep a)) =>
Bool -> ctx -> CatType k a -> [ScanRef FreeCatType c]
scanNode Bool
False WITH_GQL
withGQL (CatType 'IN a
forall {k} (a :: k). CatType 'IN a
InputType :: CatType IN a)
      [ScanRef FreeCatType GQLType]
-> [ScanRef FreeCatType GQLType] -> [ScanRef FreeCatType GQLType]
forall a. Semigroup a => a -> a -> a
<> CatType OUT b -> [ScanRef FreeCatType GQLType]
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> [ScanRef FreeCatType GQLType]
forall (c :: TypeCategory).
CatType c b -> [ScanRef FreeCatType GQLType]
__exploreRef (CatType OUT b
forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT b)

instance (GQLType k, GQLType v, Typeable k, Typeable v) => GQLType (Map k v) where
  type KIND (Map k v) = CUSTOM
  __type :: forall (cat :: TypeCategory). CatType cat (Map k v) -> TypeData
__type = CatType cat [Pair k v] -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat [Pair k v] -> TypeData
__type (CatType cat [Pair k v] -> TypeData)
-> (CatType cat (Map k v) -> CatType cat [Pair k v])
-> CatType cat (Map k v)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy [Pair k v] -> CatType cat (Map k v) -> CatType cat [Pair k v]
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @[Pair k v])
  __deriveType :: forall (c :: TypeCategory).
CatType c (Map k v) -> GQLResult (GQLTypeNode c)
__deriveType = CatType c [(k, v)] -> GQLResult (GQLTypeNode c)
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> GQLResult (GQLTypeNode c)
forall (c :: TypeCategory).
CatType c [(k, v)] -> GQLResult (GQLTypeNode c)
__deriveType (CatType c [(k, v)] -> GQLResult (GQLTypeNode c))
-> (CatType c (Map k v) -> CatType c [(k, v)])
-> CatType c (Map k v)
-> GQLResult (GQLTypeNode c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy [(k, v)] -> CatType c (Map k v) -> CatType c [(k, v)]
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @[(k, v)])
  __exploreRef :: forall (c :: TypeCategory).
CatType c (Map k v) -> [ScanRef FreeCatType GQLType]
__exploreRef = CatType c (Pair k v) -> [ScanRef FreeCatType GQLType]
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> [ScanRef FreeCatType GQLType]
forall (c :: TypeCategory).
CatType c (Pair k v) -> [ScanRef FreeCatType GQLType]
__exploreRef (CatType c (Pair k v) -> [ScanRef FreeCatType GQLType])
-> (CatType c (Map k v) -> CatType c (Pair k v))
-> CatType c (Map k v)
-> [ScanRef FreeCatType GQLType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (Pair k v) -> CatType c (Map k v) -> CatType c (Pair k v)
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Pair k v))

instance (GQLType a) => GQLType (Resolver o e m a) where
  type KIND (Resolver o e m a) = CUSTOM
  __type :: forall (cat :: TypeCategory).
CatType cat (Resolver o e m a) -> TypeData
__type = CatType cat a -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat a -> TypeData
__type (CatType cat a -> TypeData)
-> (CatType cat (Resolver o e m a) -> CatType cat a)
-> CatType cat (Resolver o e m a)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> CatType cat (Resolver o e m a) -> CatType cat a
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
  __deriveType :: forall (c :: TypeCategory).
CatType c (Resolver o e m a) -> GQLResult (GQLTypeNode c)
__deriveType = CatType c a -> GQLResult (GQLTypeNode c)
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> GQLResult (GQLTypeNode c)
forall (c :: TypeCategory).
CatType c a -> GQLResult (GQLTypeNode c)
__deriveType (CatType c a -> GQLResult (GQLTypeNode c))
-> (CatType c (Resolver o e m a) -> CatType c a)
-> CatType c (Resolver o e m a)
-> GQLResult (GQLTypeNode c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> CatType c (Resolver o e m a) -> CatType c a
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
  __exploreRef :: forall (c :: TypeCategory).
CatType c (Resolver o e m a) -> [ScanRef FreeCatType GQLType]
__exploreRef = CatType c a -> [ScanRef FreeCatType GQLType]
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> [ScanRef FreeCatType GQLType]
forall (c :: TypeCategory).
CatType c a -> [ScanRef FreeCatType GQLType]
__exploreRef (CatType c a -> [ScanRef FreeCatType GQLType])
-> (CatType c (Resolver o e m a) -> CatType c a)
-> CatType c (Resolver o e m a)
-> [ScanRef FreeCatType GQLType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> CatType c (Resolver o e m a) -> CatType c a
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)

instance (Typeable k, Typeable v, GQLType k, GQLType v) => GQLType (k, v) where
  __type :: forall (cat :: TypeCategory). CatType cat (k, v) -> TypeData
__type = CatType cat (Pair k v) -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat (Pair k v) -> TypeData
__type (CatType cat (Pair k v) -> TypeData)
-> (CatType cat (k, v) -> CatType cat (Pair k v))
-> CatType cat (k, v)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (Pair k v) -> CatType cat (k, v) -> CatType cat (Pair k v)
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Pair k v))
  directives :: forall (f :: * -> *). f (k, v) -> DirectiveUsages
directives f (k, v)
_ = InputTypeNamespace -> DirectiveUsages
forall a. DirectiveConstraint a => a -> DirectiveUsages
typeDirective InputTypeNamespace {inputTypeNamespace :: Text
inputTypeNamespace = Text
"Input"}
  __exploreRef :: forall (c :: TypeCategory).
CatType c (k, v) -> [ScanRef FreeCatType GQLType]
__exploreRef = CatType c (Pair k v) -> [ScanRef FreeCatType GQLType]
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> [ScanRef FreeCatType GQLType]
forall (c :: TypeCategory).
CatType c (Pair k v) -> [ScanRef FreeCatType GQLType]
__exploreRef (CatType c (Pair k v) -> [ScanRef FreeCatType GQLType])
-> (CatType c (k, v) -> CatType c (Pair k v))
-> CatType c (k, v)
-> [ScanRef FreeCatType GQLType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (Pair k v) -> CatType c (k, v) -> CatType c (Pair k v)
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Pair k v))

instance (KnownSymbol name, GQLType value) => GQLType (Arg name value) where
  type KIND (Arg name value) = CUSTOM
  __type :: forall (cat :: TypeCategory).
CatType cat (Arg name value) -> TypeData
__type = CatType cat value -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat value -> TypeData
__type (CatType cat value -> TypeData)
-> (CatType cat (Arg name value) -> CatType cat value)
-> CatType cat (Arg name value)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy value -> CatType cat (Arg name value) -> CatType cat value
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @value)
  __deriveType :: forall (c :: TypeCategory).
CatType c (Arg name value) -> GQLResult (GQLTypeNode c)
__deriveType CatType c (Arg name value)
OutputType = CatType OUT (Arg name value) -> Result GQLError (GQLTypeNode c)
forall (m :: * -> *) a (cat :: TypeCategory) b.
(MonadError GQLError m, GQLType a) =>
CatType cat a -> m b
cantBeInputType (CatType OUT (Arg name value)
forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT (Arg name value))
  __deriveType p :: CatType c (Arg name value)
p@CatType c (Arg name value)
InputType = (TypeDefinition c CONST -> [GQLTypeNodeExtension] -> GQLTypeNode c
forall (c :: TypeCategory).
TypeDefinition c CONST -> [GQLTypeNodeExtension] -> GQLTypeNode c
`GQLTypeNode` []) (TypeDefinition c CONST -> GQLTypeNode c)
-> Result GQLError (TypeDefinition c CONST)
-> Result GQLError (GQLTypeNode c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WITH_DERIVING
-> CatType c (Arg name value)
-> TypeContent 'True c CONST
-> Result GQLError (TypeDefinition c CONST)
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (c :: TypeCategory) (cat :: TypeCategory).
gql a =>
UseDeriving gql args
-> CatType c a
-> TypeContent 'True cat CONST
-> GQLResult (TypeDefinition cat CONST)
toTypeDefinition WITH_DERIVING
withDir CatType c (Arg name value)
p TypeContent 'True c CONST
TypeContent 'True 'IN CONST
content
    where
      content :: TypeContent TRUE IN CONST
      content :: TypeContent 'True 'IN CONST
content = FieldsDefinition 'IN CONST
-> TypeContent (INPUT_OBJECT <=? 'IN) 'IN CONST
forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition 'IN s -> TypeContent (INPUT_OBJECT <=? a) a s
DataInputObject (FieldName
-> FieldDefinition 'IN CONST -> FieldsDefinition 'IN CONST
forall a. FieldName -> a -> OrdMap FieldName a
forall k (m :: * -> *) a. IsMap k m => k -> a -> m a
singleton FieldName
argName FieldDefinition 'IN CONST
field)
      argName :: FieldName
argName = 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)
      field :: FieldDefinition IN CONST
      field :: FieldDefinition 'IN CONST
field = Maybe (FieldContent 'True 'IN CONST)
-> FieldName -> TypeRef -> FieldDefinition 'IN CONST
forall (cat :: TypeCategory) (s :: Stage).
Maybe (FieldContent 'True cat s)
-> FieldName -> TypeRef -> FieldDefinition cat s
mkField Maybe (FieldContent 'True 'IN CONST)
forall a. Maybe a
Nothing FieldName
argName (TypeName -> TypeWrapper -> TypeRef
TypeRef TypeName
gqlTypeName TypeWrapper
gqlWrappers)
      TypeData {TypeName
gqlTypeName :: TypeData -> TypeName
gqlTypeName :: TypeName
gqlTypeName, TypeWrapper
gqlWrappers :: TypeData -> TypeWrapper
gqlWrappers :: TypeWrapper
gqlWrappers} = CatType 'IN value -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat value -> TypeData
__type (CatType 'IN value
forall {k} (a :: k). CatType 'IN a
InputType :: CatType IN value)

  __exploreRef :: forall (c :: TypeCategory).
CatType c (Arg name value) -> [ScanRef FreeCatType GQLType]
__exploreRef CatType c (Arg name value)
OutputType = []
  __exploreRef CatType c (Arg name value)
InputType = CatType 'IN value -> [ScanRef FreeCatType GQLType]
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> [ScanRef FreeCatType GQLType]
forall (c :: TypeCategory).
CatType c value -> [ScanRef FreeCatType GQLType]
__exploreRef (CatType 'IN value
forall {k} (a :: k). CatType 'IN a
InputType :: CatType IN value)

instance (DERIVE_TYPE GQLType i, DERIVE_TYPE GQLType u) => GQLType (TypeGuard i u) where
  type KIND (TypeGuard i u) = CUSTOM
  __type :: forall (cat :: TypeCategory).
CatType cat (TypeGuard i u) -> TypeData
__type = CatType cat i -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat i -> TypeData
__type (CatType cat i -> TypeData)
-> (CatType cat (TypeGuard i u) -> CatType cat i)
-> CatType cat (TypeGuard i u)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy i -> CatType cat (TypeGuard i u) -> CatType cat i
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @i)
  __deriveType :: forall (c :: TypeCategory).
CatType c (TypeGuard i u) -> GQLResult (GQLTypeNode c)
__deriveType CatType c (TypeGuard i u)
OutputType = do
    [TypeName]
unions <- TypeProxy GQLType GQLValue OUT u -> GQLResult [TypeName]
forall (gql :: * -> Constraint) a (args :: * -> Constraint).
DERIVE_TYPE gql a =>
TypeProxy gql args OUT a -> GQLResult [TypeName]
deriveTypeGuardUnions (WITH_DERIVING
withDir, CatType OUT u
union)
    let imp :: GQLTypeNodeExtension
imp = TypeName -> [TypeName] -> GQLTypeNodeExtension
ImplementsExtension (WITH_GQL -> CatType OUT i -> TypeName
forall a (c :: TypeCategory).
GQLType a =>
WITH_GQL -> CatType c a -> TypeName
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeName
useTypename WITH_GQL
withGQL CatType OUT i
interface) [TypeName]
unions
    (TypeDefinition OUT CONST
cont, [GQLTypeNodeExtension]
ext) <- WITH_DERIVING
-> CatType OUT i
-> GQLResult (TypeDefinition OUT CONST, [GQLTypeNodeExtension])
forall (gql :: * -> Constraint) a (args :: * -> Constraint).
DERIVE_TYPE gql a =>
UseDeriving gql args
-> CatType OUT a
-> GQLResult (TypeDefinition OUT CONST, [GQLTypeNodeExtension])
deriveInterfaceDefinition WITH_DERIVING
withDir CatType OUT i
interface
    GQLTypeNode c -> GQLResult (GQLTypeNode c)
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GQLTypeNode c -> GQLResult (GQLTypeNode c))
-> GQLTypeNode c -> GQLResult (GQLTypeNode c)
forall a b. (a -> b) -> a -> b
$ TypeDefinition c CONST -> [GQLTypeNodeExtension] -> GQLTypeNode c
forall (c :: TypeCategory).
TypeDefinition c CONST -> [GQLTypeNodeExtension] -> GQLTypeNode c
GQLTypeNode TypeDefinition c CONST
TypeDefinition OUT CONST
cont (GQLTypeNodeExtension
imp GQLTypeNodeExtension
-> [GQLTypeNodeExtension] -> [GQLTypeNodeExtension]
forall a. a -> [a] -> [a]
: [GQLTypeNodeExtension]
ext)
    where
      interface :: CatType OUT i
interface = CatType OUT i
forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT i
      union :: CatType OUT u
union = CatType OUT u
forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT u
  __deriveType CatType c (TypeGuard i u)
proxy = CatType c (TypeGuard i u) -> GQLResult (GQLTypeNode c)
forall (m :: * -> *) a (cat :: TypeCategory) b.
(MonadError GQLError m, GQLType a) =>
CatType cat a -> m b
cantBeInputType CatType c (TypeGuard i u)
proxy
  __exploreRef :: forall (c :: TypeCategory).
CatType c (TypeGuard i u) -> [ScanRef FreeCatType GQLType]
__exploreRef CatType c (TypeGuard i u)
InputType = []
  __exploreRef ref :: CatType c (TypeGuard i u)
ref@CatType c (TypeGuard i u)
OutputType =
    [TypeFingerprint
-> CatType c (TypeGuard i u) -> ScanRef FreeCatType GQLType
forall (c1 :: * -> Constraint) a (c2 :: TypeCategory).
c1 a =>
TypeFingerprint -> CatType c2 a -> ScanRef FreeCatType c1
freeLeaf (WITH_GQL -> CatType c (TypeGuard i u) -> TypeFingerprint
forall a (c :: TypeCategory).
GQLType a =>
WITH_GQL -> CatType c a -> TypeFingerprint
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeFingerprint
useFingerprint WITH_GQL
withGQL CatType c (TypeGuard i u)
ref) CatType c (TypeGuard i u)
ref]
      [ScanRef FreeCatType GQLType]
-> [ScanRef FreeCatType GQLType] -> [ScanRef FreeCatType GQLType]
forall a. Semigroup a => a -> a -> a
<> CatType OUT u -> [ScanRef FreeCatType GQLType]
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> [ScanRef FreeCatType GQLType]
forall (c :: TypeCategory).
CatType c u -> [ScanRef FreeCatType GQLType]
__exploreRef CatType OUT u
union
      [ScanRef FreeCatType GQLType]
-> [ScanRef FreeCatType GQLType] -> [ScanRef FreeCatType GQLType]
forall a. Semigroup a => a -> a -> a
<> CatType OUT i -> [ScanRef FreeCatType GQLType]
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> [ScanRef FreeCatType GQLType]
forall (c :: TypeCategory).
CatType c i -> [ScanRef FreeCatType GQLType]
__exploreRef CatType OUT i
interface
    where
      interface :: CatType OUT i
interface = CatType OUT i
forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT i
      union :: CatType OUT u
union = CatType OUT u
forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT u

instance (GQLType a) => GQLType (NamedResolverT m a) where
  type KIND (NamedResolverT m a) = CUSTOM
  __type :: forall (cat :: TypeCategory).
CatType cat (NamedResolverT m a) -> TypeData
__type = CatType cat a -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat a -> TypeData
__type (CatType cat a -> TypeData)
-> (CatType cat (NamedResolverT m a) -> CatType cat a)
-> CatType cat (NamedResolverT m a)
-> TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> CatType cat (NamedResolverT m a) -> CatType cat a
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
  __deriveType :: forall (c :: TypeCategory).
CatType c (NamedResolverT m a) -> GQLResult (GQLTypeNode c)
__deriveType = CatType c a -> GQLResult (GQLTypeNode c)
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> GQLResult (GQLTypeNode c)
forall (c :: TypeCategory).
CatType c a -> GQLResult (GQLTypeNode c)
__deriveType (CatType c a -> GQLResult (GQLTypeNode c))
-> (CatType c (NamedResolverT m a) -> CatType c a)
-> CatType c (NamedResolverT m a)
-> GQLResult (GQLTypeNode c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> CatType c (NamedResolverT m a) -> CatType c a
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
  __deriveFieldArguments :: forall (c :: TypeCategory).
CatType c (NamedResolverT m a)
-> GQLResult (ArgumentsDefinition CONST)
__deriveFieldArguments = CatType c a -> GQLResult (ArgumentsDefinition CONST)
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> GQLResult (ArgumentsDefinition CONST)
forall (c :: TypeCategory).
CatType c a -> GQLResult (ArgumentsDefinition CONST)
__deriveFieldArguments (CatType c a -> GQLResult (ArgumentsDefinition CONST))
-> (CatType c (NamedResolverT m a) -> CatType c a)
-> CatType c (NamedResolverT m a)
-> GQLResult (ArgumentsDefinition CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> CatType c (NamedResolverT m a) -> CatType c a
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
  __exploreRef :: forall (c :: TypeCategory).
CatType c (NamedResolverT m a) -> [ScanRef FreeCatType GQLType]
__exploreRef = CatType c a -> [ScanRef FreeCatType GQLType]
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> [ScanRef FreeCatType GQLType]
forall (c :: TypeCategory).
CatType c a -> [ScanRef FreeCatType GQLType]
__exploreRef (CatType c a -> [ScanRef FreeCatType GQLType])
-> (CatType c (NamedResolverT m a) -> CatType c a)
-> CatType c (NamedResolverT m a)
-> [ScanRef FreeCatType GQLType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> CatType c (NamedResolverT m a) -> CatType c a
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
mapCat (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

type DirectiveUsages = GDirectiveUsages GQLType GQLValue

type DirectiveConstraint a = (GQLDirective a, GQLType a, KIND a ~ DIRECTIVE, GQLValue a)

type DirectiveUsage = GDirectiveUsage GQLType GQLValue

newtype InputTypeNamespace = InputTypeNamespace {InputTypeNamespace -> Text
inputTypeNamespace :: Text}
  deriving ((forall x. InputTypeNamespace -> Rep InputTypeNamespace x)
-> (forall x. Rep InputTypeNamespace x -> InputTypeNamespace)
-> Generic InputTypeNamespace
forall x. Rep InputTypeNamespace x -> InputTypeNamespace
forall x. InputTypeNamespace -> Rep InputTypeNamespace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InputTypeNamespace -> Rep InputTypeNamespace x
from :: forall x. InputTypeNamespace -> Rep InputTypeNamespace x
$cto :: forall x. Rep InputTypeNamespace x -> InputTypeNamespace
to :: forall x. Rep InputTypeNamespace x -> InputTypeNamespace
Generic)

instance GQLType InputTypeNamespace where
  type KIND InputTypeNamespace = DIRECTIVE

instance GQLDirective InputTypeNamespace where
  excludeFromSchema :: forall (f :: * -> *). f InputTypeNamespace -> Bool
excludeFromSchema f InputTypeNamespace
_ = Bool
True
  type
    DIRECTIVE_LOCATIONS InputTypeNamespace =
      '[ 'LOCATION_OBJECT,
         'LOCATION_ENUM,
         'LOCATION_INPUT_OBJECT,
         'LOCATION_UNION,
         'LOCATION_SCALAR,
         'LOCATION_INTERFACE
       ]

instance VisitType InputTypeNamespace where
  visitTypeName :: InputTypeNamespace -> Bool -> Text -> Text
visitTypeName InputTypeNamespace {Text
inputTypeNamespace :: InputTypeNamespace -> Text
inputTypeNamespace :: Text
inputTypeNamespace} Bool
isInput Text
name
    | Bool
isInput = Text
inputTypeNamespace Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
    | Bool
otherwise = Text
name

withValue :: GQLValueCTX GQLValue
withValue :: GQLValueCTX GQLValue
withValue =
  GQLValueCTX
    { __useDecodeValue :: forall a. GQLValue a => Value VALID -> ResolverState a
__useDecodeValue = Value VALID -> ResolverState a
forall a. GQLValue a => Value VALID -> ResolverState a
decodeValue,
      __useEncodeValue :: forall a. GQLValue a => a -> GQLResult (Value CONST)
__useEncodeValue = a -> GQLResult (Value CONST)
forall a. GQLValue a => a -> GQLResult (Value CONST)
encodeValue
    }

withGQL :: WITH_GQL
withGQL :: WITH_GQL
withGQL =
  GQLTypeCTX
    { __useFingerprint :: forall (c :: TypeCategory) a.
GQLType a =>
CatType c a -> TypeFingerprint
__useFingerprint = TypeData -> TypeFingerprint
gqlFingerprint (TypeData -> TypeFingerprint)
-> (CatType c a -> TypeData) -> CatType c a -> TypeFingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CatType c a -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat a -> TypeData
__type,
      __useTypename :: forall (c :: TypeCategory) a. GQLType a => CatType c a -> TypeName
__useTypename = TypeData -> TypeName
gqlTypeName (TypeData -> TypeName)
-> (CatType c a -> TypeData) -> CatType c a -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CatType c a -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat a -> TypeData
__type,
      __useTypeData :: forall (c :: TypeCategory) a. GQLType a => CatType c a -> TypeData
__useTypeData = CatType c a -> TypeData
forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
forall (cat :: TypeCategory). CatType cat a -> TypeData
forall (c :: TypeCategory) a. GQLType a => CatType c a -> TypeData
__type,
      __useDeriveNode :: forall (c :: TypeCategory) a.
GQLType a =>
CatType c a -> GQLResult (GQLTypeNode c)
__useDeriveNode = CatType c a -> GQLResult (GQLTypeNode c)
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> GQLResult (GQLTypeNode c)
forall (c :: TypeCategory).
CatType c a -> GQLResult (GQLTypeNode c)
forall (c :: TypeCategory) a.
GQLType a =>
CatType c a -> GQLResult (GQLTypeNode c)
__deriveType,
      __useExploreRef :: forall (c :: TypeCategory) a.
GQLType a =>
CatType c a -> [ScanRef FreeCatType GQLType]
__useExploreRef = \CatType c a
p -> CatType c a -> [ScanRef FreeCatType GQLType]
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> [ScanRef FreeCatType GQLType]
forall (c :: TypeCategory).
CatType c a -> [ScanRef FreeCatType GQLType]
__exploreRef CatType c a
p [ScanRef FreeCatType GQLType]
-> [ScanRef FreeCatType GQLType] -> [ScanRef FreeCatType GQLType]
forall a. Semigroup a => a -> a -> a
<> (GDirectiveUsage GQLType GQLValue -> [ScanRef FreeCatType GQLType])
-> [GDirectiveUsage GQLType GQLValue]
-> [ScanRef FreeCatType GQLType]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GDirectiveUsage GQLType GQLValue -> [ScanRef FreeCatType GQLType]
exploreDirective (DirectiveUsages -> [GDirectiveUsage GQLType GQLValue]
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsages gql args -> [GDirectiveUsage gql args]
allUsages (CatType c a -> DirectiveUsages
forall a (f :: * -> *). GQLType a => f a -> DirectiveUsages
forall (f :: * -> *). f a -> DirectiveUsages
directives CatType c a
p)),
      __useDeriveFieldArgs :: forall (c :: TypeCategory) a.
GQLType a =>
CatType c a -> GQLResult (ArgumentsDefinition CONST)
__useDeriveFieldArgs = CatType c a -> GQLResult (ArgumentsDefinition CONST)
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> GQLResult (ArgumentsDefinition CONST)
forall (c :: TypeCategory).
CatType c a -> GQLResult (ArgumentsDefinition CONST)
forall (c :: TypeCategory) a.
GQLType a =>
CatType c a -> GQLResult (ArgumentsDefinition CONST)
__deriveFieldArguments
    }

typeDirective :: (DirectiveConstraint a) => a -> DirectiveUsages
typeDirective :: forall a. DirectiveConstraint a => a -> DirectiveUsages
typeDirective a
x = [GDirectiveUsage GQLType GQLValue]
-> HashMap FieldName [GDirectiveUsage GQLType GQLValue]
-> HashMap TypeName [GDirectiveUsage GQLType GQLValue]
-> DirectiveUsages
forall (gql :: * -> Constraint) (args :: * -> Constraint).
[GDirectiveUsage gql args]
-> HashMap FieldName [GDirectiveUsage gql args]
-> HashMap TypeName [GDirectiveUsage gql args]
-> GDirectiveUsages gql args
GDirectiveUsages [a -> GDirectiveUsage GQLType GQLValue
forall a (gql :: * -> Constraint) (args :: * -> Constraint).
(GQLDirective a, gql a, args a) =>
a -> GDirectiveUsage gql args
GDirectiveUsage a
x] HashMap FieldName [GDirectiveUsage GQLType GQLValue]
forall a. Monoid a => a
mempty HashMap TypeName [GDirectiveUsage GQLType GQLValue]
forall a. Monoid a => a
mempty

fieldDirective :: (DirectiveConstraint a) => FieldName -> a -> DirectiveUsages
fieldDirective :: forall a.
DirectiveConstraint a =>
FieldName -> a -> DirectiveUsages
fieldDirective FieldName
name a
x = [GDirectiveUsage GQLType GQLValue]
-> HashMap FieldName [GDirectiveUsage GQLType GQLValue]
-> HashMap TypeName [GDirectiveUsage GQLType GQLValue]
-> DirectiveUsages
forall (gql :: * -> Constraint) (args :: * -> Constraint).
[GDirectiveUsage gql args]
-> HashMap FieldName [GDirectiveUsage gql args]
-> HashMap TypeName [GDirectiveUsage gql args]
-> GDirectiveUsages gql args
GDirectiveUsages [GDirectiveUsage GQLType GQLValue]
forall a. Monoid a => a
mempty (FieldName
-> [GDirectiveUsage GQLType GQLValue]
-> HashMap FieldName [GDirectiveUsage GQLType GQLValue]
forall k v. Hashable k => k -> v -> HashMap k v
M.singleton FieldName
name [a -> GDirectiveUsage GQLType GQLValue
forall a (gql :: * -> Constraint) (args :: * -> Constraint).
(GQLDirective a, gql a, args a) =>
a -> GDirectiveUsage gql args
GDirectiveUsage a
x]) HashMap TypeName [GDirectiveUsage GQLType GQLValue]
forall a. Monoid a => a
mempty

fieldDirective' :: (DirectiveConstraint a) => TH.Name -> a -> DirectiveUsages
fieldDirective' :: forall a. DirectiveConstraint a => Name -> a -> DirectiveUsages
fieldDirective' Name
name = FieldName -> a -> DirectiveUsages
forall a.
DirectiveConstraint a =>
FieldName -> a -> DirectiveUsages
fieldDirective (Name -> FieldName
forall a (t :: NAME). NamePacking a => a -> Name t
forall (t :: NAME). Name -> Name t
packName Name
name)

enumDirective :: (DirectiveConstraint a) => TypeName -> a -> DirectiveUsages
enumDirective :: forall a. DirectiveConstraint a => TypeName -> a -> DirectiveUsages
enumDirective TypeName
name a
x = [GDirectiveUsage GQLType GQLValue]
-> HashMap FieldName [GDirectiveUsage GQLType GQLValue]
-> HashMap TypeName [GDirectiveUsage GQLType GQLValue]
-> DirectiveUsages
forall (gql :: * -> Constraint) (args :: * -> Constraint).
[GDirectiveUsage gql args]
-> HashMap FieldName [GDirectiveUsage gql args]
-> HashMap TypeName [GDirectiveUsage gql args]
-> GDirectiveUsages gql args
GDirectiveUsages [GDirectiveUsage GQLType GQLValue]
forall a. Monoid a => a
mempty HashMap FieldName [GDirectiveUsage GQLType GQLValue]
forall a. Monoid a => a
mempty (TypeName
-> [GDirectiveUsage GQLType GQLValue]
-> HashMap TypeName [GDirectiveUsage GQLType GQLValue]
forall k v. Hashable k => k -> v -> HashMap k v
M.singleton TypeName
name [a -> GDirectiveUsage GQLType GQLValue
forall a (gql :: * -> Constraint) (args :: * -> Constraint).
(GQLDirective a, gql a, args a) =>
a -> GDirectiveUsage gql args
GDirectiveUsage a
x])

enumDirective' :: (DirectiveConstraint a) => TH.Name -> a -> DirectiveUsages
enumDirective' :: forall a. DirectiveConstraint a => Name -> a -> DirectiveUsages
enumDirective' Name
name = TypeName -> a -> DirectiveUsages
forall a. DirectiveConstraint a => TypeName -> a -> DirectiveUsages
enumDirective (Name -> TypeName
forall a (t :: NAME). NamePacking a => a -> Name t
forall (t :: NAME). Name -> Name t
packName Name
name)

exploreDirective :: DirectiveUsage -> [ScanRef FreeCatType GQLType]
exploreDirective :: GDirectiveUsage GQLType GQLValue -> [ScanRef FreeCatType GQLType]
exploreDirective (GDirectiveUsage a
x) = CatType 'IN a -> [ScanRef FreeCatType GQLType]
forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> [ScanRef FreeCatType GQLType]
forall (c :: TypeCategory).
CatType c a -> [ScanRef FreeCatType GQLType]
__exploreRef (CatType 'IN a -> [ScanRef FreeCatType GQLType])
-> CatType 'IN a -> [ScanRef FreeCatType GQLType]
forall a b. (a -> b) -> a -> b
$ Identity a -> CatType 'IN a
forall {k} (f :: k -> *) (a :: k). f a -> CatType 'IN a
inputType (Identity a -> CatType 'IN a) -> Identity a -> CatType 'IN a
forall a b. (a -> b) -> a -> b
$ a -> Identity a
forall a. a -> Identity a
Identity a
x

withDir :: WITH_DERIVING
withDir :: WITH_DERIVING
withDir =
  UseDeriving
    { useDirectives :: forall (f :: * -> *) a. GQLType a => f a -> DirectiveUsages
useDirectives = f a -> DirectiveUsages
forall a (f :: * -> *). GQLType a => f a -> DirectiveUsages
forall (f :: * -> *). f a -> DirectiveUsages
forall (f :: * -> *) a. GQLType a => f a -> DirectiveUsages
directives,
      __useGQL :: WITH_GQL
__useGQL = WITH_GQL
withGQL,
      __useValue :: GQLValueCTX GQLValue
__useValue = GQLValueCTX GQLValue
withValue
    }

type WITH_GQL = GQLTypeCTX GQLType

type WITH_DERIVING = UseDeriving GQLType GQLValue

type WITH_RESOLVER = UseResolver GQLResolver GQLType GQLValue

class (GQLType a) => GQLValue a where
  decodeValue :: Value VALID -> ResolverState a
  encodeValue :: a -> GQLResult (Value CONST)

instance (GQLType a, KindedValue WITH_DERIVING (KIND a) a) => GQLValue a where
  encodeValue :: a -> GQLResult (Value CONST)
encodeValue a
value = WITH_DERIVING -> Kinded (KIND a) a -> GQLResult (Value CONST)
forall ctx (k :: DerivingKind) a (gql :: * -> Constraint)
       (args :: * -> Constraint).
(KindedValue ctx k a, UseDeriving gql args ~ ctx) =>
ctx -> Kinded k a -> GQLResult (Value CONST)
forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ WITH_DERIVING) =>
WITH_DERIVING -> Kinded (KIND a) a -> GQLResult (Value CONST)
encodeKindedValue WITH_DERIVING
withDir (a -> Kinded (KIND a) a
forall (kind :: DerivingKind) a. a -> Kinded kind a
Kinded a
value :: Kinded (KIND a) a)
  decodeValue :: Value VALID -> ResolverState a
decodeValue = WITH_DERIVING -> Proxy (KIND a) -> Value VALID -> ResolverState a
forall ctx (k :: DerivingKind) a (gql :: * -> Constraint)
       (args :: * -> Constraint).
(KindedValue ctx k a, UseDeriving gql args ~ ctx) =>
ctx -> Proxy k -> Value VALID -> ResolverState a
forall (gql :: * -> Constraint) (args :: * -> Constraint).
(UseDeriving gql args ~ WITH_DERIVING) =>
WITH_DERIVING -> Proxy (KIND a) -> Value VALID -> ResolverState a
decodeKindedValue WITH_DERIVING
withDir (forall {k} (t :: k). Proxy t
forall (t :: DerivingKind). Proxy t
Proxy @(KIND a))

class (MonadResolver m) => GQLResolver (m :: Type -> Type) resolver where
  deriveResolver :: resolver -> m (ResolverValue m)

instance (MonadResolver m, KindedResolver WITH_RESOLVER (KIND a) m a) => GQLResolver m a where
  deriveResolver :: a -> m (ResolverValue m)
deriveResolver a
resolver = WITH_RESOLVER -> Kinded (KIND a) a -> m (ResolverValue m)
forall ctx (k :: DerivingKind) (m :: * -> *) a
       (res :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
(KindedResolver ctx k m a, MonadResolver m,
 UseResolver res gql val ~ ctx) =>
ctx -> Kinded k a -> m (ResolverValue m)
forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
(MonadResolver m, UseResolver res gql val ~ WITH_RESOLVER) =>
WITH_RESOLVER -> Kinded (KIND a) a -> m (ResolverValue m)
kindedResolver WITH_RESOLVER
withRes (a -> Kinded (KIND a) a
forall (kind :: DerivingKind) a. a -> Kinded kind a
Kinded a
resolver :: Kinded (KIND a) a)

withRes :: UseResolver GQLResolver GQLType GQLValue
withRes :: WITH_RESOLVER
withRes =
  UseResolver
    { useEncodeResolver :: forall a (m :: * -> *). GQLResolver m a => a -> m (ResolverValue m)
useEncodeResolver = a -> m (ResolverValue m)
forall a (m :: * -> *). GQLResolver m a => a -> m (ResolverValue m)
forall (m :: * -> *) resolver.
GQLResolver m resolver =>
resolver -> m (ResolverValue m)
deriveResolver,
      resDrv :: WITH_DERIVING
resDrv = WITH_DERIVING
withDir
    }