{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Types.GQLType
  ( GQLType (KIND, directives, __type),
    GQLValue (..),
    InputTypeNamespace (..),
    GQLResolver (..),
    ignoreUndefined,
    withGQL,
    withDir,
    withValue,
    withRes,
    kindedProxy,
    IgnoredResolver,
  )
where

-- MORPHEUS

import Control.Monad.Except (MonadError (throwError))
import Data.Morpheus.App.Internal.Resolving
  ( Resolver,
    ResolverState,
    ResolverValue,
    SubscriptionField,
  )
import Data.Morpheus.Internal.Ext (GQLResult)
import Data.Morpheus.Internal.Utils (singleton)
import Data.Morpheus.Server.Deriving.Internal.Schema.Type
  ( fillTypeContent,
    injectType,
  )
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 (..),
    deriveInterfaceDefinition,
    deriveScalarDefinition,
    deriveTypeGuardUnions,
  )
import Data.Morpheus.Server.Deriving.Kinded.Value (KindedValue (..))
import Data.Morpheus.Server.Deriving.Utils.Kinded (CatType (..), KindedProxy (KindedProxy), catMap, isIN)
import Data.Morpheus.Server.Deriving.Utils.Proxy (ContextValue (..), symbolName)
import Data.Morpheus.Server.Deriving.Utils.Use (UseDeriving (..), UseGQLType (..), UseResolver (..), UseValue (..))
import Data.Morpheus.Server.Types.Directives
  ( GDirectiveUsages (..),
    GQLDirective (..),
    applyTypeName,
    typeDirective,
  )
import Data.Morpheus.Server.Types.Internal
  ( TypeData (..),
    mkTypeData,
  )
import Data.Morpheus.Server.Types.Kind
  ( CUSTOM,
    DerivingKind,
    SCALAR,
    TYPE,
    WRAPPER,
  )
import Data.Morpheus.Server.Types.NamedResolvers (NamedResolverT (..))
import Data.Morpheus.Server.Types.SchemaT (SchemaT, extendImplements)
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,
    GQLError,
    IN,
    Msg (msg),
    OUT,
    QUERY,
    ScalarDefinition (..),
    TRUE,
    TypeContent (..),
    TypeDefinition (..),
    TypeRef (..),
    TypeWrapper (..),
    VALID,
    Value (..),
    internal,
    mkBaseType,
    mkField,
    toNullable,
    unitTypeName,
  )
import Data.Sequence (Seq)
import Data.Vector (Vector)
import GHC.Generics
import GHC.TypeLits (KnownSymbol)
import Relude hiding (Seq, Undefined, 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 (forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type (forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT a)) forall a. Eq a => a -> a -> Bool
== TypeName -> TypeFingerprint
InternalFingerprint TypeName
__typenameUndefined = forall a. Maybe a
Nothing
  | Bool
otherwise = 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 :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsages gql args -> [GDirectiveUsage gql args]
typeDirectives :: [GDirectiveUsage GQLType GQLValue]
typeDirectives} =
  TypeData
    { gqlTypeName :: TypeName
gqlTypeName = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Bool -> TypeName -> TypeName
`applyTypeName` forall {k} (c :: TypeCategory) (a :: k). CatType c a -> Bool
isIN CatType c a
proxy) (forall {k} (a :: k) (f :: k -> *). Typeable a => f a -> TypeName
typeableTypename (forall {k} (t :: k). Proxy t
Proxy @a)) [GDirectiveUsage GQLType GQLValue]
typeDirectives,
      gqlWrappers :: TypeWrapper
gqlWrappers = TypeWrapper
mkBaseType,
      gqlFingerprint :: TypeFingerprint
gqlFingerprint = forall {k} (a :: k) (c :: TypeCategory).
Typeable a =>
CatType c a -> TypeFingerprint
typeableFingerprint CatType c a
proxy
    }

list :: TypeWrapper -> TypeWrapper
list :: TypeWrapper -> TypeWrapper
list = 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 {TypeWrapper
TypeName
TypeFingerprint
gqlFingerprint :: TypeFingerprint
gqlWrappers :: TypeWrapper
gqlTypeName :: TypeName
gqlWrappers :: TypeData -> TypeWrapper
gqlTypeName :: TypeData -> TypeName
gqlFingerprint :: TypeData -> 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 -> KindedProxy (KIND a) a
kindedProxy :: forall (f :: * -> *) a. f a -> KindedProxy (KIND a) a
kindedProxy f a
_ = forall {k} {k} (k :: k) (a :: k). KindedProxy k a
KindedProxy

lifted :: CatType cat a -> CatType cat (f (KIND a) (Lifted a))
lifted :: forall (cat :: TypeCategory) a (f :: DerivingKind -> * -> *).
CatType cat a -> CatType cat (f (KIND a) (Lifted a))
lifted CatType cat a
InputType = forall {k} (a :: k). CatType 'IN a
InputType
lifted CatType cat a
OutputType = 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 c a = (DeriveKindedType GQLType GQLValue c (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 = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ GQLError -> GQLError
internal forall a b. (a -> b) -> a -> b
$ GQLError
"type " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (TypeData -> TypeName
gqlTypeName forall a b. (a -> b) -> a -> b
$ forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type CatType cat a
proxy) 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
_ = forall a. Monoid a => a
mempty

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

  __deriveType :: CatType c a -> SchemaT c (TypeDefinition c CONST)
  default __deriveType :: DERIVE_T c a => CatType c a -> SchemaT c (TypeDefinition c CONST)
  __deriveType = forall {k} (gql :: * -> Constraint) (val :: * -> Constraint)
       (cat :: TypeCategory) (kind :: DerivingKind) (a :: k) {k}
       (f :: DerivingKind -> k -> k).
DeriveKindedType gql val cat kind a =>
UseDeriving gql val
-> CatType cat (f kind a) -> SchemaT cat (TypeDefinition cat CONST)
deriveKindedType UseDeriving GQLType GQLValue
withDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (cat :: TypeCategory) a (f :: DerivingKind -> * -> *).
CatType cat a -> CatType cat (f (KIND a) (Lifted a))
lifted

  __deriveFieldArguments :: CatType c a -> SchemaT c (Maybe (ArgumentsDefinition CONST))
  default __deriveFieldArguments ::
    DeriveFieldArguments GQLType (HasArguments a) =>
    CatType c a ->
    SchemaT c (Maybe (ArgumentsDefinition CONST))
  __deriveFieldArguments CatType c a
OutputType = forall {k} (gql :: * -> Constraint) (a :: k)
       (val :: * -> Constraint) (f :: k -> *).
DeriveFieldArguments gql a =>
UseDeriving gql val
-> f a -> SchemaT OUT (Maybe (ArgumentsDefinition CONST))
deriveFieldArguments UseDeriving GQLType GQLValue
withDir (forall {k} (t :: k). Proxy t
Proxy @(HasArguments a))
  __deriveFieldArguments CatType c a
InputType = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

instance GQLType Int where
  type KIND Int = SCALAR
  __type :: forall (cat :: TypeCategory). CatType cat Int -> TypeData
__type = 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 = 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 = 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 = 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 = 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 = 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 = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"INTERNAL_VALUE"
  __deriveType :: forall (c :: TypeCategory).
CatType c (Value CONST) -> SchemaT c (TypeDefinition c CONST)
__deriveType = forall (gql :: * -> Constraint) a (cat :: TypeCategory)
       (args :: * -> Constraint) (kind :: TypeCategory).
gql a =>
(CatType cat a -> ScalarDefinition)
-> UseDeriving gql args
-> CatType cat a
-> SchemaT kind (TypeDefinition cat CONST)
deriveScalarDefinition (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ (Value VALID -> Either Text (Value VALID)) -> ScalarDefinition
ScalarDefinition forall (f :: * -> *) a. Applicative f => a -> f a
pure) UseDeriving GQLType GQLValue
withDir

-- WRAPPERS
instance GQLType () where
  __type :: forall (cat :: TypeCategory). CatType cat () -> TypeData
__type = 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 = 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 forall a. Nullable a => a -> a
toNullable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (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 = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (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 = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (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 = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (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 = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (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 = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (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)
_ = forall a (gql :: * -> Constraint) (args :: * -> Constraint).
(GQLDirective a, gql a, args a) =>
a -> GDirectiveUsages gql args
typeDirective InputTypeNamespace {inputTypeNamespace :: Text
inputTypeNamespace = Text
"Input"}

-- Manual

instance (GQLType b, GQLType a) => GQLType (a -> b) where
  type KIND (a -> b) = CUSTOM
  __type :: forall (cat :: TypeCategory). CatType cat (a -> b) -> TypeData
__type = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (forall {k} (t :: k). Proxy t
Proxy @b)
  __deriveType :: forall (c :: TypeCategory).
CatType c (a -> b) -> SchemaT c (TypeDefinition c CONST)
__deriveType CatType c (a -> b)
OutputType = forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> SchemaT c (TypeDefinition c CONST)
__deriveType (forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT b)
  __deriveType CatType c (a -> b)
proxy = forall (m :: * -> *) a (cat :: TypeCategory) b.
(MonadError GQLError m, GQLType a) =>
CatType cat a -> m b
cantBeInputType CatType c (a -> b)
proxy

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 = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (forall {k} (t :: k). Proxy t
Proxy @[Pair k v])
  __deriveType :: forall (c :: TypeCategory).
CatType c (Map k v) -> SchemaT c (TypeDefinition c CONST)
__deriveType = forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> SchemaT c (TypeDefinition c CONST)
__deriveType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (forall {k} (t :: k). Proxy t
Proxy @[(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 = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (forall {k} (t :: k). Proxy t
Proxy @a)
  __deriveType :: forall (c :: TypeCategory).
CatType c (Resolver o e m a) -> SchemaT c (TypeDefinition c CONST)
__deriveType = forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> SchemaT c (TypeDefinition c CONST)
__deriveType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (forall {k} (t :: k). Proxy t
Proxy @a)

instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (a, b) where
  __type :: forall (cat :: TypeCategory). CatType cat (a, b) -> TypeData
__type = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (forall {k} (t :: k). Proxy t
Proxy @(Pair a b))
  directives :: forall (f :: * -> *). f (a, b) -> DirectiveUsages
directives f (a, b)
_ = forall a (gql :: * -> Constraint) (args :: * -> Constraint).
(GQLDirective a, gql a, args a) =>
a -> GDirectiveUsages gql args
typeDirective InputTypeNamespace {inputTypeNamespace :: Text
inputTypeNamespace = Text
"Input"}

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 = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (forall {k} (t :: k). Proxy t
Proxy @value)
  __deriveType :: forall (c :: TypeCategory).
CatType c (Arg name value) -> SchemaT c (TypeDefinition c CONST)
__deriveType CatType c (Arg name value)
OutputType = forall (m :: * -> *) a (cat :: TypeCategory) b.
(MonadError GQLError m, GQLType a) =>
CatType cat a -> m b
cantBeInputType (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 = do
    forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (c :: TypeCategory).
gql a =>
UseDeriving gql args -> CatType c a -> SchemaT c ()
injectType UseDeriving GQLType GQLValue
withDir CatType 'IN value
proxy
    forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (c :: TypeCategory) (cat :: TypeCategory) (kind :: TypeCategory).
gql a =>
UseDeriving gql args
-> CatType c a
-> TypeContent 'True cat CONST
-> SchemaT kind (TypeDefinition cat CONST)
fillTypeContent UseDeriving GQLType GQLValue
withDir CatType c (Arg name value)
p TypeContent 'True 'IN CONST
content
    where
      content :: TypeContent TRUE IN CONST
      content :: TypeContent 'True 'IN CONST
content = forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition 'IN s -> TypeContent (INPUT_OBJECT <=? a) a s
DataInputObject (forall k (m :: * -> *) a. IsMap k m => k -> a -> m a
singleton FieldName
argName FieldDefinition 'IN CONST
field)
      proxy :: CatType 'IN value
proxy = forall {k} (a :: k). CatType 'IN a
InputType :: CatType IN value
      argName :: FieldName
argName = forall (a :: Symbol) (f :: Symbol -> *).
KnownSymbol a =>
f a -> FieldName
symbolName (forall {k} (t :: k). Proxy t
Proxy @name)
      field :: FieldDefinition IN CONST
      field :: FieldDefinition 'IN CONST
field = forall (cat :: TypeCategory) (s :: Stage).
Maybe (FieldContent 'True cat s)
-> FieldName -> TypeRef -> FieldDefinition cat s
mkField forall a. Maybe a
Nothing FieldName
argName (TypeName -> TypeWrapper -> TypeRef
TypeRef TypeName
gqlTypeName TypeWrapper
gqlWrappers)
      TypeData {TypeName
gqlTypeName :: TypeName
gqlTypeName :: TypeData -> TypeName
gqlTypeName, TypeWrapper
gqlWrappers :: TypeWrapper
gqlWrappers :: TypeData -> TypeWrapper
gqlWrappers} = forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeData
useTypeData UseGQLType GQLType
withGQL CatType 'IN value
proxy

instance (DERIVE_TYPE GQLType OUT i, DERIVE_TYPE GQLType OUT u) => GQLType (TypeGuard i u) where
  type KIND (TypeGuard i u) = CUSTOM
  __type :: forall (cat :: TypeCategory).
CatType cat (TypeGuard i u) -> TypeData
__type = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (forall {k} (t :: k). Proxy t
Proxy @i)
  __deriveType :: forall (c :: TypeCategory).
CatType c (TypeGuard i u) -> SchemaT c (TypeDefinition c CONST)
__deriveType CatType c (TypeGuard i u)
OutputType = do
    [TypeName]
unions <- forall (gql :: * -> Constraint) a (args :: * -> Constraint).
(gql a,
 GRep
   gql
   gql
   (SchemaT OUT (Maybe (ArgumentsDefinition CONST)))
   (Rep a)) =>
UseDeriving gql args -> CatType OUT a -> SchemaT OUT [TypeName]
deriveTypeGuardUnions UseDeriving GQLType GQLValue
withDir CatType OUT u
union
    forall (cat' :: TypeCategory).
TypeName -> [TypeName] -> SchemaT cat' ()
extendImplements (forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeName
useTypename UseGQLType GQLType
withGQL CatType OUT i
interface) [TypeName]
unions
    forall (gql :: * -> Constraint) a (args :: * -> Constraint).
(gql a,
 GRep
   gql
   gql
   (SchemaT OUT (Maybe (ArgumentsDefinition CONST)))
   (Rep a)) =>
UseDeriving gql args
-> CatType OUT a -> SchemaT OUT (TypeDefinition OUT CONST)
deriveInterfaceDefinition UseDeriving GQLType GQLValue
withDir CatType OUT i
interface
    where
      interface :: CatType OUT i
interface = forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT i
      union :: CatType OUT u
union = forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT u
  __deriveType CatType c (TypeGuard i u)
proxy = forall (m :: * -> *) a (cat :: TypeCategory) b.
(MonadError GQLError m, GQLType a) =>
CatType cat a -> m b
cantBeInputType CatType c (TypeGuard i u)
proxy

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 = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
  __deriveType :: forall (c :: TypeCategory).
CatType c (NamedResolverT m a)
-> SchemaT c (TypeDefinition c CONST)
__deriveType = forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> SchemaT c (TypeDefinition c CONST)
__deriveType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (forall {k} (t :: k). Proxy t
Proxy @a)
  __deriveFieldArguments :: forall (c :: TypeCategory).
CatType c (NamedResolverT m a)
-> SchemaT c (Maybe (ArgumentsDefinition CONST))
__deriveFieldArguments = forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> SchemaT c (Maybe (ArgumentsDefinition CONST))
__deriveFieldArguments forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (forall {k} (t :: k). Proxy t
Proxy @a)

type DirectiveUsages = GDirectiveUsages GQLType GQLValue

newtype InputTypeNamespace = InputTypeNamespace {InputTypeNamespace -> Text
inputTypeNamespace :: Text}
  deriving (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
$cto :: forall x. Rep InputTypeNamespace x -> InputTypeNamespace
$cfrom :: forall x. InputTypeNamespace -> Rep InputTypeNamespace x
Generic)
  deriving anyclass
    (forall a.
(forall (f :: * -> *). f a -> DirectiveUsages)
-> (forall (cat :: TypeCategory). CatType cat a -> TypeData)
-> (forall (c :: TypeCategory).
    CatType c a -> SchemaT c (TypeDefinition c CONST))
-> (forall (c :: TypeCategory).
    CatType c a -> SchemaT c (Maybe (ArgumentsDefinition CONST)))
-> GQLType a
forall (c :: TypeCategory).
CatType c InputTypeNamespace
-> SchemaT c (Maybe (ArgumentsDefinition CONST))
forall (c :: TypeCategory).
CatType c InputTypeNamespace -> SchemaT c (TypeDefinition c CONST)
forall (cat :: TypeCategory).
CatType cat InputTypeNamespace -> TypeData
forall (f :: * -> *). f InputTypeNamespace -> DirectiveUsages
__deriveFieldArguments :: forall (c :: TypeCategory).
CatType c InputTypeNamespace
-> SchemaT c (Maybe (ArgumentsDefinition CONST))
$c__deriveFieldArguments :: forall (c :: TypeCategory).
CatType c InputTypeNamespace
-> SchemaT c (Maybe (ArgumentsDefinition CONST))
__deriveType :: forall (c :: TypeCategory).
CatType c InputTypeNamespace -> SchemaT c (TypeDefinition c CONST)
$c__deriveType :: forall (c :: TypeCategory).
CatType c InputTypeNamespace -> SchemaT c (TypeDefinition c CONST)
__type :: forall (cat :: TypeCategory).
CatType cat InputTypeNamespace -> TypeData
$c__type :: forall (cat :: TypeCategory).
CatType cat InputTypeNamespace -> TypeData
directives :: forall (f :: * -> *). f InputTypeNamespace -> DirectiveUsages
$cdirectives :: forall (f :: * -> *). f InputTypeNamespace -> DirectiveUsages
GQLType)

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 :: Text
inputTypeNamespace :: InputTypeNamespace -> Text
inputTypeNamespace} Bool
isInput Text
name
    | Bool
isInput = Text
inputTypeNamespace forall a. Semigroup a => a -> a -> a
<> Text
name
    | Bool
otherwise = Text
name

withValue :: UseValue GQLValue
withValue :: UseValue GQLValue
withValue =
  UseValue
    { useDecodeValue :: forall a. GQLValue a => Value VALID -> ResolverState a
useDecodeValue = forall a. GQLValue a => Value VALID -> ResolverState a
decodeValue,
      useEncodeValue :: forall a. GQLValue a => a -> GQLResult (Value CONST)
useEncodeValue = forall a. GQLValue a => a -> GQLResult (Value CONST)
encodeValue
    }

withGQL :: UseGQLType GQLType
withGQL :: UseGQLType GQLType
withGQL =
  UseGQLType
    { useFingerprint :: forall (c :: TypeCategory) a.
GQLType a =>
CatType c a -> TypeFingerprint
useFingerprint = TypeData -> TypeFingerprint
gqlFingerprint forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type,
      useTypename :: forall (c :: TypeCategory) a. GQLType a => CatType c a -> TypeName
useTypename = TypeData -> TypeName
gqlTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type,
      useTypeData :: forall (c :: TypeCategory) a. GQLType a => CatType c a -> TypeData
useTypeData = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__type,
      useDeriveType :: forall (c :: TypeCategory) a.
GQLType a =>
CatType c a -> SchemaT c (TypeDefinition c CONST)
useDeriveType = forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> SchemaT c (TypeDefinition c CONST)
__deriveType,
      useDeriveFieldArguments :: forall (c :: TypeCategory) a.
GQLType a =>
CatType c a -> SchemaT c (Maybe (ArgumentsDefinition CONST))
useDeriveFieldArguments = forall a (c :: TypeCategory).
GQLType a =>
CatType c a -> SchemaT c (Maybe (ArgumentsDefinition CONST))
__deriveFieldArguments
    }

withDir :: UseDeriving GQLType GQLValue
withDir :: UseDeriving GQLType GQLValue
withDir =
  UseDeriving
    { __directives :: forall (f :: * -> *) a. GQLType a => f a -> DirectiveUsages
__directives = forall a (f :: * -> *). GQLType a => f a -> DirectiveUsages
directives,
      dirGQL :: UseGQLType GQLType
dirGQL = UseGQLType GQLType
withGQL,
      dirArgs :: UseValue GQLValue
dirArgs = UseValue GQLValue
withValue
    }

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

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

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

instance (KindedResolver GQLType GQLResolver GQLValue (KIND a) m a) => GQLResolver m a where
  deriveResolver :: a -> m (ResolverValue m)
deriveResolver a
resolver = forall (gql :: * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) (val :: * -> Constraint)
       (kind :: DerivingKind) (m :: * -> *) a.
KindedResolver gql res val kind m a =>
UseResolver res gql val
-> ContextValue kind a -> m (ResolverValue m)
kindedResolver UseResolver GQLResolver GQLType GQLValue
withRes (forall (kind :: DerivingKind) a. a -> ContextValue kind a
ContextValue a
resolver :: ContextValue (KIND a) a)

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