{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Deriving.Schema
  ( compileTimeSchemaValidation,
    DeriveType,
    deriveSchema,
    SchemaConstraints,
    SchemaT,
  )
where

-- MORPHEUS

import Control.Monad.Except (throwError)
import Data.Morpheus.App.Internal.Resolving
  ( Resolver,
  )
import Data.Morpheus.Core (defaultConfig, validateSchema)
import Data.Morpheus.Internal.Ext
import Data.Morpheus.Internal.Utils (singleton)
import Data.Morpheus.Kind
  ( CUSTOM,
    DerivingKind,
    SCALAR,
    TYPE,
    WRAPPER,
  )
import Data.Morpheus.Server.Deriving.Schema.Internal
  ( KindedType (..),
    TyContentM,
    fromSchema,
    updateByContent,
  )
import Data.Morpheus.Server.Deriving.Schema.Object
  ( asObjectType,
    withObject,
  )
import Data.Morpheus.Server.Deriving.Schema.TypeContent
import Data.Morpheus.Server.Deriving.Utils
  ( TypeConstraint (..),
    TypeRep (..),
    deriveTypeRef,
    symbolName,
    toRep,
    unpackMonad,
    withKind,
  )
import Data.Morpheus.Server.Deriving.Utils.Kinded
  ( CategoryValue (..),
    KindedProxy (..),
    inputType,
    outputType,
    setKind,
  )
import Data.Morpheus.Server.Types.GQLType
  ( GQLType (..),
    TypeData (..),
    __typeData,
  )
import Data.Morpheus.Server.Types.SchemaT
  ( SchemaT,
    extendImplements,
    toSchema,
    withInput,
  )
import Data.Morpheus.Server.Types.Types
  ( Arg (..),
    TypeGuard,
  )
import Data.Morpheus.Types.GQLScalar
  ( DecodeScalar (..),
    scalarValidator,
  )
import Data.Morpheus.Types.Internal.AST
  ( ArgumentsDefinition,
    CONST,
    FieldContent (..),
    FieldsDefinition,
    IN,
    LEAF,
    MUTATION,
    OBJECT,
    OUT,
    QUERY,
    SUBSCRIPTION,
    Schema (..),
    TRUE,
    TypeCategory,
    TypeContent (..),
    TypeDefinition (..),
    TypeName,
    UnionMember (memberName),
    fieldsToArguments,
    mkField,
  )
import GHC.Generics (Rep)
import GHC.TypeLits
import Language.Haskell.TH (Exp, Q)
import Relude

type SchemaConstraints event (m :: Type -> Type) query mutation subscription =
  ( DeriveTypeConstraintOpt OUT (query (Resolver QUERY event m)),
    DeriveTypeConstraintOpt OUT (mutation (Resolver MUTATION event m)),
    DeriveTypeConstraintOpt OUT (subscription (Resolver SUBSCRIPTION event m))
  )

type DeriveTypeConstraintOpt kind a =
  ( Generic a,
    GQLType a,
    TypeRep (DeriveType kind) (TyContentM kind) (Rep a),
    TypeRep (DeriveType kind) (SchemaT kind ()) (Rep a)
  )

-- | normal morpheus server validates schema at runtime (after the schema derivation).
--   this method allows you to validate it at compile time.
compileTimeSchemaValidation ::
  (SchemaConstraints event m qu mu su) =>
  proxy (root m event qu mu su) ->
  Q Exp
compileTimeSchemaValidation :: forall {k} event (m :: * -> *) (qu :: (* -> *) -> *)
       (mu :: (* -> *) -> *) (su :: (* -> *) -> *) (proxy :: k -> *)
       (root :: (* -> *)
                -> *
                -> ((* -> *) -> *)
                -> ((* -> *) -> *)
                -> ((* -> *) -> *)
                -> k).
SchemaConstraints event m qu mu su =>
proxy (root m event qu mu su) -> Q Exp
compileTimeSchemaValidation =
  GQLResult (Schema VALID) -> Q Exp
fromSchema forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {k}
       (root :: (* -> *)
                -> * -> ((* -> *) -> *) -> ((* -> *) -> *) -> ((* -> *) -> *) -> k)
       (proxy :: k -> *) (m :: * -> *) e (query :: (* -> *) -> *)
       (mut :: (* -> *) -> *) (subs :: (* -> *) -> *).
SchemaConstraints e m query mut subs =>
proxy (root m e query mut subs) -> GQLResult (Schema CONST)
deriveSchema forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (s :: Stage).
ValidateSchema s =>
Bool -> Config -> Schema s -> GQLResult (Schema VALID)
validateSchema Bool
True Config
defaultConfig)

deriveSchema ::
  forall
    root
    proxy
    m
    e
    query
    mut
    subs.
  ( SchemaConstraints e m query mut subs
  ) =>
  proxy (root m e query mut subs) ->
  GQLResult (Schema CONST)
deriveSchema :: forall {k}
       (root :: (* -> *)
                -> * -> ((* -> *) -> *) -> ((* -> *) -> *) -> ((* -> *) -> *) -> k)
       (proxy :: k -> *) (m :: * -> *) e (query :: (* -> *) -> *)
       (mut :: (* -> *) -> *) (subs :: (* -> *) -> *).
SchemaConstraints e m query mut subs =>
proxy (root m e query mut subs) -> GQLResult (Schema CONST)
deriveSchema proxy (root m e query mut subs)
_ = forall (c :: TypeCategory).
SchemaT
  c
  (TypeDefinition OBJECT CONST, Maybe (TypeDefinition OBJECT CONST),
   Maybe (TypeDefinition OBJECT CONST))
-> GQLResult (Schema CONST)
toSchema SchemaT
  OUT
  (TypeDefinition OBJECT CONST, Maybe (TypeDefinition OBJECT CONST),
   Maybe (TypeDefinition OBJECT CONST))
schemaT
  where
    schemaT ::
      SchemaT
        OUT
        ( TypeDefinition OBJECT CONST,
          Maybe (TypeDefinition OBJECT CONST),
          Maybe (TypeDefinition OBJECT CONST)
        )
    schemaT :: SchemaT
  OUT
  (TypeDefinition OBJECT CONST, Maybe (TypeDefinition OBJECT CONST),
   Maybe (TypeDefinition OBJECT CONST))
schemaT =
      (,,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT OUT (TypeDefinition OBJECT CONST)
deriveRoot (forall {k} (t :: k). Proxy t
Proxy @(query (Resolver QUERY e m)))
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT OUT (Maybe (TypeDefinition OBJECT CONST))
deriveMaybeRoot (forall {k} (t :: k). Proxy t
Proxy @(mut (Resolver MUTATION e m)))
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT OUT (Maybe (TypeDefinition OBJECT CONST))
deriveMaybeRoot (forall {k} (t :: k). Proxy t
Proxy @(subs (Resolver SUBSCRIPTION e m)))

-- |  Generates internal GraphQL Schema for query validation and introspection rendering
class DeriveType (kind :: TypeCategory) (a :: Type) where
  deriveType :: f a -> SchemaT kind ()
  deriveContent :: f a -> TyContentM kind

instance (GQLType a, DeriveKindedType cat (KIND a) a) => DeriveType cat a where
  deriveType :: forall (f :: * -> *). f a -> SchemaT cat ()
deriveType f a
_ = forall {k} (cat :: TypeCategory) (kind :: DerivingKind) (a :: k)
       (kinded :: DerivingKind -> k -> *).
DeriveKindedType cat kind a =>
kinded kind a -> SchemaT cat ()
deriveKindedType (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy (KIND a) a)
  deriveContent :: forall (f :: * -> *). f a -> TyContentM cat
deriveContent f a
_ = forall {k} (cat :: TypeCategory) (kind :: DerivingKind) (a :: k)
       (kinded :: DerivingKind -> k -> *).
DeriveKindedType cat kind a =>
kinded kind a -> TyContentM cat
deriveKindedContent (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy (KIND a) a)

-- | DeriveType With specific Kind: 'kind': object, scalar, enum ...
class DeriveKindedType (cat :: TypeCategory) (kind :: DerivingKind) a where
  deriveKindedType :: kinded kind a -> SchemaT cat ()
  deriveKindedContent :: kinded kind a -> TyContentM cat
  deriveKindedContent kinded kind a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

type DeriveTypeConstraint kind a =
  ( DeriveTypeConstraintOpt kind a,
    CategoryValue kind
  )

-- SCALAR
instance (GQLType a, DeriveType cat a) => DeriveKindedType cat WRAPPER (f a) where
  deriveKindedType :: forall (kinded :: DerivingKind -> k -> *).
kinded WRAPPER (f a) -> SchemaT cat ()
deriveKindedType kinded WRAPPER (f a)
_ = forall (kind :: TypeCategory) a (f :: * -> *).
DeriveType kind a =>
f a -> SchemaT kind ()
deriveType (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy cat a)

instance (GQLType a, DecodeScalar a) => DeriveKindedType cat SCALAR a where
  deriveKindedType :: forall (kinded :: DerivingKind -> * -> *).
kinded SCALAR a -> SchemaT cat ()
deriveKindedType = forall a (kind :: TypeCategory) (f :: TypeCategory -> * -> *)
       (c :: TypeCategory).
(GQLType a, CategoryValue kind) =>
(f kind a -> SchemaT c (TypeContent TRUE kind CONST))
-> f kind a -> SchemaT c ()
updateByContent forall {k} a (f :: k -> * -> *) (k :: k) (cat :: TypeCategory).
DecodeScalar a =>
f k a -> SchemaT cat (TypeContent TRUE LEAF CONST)
deriveScalarContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (k3 :: k1) t
       (kinded :: t -> k2 -> *) (k' :: t) (a :: k2).
f k3 -> kinded k' a -> KindedProxy k3 a
setKind (forall {k} (t :: k). Proxy t
Proxy @LEAF)

instance DeriveTypeConstraint OUT a => DeriveKindedType OUT TYPE a where
  deriveKindedType :: forall (kinded :: DerivingKind -> * -> *).
kinded TYPE a -> SchemaT OUT ()
deriveKindedType = forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT OUT ()
deriveOutputType

instance DeriveTypeConstraint IN a => DeriveKindedType IN TYPE a where
  deriveKindedType :: forall (kinded :: DerivingKind -> * -> *).
kinded TYPE a -> SchemaT IN ()
deriveKindedType = forall a (f :: * -> *).
DeriveTypeConstraint IN a =>
f a -> SchemaT IN ()
deriveInputType

instance DeriveType cat a => DeriveKindedType cat CUSTOM (Resolver o e m a) where
  deriveKindedType :: forall (kinded :: DerivingKind -> * -> *).
kinded CUSTOM (Resolver o e m a) -> SchemaT cat ()
deriveKindedType kinded CUSTOM (Resolver o e m a)
_ = forall (kind :: TypeCategory) a (f :: * -> *).
DeriveType kind a =>
f a -> SchemaT kind ()
deriveType (forall {k} (t :: k). Proxy t
Proxy @a)

-- Map
instance DeriveType cat [(k, v)] => DeriveKindedType cat CUSTOM (Map k v) where
  deriveKindedType :: forall (kinded :: DerivingKind -> * -> *).
kinded CUSTOM (Map k v) -> SchemaT cat ()
deriveKindedType kinded CUSTOM (Map k v)
_ = forall (kind :: TypeCategory) a (f :: * -> *).
DeriveType kind a =>
f a -> SchemaT kind ()
deriveType (forall {k} (t :: k). Proxy t
Proxy @[(k, v)])

instance
  ( DeriveTypeConstraint OUT interface,
    DeriveTypeConstraint OUT union
  ) =>
  DeriveKindedType OUT CUSTOM (TypeGuard interface union)
  where
  deriveKindedType :: forall (kinded :: DerivingKind -> * -> *).
kinded CUSTOM (TypeGuard interface union) -> SchemaT OUT ()
deriveKindedType kinded CUSTOM (TypeGuard interface union)
_ = do
    forall a (kind :: TypeCategory) (f :: TypeCategory -> * -> *)
       (c :: TypeCategory).
(GQLType a, CategoryValue kind) =>
(f kind a -> SchemaT c (TypeContent TRUE kind CONST))
-> f kind a -> SchemaT c ()
updateByContent forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT OUT (TypeContent TRUE OUT CONST)
deriveInterfaceContent KindedProxy OUT interface
interfaceProxy
    TypeContent TRUE OUT CONST
content <- forall (kind :: TypeCategory) a.
DeriveTypeConstraint kind a =>
KindedType kind a -> SchemaT kind (TypeContent TRUE kind CONST)
deriveTypeContent (forall {k} (a :: k). KindedType OUT a
OutputType :: KindedType OUT union)
    [TypeName]
unionNames <- TypeContent TRUE OUT CONST -> SchemaT OUT [TypeName]
getUnionNames TypeContent TRUE OUT CONST
content
    forall (cat' :: TypeCategory).
TypeName -> [TypeName] -> SchemaT cat' ()
extendImplements TypeName
interfaceName [TypeName]
unionNames
    where
      interfaceName :: TypeName
      interfaceName :: TypeName
interfaceName = TypeData -> TypeName
gqlTypeName (forall (kinded :: TypeCategory -> * -> *) (kind :: TypeCategory) a.
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeData
__typeData KindedProxy OUT interface
interfaceProxy)
      interfaceProxy :: KindedProxy OUT interface
      interfaceProxy :: KindedProxy OUT interface
interfaceProxy = forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy
      unionProxy :: KindedProxy OUT union
      unionProxy :: KindedProxy OUT union
unionProxy = forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy
      getUnionNames :: TypeContent TRUE OUT CONST -> SchemaT OUT [TypeName]
      getUnionNames :: TypeContent TRUE OUT CONST -> SchemaT OUT [TypeName]
getUnionNames DataUnion {UnionTypeDefinition OUT CONST
unionMembers :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OUT a s -> UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT CONST
unionMembers} = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
memberName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnionTypeDefinition OUT CONST
unionMembers
      getUnionNames DataObject {} = forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeData -> TypeName
gqlTypeName (forall (kinded :: TypeCategory -> * -> *) (kind :: TypeCategory) a.
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeData
__typeData KindedProxy OUT union
unionProxy)]
      getUnionNames TypeContent TRUE OUT CONST
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"guarded type must be an union or object"

instance
  ( GQLType b,
    DeriveKindedType OUT (KIND b) b,
    DeriveArguments (KIND a) a
  ) =>
  DeriveKindedType OUT CUSTOM (a -> b)
  where
  deriveKindedContent :: forall (kinded :: DerivingKind -> * -> *).
kinded CUSTOM (a -> b) -> TyContentM OUT
deriveKindedContent kinded CUSTOM (a -> b)
_ = do
    ArgumentsDefinition CONST
a <- forall {k} (k :: DerivingKind) (a :: k)
       (f :: DerivingKind -> k -> *).
DeriveArguments k a =>
f k a -> SchemaT OUT (ArgumentsDefinition CONST)
deriveArgumentsDefinition (forall a. Proxy a -> KindedProxy (KIND a) a
withKind (forall {k} (t :: k). Proxy t
Proxy @a))
    TyContent OUT
b <- forall {k} (cat :: TypeCategory) (kind :: DerivingKind) (a :: k)
       (kinded :: DerivingKind -> k -> *).
DeriveKindedType cat kind a =>
kinded kind a -> TyContentM cat
deriveKindedContent (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy (KIND b) b)
    case TyContent OUT
b of
      Just (FieldArgs ArgumentsDefinition CONST
x) -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage) (cat :: TypeCategory).
ArgumentsDefinition s -> FieldContent (OUT <=? cat) cat s
FieldArgs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArgumentsDefinition CONST
a forall (m :: * -> *) a.
(Merge (HistoryT m) a, Monad m) =>
a -> a -> m a
<:> ArgumentsDefinition CONST
x)
      TyContent OUT
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall (s :: Stage) (cat :: TypeCategory).
ArgumentsDefinition s -> FieldContent (OUT <=? cat) cat s
FieldArgs ArgumentsDefinition CONST
a)
  deriveKindedType :: forall (kinded :: DerivingKind -> * -> *).
kinded CUSTOM (a -> b) -> SchemaT OUT ()
deriveKindedType kinded CUSTOM (a -> b)
_ = forall (kind :: TypeCategory) a (f :: * -> *).
DeriveType kind a =>
f a -> SchemaT kind ()
deriveType (forall {k} (f :: k -> *) (a :: k). f a -> KindedType OUT a
outputType forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @b)

deriveScalarContent :: (DecodeScalar a) => f k a -> SchemaT cat (TypeContent TRUE LEAF CONST)
deriveScalarContent :: forall {k} a (f :: k -> * -> *) (k :: k) (cat :: TypeCategory).
DecodeScalar a =>
f k a -> SchemaT cat (TypeContent TRUE LEAF CONST)
deriveScalarContent = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> TypeContent (LEAF <=? a) a s
DataScalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. DecodeScalar a => f a -> ScalarDefinition
scalarValidator

deriveInterfaceContent :: DeriveTypeConstraint OUT a => f a -> SchemaT OUT (TypeContent TRUE OUT CONST)
deriveInterfaceContent :: forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT OUT (TypeContent TRUE OUT CONST)
deriveInterfaceContent = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> TypeContent (IMPLEMENTABLE <=? a) a s
DataInterface forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: TypeCategory) a.
DeriveTypeConstraint kind a =>
KindedType kind a -> SchemaT kind (FieldsDefinition kind CONST)
deriveFields forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> KindedType OUT a
outputType

class DeriveArguments (k :: DerivingKind) a where
  deriveArgumentsDefinition :: f k a -> SchemaT OUT (ArgumentsDefinition CONST)

instance DeriveTypeConstraint IN a => DeriveArguments TYPE a where
  deriveArgumentsDefinition :: forall (f :: DerivingKind -> * -> *).
f TYPE a -> SchemaT OUT (ArgumentsDefinition CONST)
deriveArgumentsDefinition = forall a. SchemaT IN a -> SchemaT OUT a
withInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: Stage). FieldsDefinition IN s -> ArgumentsDefinition s
fieldsToArguments forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: TypeCategory) a.
DeriveTypeConstraint kind a =>
KindedType kind a -> SchemaT kind (FieldsDefinition kind CONST)
deriveFields forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> KindedType IN a
inputType

instance (KnownSymbol name, DeriveType IN a, GQLType a) => DeriveArguments CUSTOM (Arg name a) where
  deriveArgumentsDefinition :: forall (f :: DerivingKind -> * -> *).
f CUSTOM (Arg name a) -> SchemaT OUT (ArgumentsDefinition CONST)
deriveArgumentsDefinition f CUSTOM (Arg name a)
_ = do
    forall a. SchemaT IN a -> SchemaT OUT a
withInput (forall (kind :: TypeCategory) a (f :: * -> *).
DeriveType kind a =>
f a -> SchemaT kind ()
deriveType KindedProxy IN a
proxy)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (s :: Stage). FieldsDefinition IN s -> ArgumentsDefinition s
fieldsToArguments forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *) a. IsMap k m => k -> a -> m a
singleton Name 'FIELD
argName forall a b. (a -> b) -> a -> b
$ forall (cat :: TypeCategory) (s :: Stage).
Maybe (FieldContent TRUE cat s)
-> Name 'FIELD -> TypeRef -> FieldDefinition cat s
mkField forall a. Maybe a
Nothing Name 'FIELD
argName TypeRef
argTypeRef
    where
      proxy :: KindedProxy IN a
      proxy :: KindedProxy IN a
proxy = forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy
      argName :: Name 'FIELD
argName = forall (a :: Symbol) (f :: Symbol -> *).
KnownSymbol a =>
f a -> Name 'FIELD
symbolName (forall {k} (t :: k). Proxy t
Proxy @name)
      argTypeRef :: TypeRef
argTypeRef = forall a (kind :: TypeCategory) (kinded :: TypeCategory -> * -> *).
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeRef
deriveTypeRef KindedProxy IN a
proxy

deriveFields :: DeriveTypeConstraint kind a => KindedType kind a -> SchemaT kind (FieldsDefinition kind CONST)
deriveFields :: forall (kind :: TypeCategory) a.
DeriveTypeConstraint kind a =>
KindedType kind a -> SchemaT kind (FieldsDefinition kind CONST)
deriveFields KindedType kind a
kindedType = forall (kind :: TypeCategory) a.
DeriveTypeConstraint kind a =>
KindedType kind a -> SchemaT kind (TypeContent TRUE kind CONST)
deriveTypeContent KindedType kind a
kindedType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (c :: TypeCategory) (any :: TypeCategory) (s :: Stage).
(GQLType a, CategoryValue c) =>
KindedType c a
-> TypeContent TRUE any s -> SchemaT c (FieldsDefinition c s)
withObject KindedType kind a
kindedType

deriveInputType :: DeriveTypeConstraint IN a => f a -> SchemaT IN ()
deriveInputType :: forall a (f :: * -> *).
DeriveTypeConstraint IN a =>
f a -> SchemaT IN ()
deriveInputType = forall a (kind :: TypeCategory) (f :: TypeCategory -> * -> *)
       (c :: TypeCategory).
(GQLType a, CategoryValue kind) =>
(f kind a -> SchemaT c (TypeContent TRUE kind CONST))
-> f kind a -> SchemaT c ()
updateByContent forall (kind :: TypeCategory) a.
DeriveTypeConstraint kind a =>
KindedType kind a -> SchemaT kind (TypeContent TRUE kind CONST)
deriveTypeContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> KindedType IN a
inputType

deriveOutputType :: DeriveTypeConstraint OUT a => f a -> SchemaT OUT ()
deriveOutputType :: forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT OUT ()
deriveOutputType = forall a (kind :: TypeCategory) (f :: TypeCategory -> * -> *)
       (c :: TypeCategory).
(GQLType a, CategoryValue kind) =>
(f kind a -> SchemaT c (TypeContent TRUE kind CONST))
-> f kind a -> SchemaT c ()
updateByContent forall (kind :: TypeCategory) a.
DeriveTypeConstraint kind a =>
KindedType kind a -> SchemaT kind (TypeContent TRUE kind CONST)
deriveTypeContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> KindedType OUT a
outputType

deriveRoot :: DeriveTypeConstraint OUT a => f a -> SchemaT OUT (TypeDefinition OBJECT CONST)
deriveRoot :: forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT OUT (TypeDefinition OBJECT CONST)
deriveRoot = forall a (f :: * -> *) (kind :: TypeCategory).
GQLType a =>
(f a -> SchemaT kind (FieldsDefinition OUT CONST))
-> f a -> SchemaT kind (TypeDefinition OBJECT CONST)
asObjectType (forall (kind :: TypeCategory) a.
DeriveTypeConstraint kind a =>
KindedType kind a -> SchemaT kind (FieldsDefinition kind CONST)
deriveFields forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> KindedType OUT a
outputType)

deriveMaybeRoot :: DeriveTypeConstraint OUT a => f a -> SchemaT OUT (Maybe (TypeDefinition OBJECT CONST))
deriveMaybeRoot :: forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT OUT (Maybe (TypeDefinition OBJECT CONST))
deriveMaybeRoot f a
proxy
  | forall a (f :: * -> *). GQLType a => f a -> Bool
__isEmptyType f a
proxy =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (f :: * -> *) (kind :: TypeCategory).
GQLType a =>
(f a -> SchemaT kind (FieldsDefinition OUT CONST))
-> f a -> SchemaT kind (TypeDefinition OBJECT CONST)
asObjectType (forall (kind :: TypeCategory) a.
DeriveTypeConstraint kind a =>
KindedType kind a -> SchemaT kind (FieldsDefinition kind CONST)
deriveFields forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> KindedType OUT a
outputType) f a
proxy

fieldContentConstraint :: f kind a -> TypeConstraint (DeriveType kind) (TyContentM kind) Proxy
fieldContentConstraint :: forall {k} (f :: TypeCategory -> k -> *) (kind :: TypeCategory)
       (a :: k).
f kind a
-> TypeConstraint (DeriveType kind) (TyContentM kind) Proxy
fieldContentConstraint f kind a
_ = forall (c :: * -> Constraint) v (f :: * -> *).
(forall a. c a => f a -> v) -> TypeConstraint c v f
TypeConstraint forall (f :: * -> *) (kind :: TypeCategory) a.
DeriveType kind a =>
f a -> TyContentM kind
deriveFieldContent

deriveFieldContent :: forall f kind a. (DeriveType kind a) => f a -> TyContentM kind
deriveFieldContent :: forall (f :: * -> *) (kind :: TypeCategory) a.
DeriveType kind a =>
f a -> TyContentM kind
deriveFieldContent f a
_ = forall (kind :: TypeCategory) a (f :: * -> *).
DeriveType kind a =>
f a -> SchemaT kind ()
deriveType KindedProxy kind a
kindedProxy forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (kind :: TypeCategory) a (f :: * -> *).
DeriveType kind a =>
f a -> TyContentM kind
deriveContent KindedProxy kind a
kindedProxy
  where
    kindedProxy :: KindedProxy kind a
    kindedProxy :: KindedProxy kind a
kindedProxy = forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy

deriveTypeContent ::
  forall kind a.
  DeriveTypeConstraint kind a =>
  KindedType kind a ->
  SchemaT kind (TypeContent TRUE kind CONST)
deriveTypeContent :: forall (kind :: TypeCategory) a.
DeriveTypeConstraint kind a =>
KindedType kind a -> SchemaT kind (TypeContent TRUE kind CONST)
deriveTypeContent KindedType kind a
kindedProxy =
  forall (m :: * -> *) a. Monad m => [ConsRep (m a)] -> m [ConsRep a]
unpackMonad
    (forall (kinded :: TypeCategory -> * -> *)
       (constraint :: * -> Constraint) value a (kind :: TypeCategory).
(GQLType a, CategoryValue kind,
 TypeRep constraint value (Rep a)) =>
TypeConstraint constraint value Proxy
-> kinded kind a -> [ConsRep value]
toRep (forall {k} (f :: TypeCategory -> k -> *) (kind :: TypeCategory)
       (a :: k).
f kind a
-> TypeConstraint (DeriveType kind) (TyContentM kind) Proxy
fieldContentConstraint KindedType kind a
kindedProxy) KindedType kind a
kindedProxy)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (kind :: TypeCategory).
(GQLType a, CategoryValue kind) =>
KindedType kind a
-> [ConsRep (TyContent kind)]
-> SchemaT kind (TypeContent TRUE kind CONST)
buildTypeContent KindedType kind a
kindedProxy