{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.Morpheus.Server.Deriving.Internal.Schema.Type
  ( fillTypeContent,
    deriveTypeDefinition,
    deriveScalarDefinition,
    deriveInterfaceDefinition,
    deriveTypeGuardUnions,
    useDeriveObject,
    injectType,
  )
where

import Control.Monad.Except
import Data.Foldable
import Data.Morpheus.Server.Deriving.Internal.Schema.Directive
  ( UseDeriving (..),
    deriveTypeDirectives,
    visitTypeDescription,
  )
import Data.Morpheus.Server.Deriving.Internal.Schema.Enum
  ( buildEnumTypeContent,
  )
import Data.Morpheus.Server.Deriving.Internal.Schema.Internal
  ( CatType,
    withObject,
  )
import Data.Morpheus.Server.Deriving.Internal.Schema.Object
  ( buildObjectTypeContent,
  )
import Data.Morpheus.Server.Deriving.Internal.Schema.Union (buildUnionTypeContent)
import Data.Morpheus.Server.Deriving.Utils.GRep
  ( ConsRep (..),
    GRep,
    RepContext (..),
    deriveTypeWith,
    isEmptyConstraint,
    unpackMonad,
  )
import Data.Morpheus.Server.Deriving.Utils.Kinded (CatContext, addContext, getCatContext, mkScalar, outputType)
import Data.Morpheus.Server.Deriving.Utils.Use
  ( UseGQLType (..),
  )
import Data.Morpheus.Server.Types.SchemaT
  ( SchemaT,
    updateSchema,
  )
import Data.Morpheus.Types.Internal.AST
import GHC.Generics (Rep)
import Relude

buildTypeContent ::
  (gql a) =>
  UseDeriving gql args ->
  CatType kind a ->
  [ConsRep (Maybe (ArgumentsDefinition CONST))] ->
  SchemaT kind (TypeContent TRUE kind CONST)
buildTypeContent :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (kind :: TypeCategory).
gql a =>
UseDeriving gql args
-> CatType kind a
-> [ConsRep (Maybe (ArgumentsDefinition CONST))]
-> SchemaT kind (TypeContent TRUE kind CONST)
buildTypeContent UseDeriving gql args
options CatType kind a
scope [ConsRep (Maybe (ArgumentsDefinition CONST))]
cons | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. ConsRep a -> Bool
isEmptyConstraint [ConsRep (Maybe (ArgumentsDefinition CONST))]
cons = forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (kind :: TypeCategory) (k :: TypeCategory).
gql a =>
UseDeriving gql args
-> CatType kind a
-> [TypeName]
-> SchemaT k (TypeContent TRUE kind CONST)
buildEnumTypeContent UseDeriving gql args
options CatType kind a
scope (forall v. ConsRep v -> TypeName
consName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ConsRep (Maybe (ArgumentsDefinition CONST))]
cons)
buildTypeContent UseDeriving gql args
options CatType kind a
scope [ConsRep {[FieldRep (Maybe (ArgumentsDefinition CONST))]
consFields :: forall v. ConsRep v -> [FieldRep v]
consFields :: [FieldRep (Maybe (ArgumentsDefinition CONST))]
consFields}] = forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (cat :: TypeCategory) (k :: TypeCategory).
gql a =>
UseDeriving gql args
-> CatType cat a
-> [FieldRep (Maybe (ArgumentsDefinition CONST))]
-> SchemaT k (TypeContent TRUE cat CONST)
buildObjectTypeContent UseDeriving gql args
options CatType kind a
scope [FieldRep (Maybe (ArgumentsDefinition CONST))]
consFields
buildTypeContent UseDeriving gql args
options CatType kind a
scope [ConsRep (Maybe (ArgumentsDefinition CONST))]
cons = forall (gql :: * -> Constraint) a (kind :: TypeCategory)
       (k :: TypeCategory).
gql a =>
UseGQLType gql
-> CatType kind a
-> [ConsRep (Maybe (ArgumentsDefinition CONST))]
-> SchemaT k (TypeContent TRUE kind CONST)
buildUnionTypeContent (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL UseDeriving gql args
options) CatType kind a
scope [ConsRep (Maybe (ArgumentsDefinition CONST))]
cons

deriveTypeContentWith ::
  (gql a, GRep gql gql (SchemaT kind (Maybe (ArgumentsDefinition CONST))) (Rep a)) =>
  UseDeriving gql args ->
  CatType kind a ->
  SchemaT kind (TypeContent TRUE kind CONST)
deriveTypeContentWith :: forall (gql :: * -> Constraint) a (kind :: TypeCategory)
       (args :: * -> Constraint).
(gql a,
 GRep
   gql
   gql
   (SchemaT kind (Maybe (ArgumentsDefinition CONST)))
   (Rep a)) =>
UseDeriving gql args
-> CatType kind a -> SchemaT kind (TypeContent TRUE kind CONST)
deriveTypeContentWith UseDeriving gql args
dir CatType kind a
proxy =
  forall (m :: * -> *) a. Monad m => [ConsRep (m a)] -> m [ConsRep a]
unpackMonad (forall {k} (kind :: k) (gql :: * -> Constraint)
       (c :: * -> Constraint) v (kinded :: k -> * -> *) a.
GRep gql c v (Rep a) =>
RepContext gql c Proxy v -> kinded kind a -> [ConsRep v]
deriveTypeWith (forall (cat :: TypeCategory) (gql :: * -> Constraint)
       (dir :: * -> Constraint).
CatContext cat
-> UseDeriving gql dir
-> RepContext
     gql gql Proxy (SchemaT cat (Maybe (ArgumentsDefinition CONST)))
toFieldContent (forall {k} (c :: TypeCategory) (a :: k).
CatType c a -> CatContext c
getCatContext CatType kind a
proxy) UseDeriving gql args
dir) CatType kind a
proxy)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (kind :: TypeCategory).
gql a =>
UseDeriving gql args
-> CatType kind a
-> [ConsRep (Maybe (ArgumentsDefinition CONST))]
-> SchemaT kind (TypeContent TRUE kind CONST)
buildTypeContent UseDeriving gql args
dir CatType kind a
proxy

deriveTypeGuardUnions ::
  ( gql a,
    GRep gql gql (SchemaT OUT (Maybe (ArgumentsDefinition CONST))) (Rep a)
  ) =>
  UseDeriving gql args ->
  CatType OUT a ->
  SchemaT OUT [TypeName]
deriveTypeGuardUnions :: 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 gql args
dir CatType OUT a
proxy = do
  TypeContent TRUE OUT CONST
content <- forall (gql :: * -> Constraint) a (kind :: TypeCategory)
       (args :: * -> Constraint).
(gql a,
 GRep
   gql
   gql
   (SchemaT kind (Maybe (ArgumentsDefinition CONST)))
   (Rep a)) =>
UseDeriving gql args
-> CatType kind a -> SchemaT kind (TypeContent TRUE kind CONST)
deriveTypeContentWith UseDeriving gql args
dir CatType OUT a
proxy
  TypeContent TRUE OUT CONST -> SchemaT OUT [TypeName]
getUnionNames TypeContent TRUE OUT CONST
content
  where
    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 [forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeName
useTypename (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL UseDeriving gql args
dir) CatType OUT a
proxy]
    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"

insertType ::
  forall c gql a args.
  (gql a) =>
  UseDeriving gql args ->
  (UseDeriving gql args -> CatType c a -> SchemaT c (TypeDefinition c CONST)) ->
  CatType c a ->
  SchemaT c ()
insertType :: forall (c :: TypeCategory) (gql :: * -> Constraint) a
       (args :: * -> Constraint).
gql a =>
UseDeriving gql args
-> (UseDeriving gql args
    -> CatType c a -> SchemaT c (TypeDefinition c CONST))
-> CatType c a
-> SchemaT c ()
insertType UseDeriving gql args
dir UseDeriving gql args
-> CatType c a -> SchemaT c (TypeDefinition c CONST)
f CatType c a
proxy = forall a (cat' :: TypeCategory) (cat :: TypeCategory).
TypeFingerprint
-> (a -> SchemaT cat' (TypeDefinition cat CONST))
-> a
-> SchemaT cat' ()
updateSchema (forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a.
   gql a =>
   CatType c a -> TypeFingerprint
useFingerprint (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL UseDeriving gql args
dir) CatType c a
proxy) (UseDeriving gql args
-> CatType c a -> SchemaT c (TypeDefinition c CONST)
f UseDeriving gql args
dir) CatType c a
proxy

deriveScalarDefinition ::
  gql a =>
  (CatType cat a -> ScalarDefinition) ->
  UseDeriving gql args ->
  CatType cat a ->
  SchemaT kind (TypeDefinition cat CONST)
deriveScalarDefinition :: 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 CatType cat a -> ScalarDefinition
f UseDeriving gql args
dir CatType cat a
p = 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 gql args
dir CatType cat a
p (forall {k} (c :: TypeCategory) (a :: k) (s :: Stage).
CatType c a -> ScalarDefinition -> TypeContent TRUE c s
mkScalar CatType cat a
p (CatType cat a -> ScalarDefinition
f CatType cat a
p))

deriveTypeDefinition ::
  (gql a, GRep gql gql (SchemaT c (Maybe (ArgumentsDefinition CONST))) (Rep a)) =>
  UseDeriving gql args ->
  CatType c a ->
  SchemaT c (TypeDefinition c CONST)
deriveTypeDefinition :: forall (gql :: * -> Constraint) a (c :: TypeCategory)
       (args :: * -> Constraint).
(gql a,
 GRep
   gql gql (SchemaT c (Maybe (ArgumentsDefinition CONST))) (Rep a)) =>
UseDeriving gql args
-> CatType c a -> SchemaT c (TypeDefinition c CONST)
deriveTypeDefinition UseDeriving gql args
dir CatType c a
proxy = forall (gql :: * -> Constraint) a (kind :: TypeCategory)
       (args :: * -> Constraint).
(gql a,
 GRep
   gql
   gql
   (SchemaT kind (Maybe (ArgumentsDefinition CONST)))
   (Rep a)) =>
UseDeriving gql args
-> CatType kind a -> SchemaT kind (TypeContent TRUE kind CONST)
deriveTypeContentWith UseDeriving gql args
dir CatType c a
proxy forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 gql args
dir CatType c a
proxy

deriveInterfaceDefinition ::
  (gql a, GRep gql gql (SchemaT OUT (Maybe (ArgumentsDefinition CONST))) (Rep a)) =>
  UseDeriving gql args ->
  CatType OUT a ->
  SchemaT OUT (TypeDefinition OUT CONST)
deriveInterfaceDefinition :: 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 gql args
dir CatType OUT a
proxy = do
  FieldsDefinition OUT CONST
fields <- forall (gql :: * -> Constraint) a (cat :: TypeCategory)
       (args :: * -> Constraint).
(gql a,
 GRep
   gql
   gql
   (SchemaT cat (Maybe (ArgumentsDefinition CONST)))
   (Rep a)) =>
UseDeriving gql args
-> CatType cat a -> SchemaT cat (FieldsDefinition cat CONST)
deriveFields UseDeriving gql args
dir CatType OUT a
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 gql args
dir CatType OUT a
proxy (forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> TypeContent (IMPLEMENTABLE <=? a) a s
DataInterface FieldsDefinition OUT CONST
fields)

fillTypeContent ::
  gql a =>
  UseDeriving gql args ->
  CatType c a ->
  TypeContent TRUE cat CONST ->
  SchemaT kind (TypeDefinition cat CONST)
fillTypeContent :: 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 options :: UseDeriving gql args
options@UseDeriving {dirGQL :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL = UseGQLType {forall (c :: TypeCategory) a. gql a => CatType c a -> TypeName
forall (c :: TypeCategory) a.
gql a =>
CatType c a -> TypeFingerprint
forall (c :: TypeCategory) a.
gql a =>
CatType c a -> SchemaT c (Maybe (ArgumentsDefinition CONST))
forall (c :: TypeCategory) a.
gql a =>
CatType c a -> SchemaT c (TypeDefinition c CONST)
forall (c :: TypeCategory) a. gql a => CatType c a -> TypeData
useDeriveFieldArguments :: forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a.
   gql a =>
   CatType c a -> SchemaT c (Maybe (ArgumentsDefinition CONST))
useDeriveType :: forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a.
   gql a =>
   CatType c a -> SchemaT c (TypeDefinition c CONST)
useTypeData :: forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeData
useDeriveFieldArguments :: forall (c :: TypeCategory) a.
gql a =>
CatType c a -> SchemaT c (Maybe (ArgumentsDefinition CONST))
useDeriveType :: forall (c :: TypeCategory) a.
gql a =>
CatType c a -> SchemaT c (TypeDefinition c CONST)
useTypeData :: forall (c :: TypeCategory) a. gql a => CatType c a -> TypeData
useTypename :: forall (c :: TypeCategory) a. gql a => CatType c a -> TypeName
useFingerprint :: forall (c :: TypeCategory) a.
gql a =>
CatType c a -> TypeFingerprint
useFingerprint :: forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a.
   gql a =>
   CatType c a -> TypeFingerprint
useTypename :: forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeName
..}} CatType c a
proxy TypeContent TRUE cat CONST
content = do
  Directives CONST
dirs <- forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *) (kind :: TypeCategory).
gql a =>
UseDeriving gql args -> f a -> SchemaT kind (Directives CONST)
deriveTypeDirectives UseDeriving gql args
options CatType c a
proxy
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall (a :: TypeCategory) (s :: Stage).
Maybe Description
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition
      (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> Maybe Description -> Maybe Description
visitTypeDescription UseDeriving gql args
options CatType c a
proxy forall a. Maybe a
Nothing)
      (forall (c :: TypeCategory) a. gql a => CatType c a -> TypeName
useTypename CatType c a
proxy)
      Directives CONST
dirs
      TypeContent TRUE cat CONST
content

deriveFields ::
  ( gql a,
    GRep gql gql (SchemaT cat (Maybe (ArgumentsDefinition CONST))) (Rep a)
  ) =>
  UseDeriving gql args ->
  CatType cat a ->
  SchemaT cat (FieldsDefinition cat CONST)
deriveFields :: forall (gql :: * -> Constraint) a (cat :: TypeCategory)
       (args :: * -> Constraint).
(gql a,
 GRep
   gql
   gql
   (SchemaT cat (Maybe (ArgumentsDefinition CONST)))
   (Rep a)) =>
UseDeriving gql args
-> CatType cat a -> SchemaT cat (FieldsDefinition cat CONST)
deriveFields UseDeriving gql args
dirs CatType cat a
kindedType = forall (gql :: * -> Constraint) a (kind :: TypeCategory)
       (args :: * -> Constraint).
(gql a,
 GRep
   gql
   gql
   (SchemaT kind (Maybe (ArgumentsDefinition CONST)))
   (Rep a)) =>
UseDeriving gql args
-> CatType kind a -> SchemaT kind (TypeContent TRUE kind CONST)
deriveTypeContentWith UseDeriving gql args
dirs CatType cat a
kindedType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (gql :: * -> Constraint) a (c :: TypeCategory)
       (any :: TypeCategory) (s :: Stage).
gql a =>
UseGQLType gql
-> CatType c a
-> TypeContent TRUE any s
-> SchemaT c (FieldsDefinition c s)
withObject (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL UseDeriving gql args
dirs) CatType cat a
kindedType

toFieldContent :: CatContext cat -> UseDeriving gql dir -> RepContext gql gql Proxy (SchemaT cat (Maybe (ArgumentsDefinition CONST)))
toFieldContent :: forall (cat :: TypeCategory) (gql :: * -> Constraint)
       (dir :: * -> Constraint).
CatContext cat
-> UseDeriving gql dir
-> RepContext
     gql gql Proxy (SchemaT cat (Maybe (ArgumentsDefinition CONST)))
toFieldContent CatContext cat
ctx dir :: UseDeriving gql dir
dir@UseDeriving {UseValue dir
UseGQLType gql
forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql dir
dirArgs :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseValue val
__directives :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val
-> forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql val
dirGQL :: UseGQLType gql
dirArgs :: UseValue dir
__directives :: forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql dir
dirGQL :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
..} =
  RepContext
    { optTypeData :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeData
optTypeData = forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeData
useTypeData UseGQLType gql
dirGQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (c :: TypeCategory) (f :: k -> *) (a :: k).
CatContext c -> f a -> CatType c a
addContext CatContext cat
ctx,
      optApply :: forall a.
gql a =>
Proxy a -> SchemaT cat (Maybe (ArgumentsDefinition CONST))
optApply = \Proxy a
proxy -> forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (c :: TypeCategory).
gql a =>
UseDeriving gql args -> CatType c a -> SchemaT c ()
injectType UseDeriving gql dir
dir (forall {k} (c :: TypeCategory) (f :: k -> *) (a :: k).
CatContext c -> f a -> CatType c a
addContext CatContext cat
ctx Proxy a
proxy) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a.
   gql a =>
   CatType c a -> SchemaT c (Maybe (ArgumentsDefinition CONST))
useDeriveFieldArguments UseGQLType gql
dirGQL (forall {k} (c :: TypeCategory) (f :: k -> *) (a :: k).
CatContext c -> f a -> CatType c a
addContext CatContext cat
ctx Proxy a
proxy)
    }

injectType :: gql a => UseDeriving gql args -> CatType c a -> SchemaT c ()
injectType :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (c :: TypeCategory).
gql a =>
UseDeriving gql args -> CatType c a -> SchemaT c ()
injectType UseDeriving gql args
dir = forall (c :: TypeCategory) (gql :: * -> Constraint) a
       (args :: * -> Constraint).
gql a =>
UseDeriving gql args
-> (UseDeriving gql args
    -> CatType c a -> SchemaT c (TypeDefinition c CONST))
-> CatType c a
-> SchemaT c ()
insertType UseDeriving gql args
dir (\UseDeriving gql args
_ CatType c a
y -> forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a.
   gql a =>
   CatType c a -> SchemaT c (TypeDefinition c CONST)
useDeriveType (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL UseDeriving gql args
dir) CatType c a
y)

useDeriveObject :: gql a => UseGQLType gql -> f a -> SchemaT OUT (TypeDefinition OBJECT CONST)
useDeriveObject :: forall (gql :: * -> Constraint) a (f :: * -> *).
gql a =>
UseGQLType gql -> f a -> SchemaT OUT (TypeDefinition OBJECT CONST)
useDeriveObject UseGQLType gql
gql f a
pr = do
  FieldsDefinition OUT CONST
fields <- forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a.
   gql a =>
   CatType c a -> SchemaT c (TypeDefinition c CONST)
useDeriveType UseGQLType gql
gql CatType OUT a
proxy forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (gql :: * -> Constraint) a (c :: TypeCategory)
       (any :: TypeCategory) (s :: Stage).
gql a =>
UseGQLType gql
-> CatType c a
-> TypeContent TRUE any s
-> SchemaT c (FieldsDefinition c s)
withObject UseGQLType gql
gql CatType OUT a
proxy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (a :: TypeCategory) (s :: Stage).
TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType (forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeName
useTypename UseGQLType gql
gql (forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a
outputType CatType OUT a
proxy)) (forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (OBJECT <=? a) a s
DataObject [] FieldsDefinition OUT CONST
fields)
  where
    proxy :: CatType OUT a
proxy = forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a
outputType f a
pr