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

module Data.Morpheus.Server.Deriving.Schema.DeriveKinded
  ( DeriveKindedType (..),
    DeriveArgs (..),
    toFieldContent,
    DERIVE_TYPE,
  )
where

import Control.Monad.Except (throwError)
import Data.Morpheus.App.Internal.Resolving
  ( Resolver,
  )
import Data.Morpheus.Internal.Ext
import Data.Morpheus.Internal.Utils (singleton)
import Data.Morpheus.Server.Deriving.Schema.Internal
  ( CatType,
    TyContentM,
  )
import Data.Morpheus.Server.Deriving.Schema.TypeContent
import Data.Morpheus.Server.Deriving.Utils
  ( DeriveTypeOptions (..),
    DeriveWith,
    symbolName,
  )
import Data.Morpheus.Server.Deriving.Utils.Kinded
  ( CatContext (..),
    CatType (..),
    addContext,
    catMap,
    getCat,
    getCatContext,
    inputType,
    mkScalar,
    outputType,
    unliftKind,
  )
import Data.Morpheus.Server.Deriving.Utils.Use
import Data.Morpheus.Server.Types.Internal (TypeData (..))
import Data.Morpheus.Server.Types.Kind
  ( CUSTOM,
    DerivingKind,
    SCALAR,
    TYPE,
    WRAPPER,
  )
import Data.Morpheus.Server.Types.SchemaT
  ( SchemaT,
    extendImplements,
  )
import Data.Morpheus.Server.Types.Types
  ( Arg (..),
    TypeGuard,
  )
import Data.Morpheus.Types.GQLScalar
  ( DecodeScalar (..),
    scalarValidator,
  )
import Data.Morpheus.Types.Internal.AST
  ( ArgumentsDefinition,
    CONST,
    FieldContent (..),
    IN,
    OUT,
    ScalarDefinition (..),
    TRUE,
    TypeCategory (IN),
    TypeContent (..),
    TypeName,
    TypeRef (..),
    UnionMember (memberName),
    Value,
    fieldsToArguments,
    mkField,
  )
import GHC.Generics
import GHC.TypeLits
import Relude

type DERIVE_TYPE gql derive k a = (gql a, DeriveWith gql (derive k) (TyContentM k) (Rep a))

toFieldContent :: CatContext kind -> UseDirective gql dir -> UseDeriveType derive -> DeriveTypeOptions kind gql (derive kind) (TyContentM kind)
toFieldContent :: forall (kind :: TypeCategory) (gql :: * -> Constraint)
       (dir :: * -> Constraint)
       (derive :: TypeCategory -> * -> Constraint).
CatContext kind
-> UseDirective gql dir
-> UseDeriveType derive
-> DeriveTypeOptions kind gql (derive kind) (TyContentM kind)
toFieldContent CatContext kind
catCtx UseDirective {UseArguments dir
UseGQLType gql
forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql dir
dirGQL :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
UseDirective gql args -> UseGQLType gql
dirArgs :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
UseDirective gql args -> UseArguments args
__directives :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
UseDirective gql args
-> forall (f :: * -> *) a.
   gql a =>
   f a -> GDirectiveUsages gql args
dirGQL :: UseGQLType gql
dirArgs :: UseArguments dir
__directives :: forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql dir
..} UseDeriveType derive
ops =
  DeriveTypeOptions
    { __typeGetType :: forall (f :: * -> *) a. gql a => f a -> TypeData
__typeGetType = \f a
x -> forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (f :: * -> *) a. gql a => f a -> TypeCategory -> TypeData
__useTypeData UseGQLType gql
dirGQL f a
x (forall (c :: TypeCategory). CatContext c -> TypeCategory
getCat CatContext kind
catCtx),
      __typeApply :: forall (f :: * -> *) a. derive kind a => f a -> TyContentM kind
__typeApply = \f a
proxy -> forall (derive :: TypeCategory -> * -> Constraint).
UseDeriveType derive
-> forall (c :: TypeCategory) a.
   derive c a =>
   CatType c a -> SchemaT c ()
useDeriveType UseDeriveType derive
ops (forall {k} (c :: TypeCategory) (f :: k -> *) (a :: k).
CatContext c -> f a -> CatType c a
addContext CatContext kind
catCtx f a
proxy) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (derive :: TypeCategory -> * -> Constraint).
UseDeriveType derive
-> forall (c :: TypeCategory) a.
   derive c a =>
   CatType c a -> TyContentM c
useDeriveContent UseDeriveType derive
ops (forall {k} (c :: TypeCategory) (f :: k -> *) (a :: k).
CatContext c -> f a -> CatType c a
addContext CatContext kind
catCtx f a
proxy)
    }

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

instance (derive cat a) => DeriveKindedType gql derive dir cat WRAPPER (f a) where
  deriveKindedType :: forall {k} (f :: DerivingKind -> k -> k).
UseDirective gql dir
-> UseDeriveType derive
-> CatType cat (f WRAPPER (f a))
-> SchemaT cat ()
deriveKindedType UseDirective gql dir
_ UseDeriveType {forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> TyContentM c
forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveContent :: forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> TyContentM c
useDeriveType :: forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveContent :: forall (derive :: TypeCategory -> * -> Constraint).
UseDeriveType derive
-> forall (c :: TypeCategory) a.
   derive c a =>
   CatType c a -> TyContentM c
useDeriveType :: forall (derive :: TypeCategory -> * -> Constraint).
UseDeriveType derive
-> forall (c :: TypeCategory) a.
   derive c a =>
   CatType c a -> SchemaT c ()
..} = forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveType 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 (DecodeScalar a, gql a) => DeriveKindedType gql derive dir cat SCALAR a where
  deriveKindedType :: forall {k} (f :: DerivingKind -> * -> k).
UseDirective gql dir
-> UseDeriveType derive
-> CatType cat (f SCALAR a)
-> SchemaT cat ()
deriveKindedType UseDirective gql dir
dirs UseDeriveType derive
_ CatType cat (f SCALAR a)
proxy = forall (k :: TypeCategory) (gql :: * -> Constraint)
       (args :: * -> Constraint) a.
gql a =>
UseDirective gql args
-> (CatType k a -> SchemaT k (TypeContent TRUE k CONST))
-> CatType k a
-> SchemaT k ()
insertTypeContent UseDirective gql dir
dirs (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (c :: TypeCategory) (a :: k) (s :: Stage).
CatType c a -> ScalarDefinition -> TypeContent TRUE c s
mkScalar CatType cat (f SCALAR a)
proxy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. DecodeScalar a => f a -> ScalarDefinition
scalarValidator) (forall {k1} {k2} {k3} (cat :: TypeCategory) (f :: k1 -> k2 -> k3)
       (k4 :: k1) (a :: k2).
CatType cat (f k4 a) -> CatType cat a
unliftKind CatType cat (f SCALAR a)
proxy)

instance DERIVE_TYPE gql derive cat a => DeriveKindedType gql derive dir cat TYPE a where
  deriveKindedType :: forall {k} (f :: DerivingKind -> * -> k).
UseDirective gql dir
-> UseDeriveType derive -> CatType cat (f TYPE a) -> SchemaT cat ()
deriveKindedType UseDirective gql dir
dirs UseDeriveType derive
ops CatType cat (f TYPE a)
proxy = forall (k :: TypeCategory) (gql :: * -> Constraint)
       (args :: * -> Constraint) a.
gql a =>
UseDirective gql args
-> (CatType k a -> SchemaT k (TypeContent TRUE k CONST))
-> CatType k a
-> SchemaT k ()
insertTypeContent UseDirective gql dir
dirs (forall (gql :: * -> Constraint) (derive :: * -> Constraint)
       (kind :: TypeCategory) a (args :: * -> Constraint).
(DeriveWith gql derive (SchemaT kind (TyContent kind)) (Rep a),
 gql a) =>
UseDirective gql args
-> DeriveTypeOptions
     kind gql derive (SchemaT kind (TyContent kind))
-> CatType kind a
-> SchemaT kind (TypeContent TRUE kind CONST)
deriveTypeContentWith UseDirective gql dir
dirs (forall (kind :: TypeCategory) (gql :: * -> Constraint)
       (dir :: * -> Constraint)
       (derive :: TypeCategory -> * -> Constraint).
CatContext kind
-> UseDirective gql dir
-> UseDeriveType derive
-> DeriveTypeOptions kind gql (derive kind) (TyContentM kind)
toFieldContent (forall {k} (c :: TypeCategory) (a :: k).
CatType c a -> CatContext c
getCatContext CatType cat (f TYPE a)
proxy) UseDirective gql dir
dirs UseDeriveType derive
ops)) (forall {k1} {k2} {k3} (cat :: TypeCategory) (f :: k1 -> k2 -> k3)
       (k4 :: k1) (a :: k2).
CatType cat (f k4 a) -> CatType cat a
unliftKind CatType cat (f TYPE a)
proxy)

instance (derive cat a) => DeriveKindedType gql derive dir cat CUSTOM (Resolver o e m a) where
  deriveKindedType :: forall {k} (f :: DerivingKind -> * -> k).
UseDirective gql dir
-> UseDeriveType derive
-> CatType cat (f CUSTOM (Resolver o e m a))
-> SchemaT cat ()
deriveKindedType UseDirective gql dir
_ UseDeriveType {forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> TyContentM c
forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveContent :: forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> TyContentM c
useDeriveType :: forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveContent :: forall (derive :: TypeCategory -> * -> Constraint).
UseDeriveType derive
-> forall (c :: TypeCategory) a.
   derive c a =>
   CatType c a -> TyContentM c
useDeriveType :: forall (derive :: TypeCategory -> * -> Constraint).
UseDeriveType derive
-> forall (c :: TypeCategory) a.
   derive c a =>
   CatType c a -> SchemaT c ()
..} = forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveType 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 (gql (Value CONST)) => DeriveKindedType gql derive dir cat CUSTOM (Value CONST) where
  deriveKindedType :: forall {k} (f :: DerivingKind -> * -> k).
UseDirective gql dir
-> UseDeriveType derive
-> CatType cat (f CUSTOM (Value CONST))
-> SchemaT cat ()
deriveKindedType UseDirective gql dir
dirs UseDeriveType derive
_ CatType cat (f CUSTOM (Value CONST))
proxy = forall (k :: TypeCategory) (gql :: * -> Constraint)
       (args :: * -> Constraint) a.
gql a =>
UseDirective gql args
-> (CatType k a -> SchemaT k (TypeContent TRUE k CONST))
-> CatType k a
-> SchemaT k ()
insertTypeContent UseDirective gql dir
dirs (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (c :: TypeCategory) (a :: k) (s :: Stage).
CatType c a -> ScalarDefinition -> TypeContent TRUE c s
mkScalar CatType cat (f CUSTOM (Value CONST))
proxy forall a b. (a -> b) -> a -> b
$ (Value VALID -> Either Token (Value VALID)) -> ScalarDefinition
ScalarDefinition forall (f :: * -> *) a. Applicative f => a -> f a
pure) (forall {k1} {k2} {k3} (cat :: TypeCategory) (f :: k1 -> k2 -> k3)
       (k4 :: k1) (a :: k2).
CatType cat (f k4 a) -> CatType cat a
unliftKind CatType cat (f CUSTOM (Value CONST))
proxy)

instance (derive cat [(k, v)]) => DeriveKindedType gql derive dir cat CUSTOM (Map k v) where
  deriveKindedType :: forall {k} (f :: DerivingKind -> * -> k).
UseDirective gql dir
-> UseDeriveType derive
-> CatType cat (f CUSTOM (Map k v))
-> SchemaT cat ()
deriveKindedType UseDirective gql dir
_ UseDeriveType {forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> TyContentM c
forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveContent :: forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> TyContentM c
useDeriveType :: forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveContent :: forall (derive :: TypeCategory -> * -> Constraint).
UseDeriveType derive
-> forall (c :: TypeCategory) a.
   derive c a =>
   CatType c a -> TyContentM c
useDeriveType :: forall (derive :: TypeCategory -> * -> Constraint).
UseDeriveType derive
-> forall (c :: TypeCategory) a.
   derive c a =>
   CatType c a -> SchemaT c ()
..} = forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveType 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
  ( DERIVE_TYPE gql derive OUT interface,
    DERIVE_TYPE gql derive OUT union
  ) =>
  DeriveKindedType gql derive dir OUT CUSTOM (TypeGuard interface union)
  where
  deriveKindedType :: forall {k} (f :: DerivingKind -> * -> k).
UseDirective gql dir
-> UseDeriveType derive
-> CatType OUT (f CUSTOM (TypeGuard interface union))
-> SchemaT OUT ()
deriveKindedType UseDirective gql dir
dir UseDeriveType derive
ops CatType OUT (f CUSTOM (TypeGuard interface union))
OutputType = do
    forall (k :: TypeCategory) (gql :: * -> Constraint)
       (args :: * -> Constraint) a.
gql a =>
UseDirective gql args
-> (CatType k a -> SchemaT k (TypeContent TRUE k CONST))
-> CatType k a
-> SchemaT k ()
insertTypeContent UseDirective gql dir
dir (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 (gql :: * -> Constraint) a (derive :: * -> Constraint)
       (cat :: TypeCategory) (args :: * -> Constraint).
(gql a,
 DeriveWith gql derive (SchemaT cat (TyContent cat)) (Rep a)) =>
UseDirective gql args
-> DeriveTypeOptions cat gql derive (SchemaT cat (TyContent cat))
-> CatType cat a
-> SchemaT cat (FieldsDefinition cat CONST)
deriveFieldsWith UseDirective gql dir
dir (forall (kind :: TypeCategory) (gql :: * -> Constraint)
       (dir :: * -> Constraint)
       (derive :: TypeCategory -> * -> Constraint).
CatContext kind
-> UseDirective gql dir
-> UseDeriveType derive
-> DeriveTypeOptions kind gql (derive kind) (TyContentM kind)
toFieldContent CatContext OUT
OutputContext UseDirective gql dir
dir UseDeriveType derive
ops) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a
outputType) CatType OUT interface
interfaceProxy
    TypeContent TRUE OUT CONST
content <- forall (gql :: * -> Constraint) (derive :: * -> Constraint)
       (kind :: TypeCategory) a (args :: * -> Constraint).
(DeriveWith gql derive (SchemaT kind (TyContent kind)) (Rep a),
 gql a) =>
UseDirective gql args
-> DeriveTypeOptions
     kind gql derive (SchemaT kind (TyContent kind))
-> CatType kind a
-> SchemaT kind (TypeContent TRUE kind CONST)
deriveTypeContentWith UseDirective gql dir
dir (forall (kind :: TypeCategory) (gql :: * -> Constraint)
       (dir :: * -> Constraint)
       (derive :: TypeCategory -> * -> Constraint).
CatContext kind
-> UseDirective gql dir
-> UseDeriveType derive
-> DeriveTypeOptions kind gql (derive kind) (TyContentM kind)
toFieldContent CatContext OUT
OutputContext UseDirective gql dir
dir UseDeriveType derive
ops) (forall {k} (a :: k). CatType OUT a
OutputType :: CatType 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 = forall (gqlType :: * -> Constraint) a (c :: TypeCategory).
gqlType a =>
UseGQLType gqlType -> CatType c a -> TypeName
useTypename (forall (gql :: * -> Constraint) (args :: * -> Constraint).
UseDirective gql args -> UseGQLType gql
dirGQL UseDirective gql dir
dir) CatType OUT interface
interfaceProxy
      interfaceProxy :: CatType OUT interface
      interfaceProxy :: CatType OUT interface
interfaceProxy = forall {k} (a :: k). CatType OUT a
OutputType
      unionProxy :: CatType OUT union
      unionProxy :: CatType OUT union
unionProxy = forall {k} (a :: k). CatType OUT a
OutputType
      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 (gqlType :: * -> Constraint) a (c :: TypeCategory).
gqlType a =>
UseGQLType gqlType -> CatType c a -> TypeName
useTypename (forall (gql :: * -> Constraint) (args :: * -> Constraint).
UseDirective gql args -> UseGQLType gql
dirGQL UseDirective gql dir
dir) CatType 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 (derive OUT b, dir a) => DeriveKindedType gql derive dir OUT CUSTOM (a -> b) where
  deriveKindedContent :: forall {k} (f :: DerivingKind -> * -> k).
UseDirective gql dir
-> UseDeriveType derive
-> CatType OUT (f CUSTOM (a -> b))
-> TyContentM OUT
deriveKindedContent UseDirective gql dir
dir UseDeriveType {forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> TyContentM c
forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveContent :: forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> TyContentM c
useDeriveType :: forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveContent :: forall (derive :: TypeCategory -> * -> Constraint).
UseDeriveType derive
-> forall (c :: TypeCategory) a.
   derive c a =>
   CatType c a -> TyContentM c
useDeriveType :: forall (derive :: TypeCategory -> * -> Constraint).
UseDeriveType derive
-> forall (c :: TypeCategory) a.
   derive c a =>
   CatType c a -> SchemaT c ()
..} CatType OUT (f CUSTOM (a -> b))
OutputType = do
    ArgumentsDefinition CONST
a <- forall (args :: * -> Constraint).
UseArguments args
-> forall (f :: * -> *) a.
   args a =>
   f a -> SchemaT OUT (ArgumentsDefinition CONST)
useDeriveArguments (forall (gql :: * -> Constraint) (args :: * -> Constraint).
UseDirective gql args -> UseArguments args
dirArgs UseDirective gql dir
dir) (forall {k} (t :: k). Proxy t
Proxy @a)
    TyContent OUT
b <- forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> TyContentM c
useDeriveContent (forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT 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 {k} (f :: DerivingKind -> * -> k).
UseDirective gql dir
-> UseDeriveType derive
-> CatType OUT (f CUSTOM (a -> b))
-> SchemaT OUT ()
deriveKindedType UseDirective gql dir
_ UseDeriveType {forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> TyContentM c
forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveContent :: forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> TyContentM c
useDeriveType :: forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveContent :: forall (derive :: TypeCategory -> * -> Constraint).
UseDeriveType derive
-> forall (c :: TypeCategory) a.
   derive c a =>
   CatType c a -> TyContentM c
useDeriveType :: forall (derive :: TypeCategory -> * -> Constraint).
UseDeriveType derive
-> forall (c :: TypeCategory) a.
   derive c a =>
   CatType c a -> SchemaT c ()
..} CatType OUT (f CUSTOM (a -> b))
OutputType = forall (c :: TypeCategory) a.
derive c a =>
CatType c a -> SchemaT c ()
useDeriveType (forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a
outputType forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @b)

class DeriveArgs gql derive (k :: DerivingKind) a where
  deriveArgs :: UseDirective gql dir -> UseDeriveType derive -> f k a -> SchemaT IN (ArgumentsDefinition CONST)

instance (DERIVE_TYPE gql derive IN a) => DeriveArgs gql derive TYPE a where
  deriveArgs :: forall (dir :: * -> Constraint) (f :: DerivingKind -> * -> *).
UseDirective gql dir
-> UseDeriveType derive
-> f TYPE a
-> SchemaT IN (ArgumentsDefinition CONST)
deriveArgs UseDirective gql dir
dir UseDeriveType derive
ops = 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 (gql :: * -> Constraint) a (derive :: * -> Constraint)
       (cat :: TypeCategory) (args :: * -> Constraint).
(gql a,
 DeriveWith gql derive (SchemaT cat (TyContent cat)) (Rep a)) =>
UseDirective gql args
-> DeriveTypeOptions cat gql derive (SchemaT cat (TyContent cat))
-> CatType cat a
-> SchemaT cat (FieldsDefinition cat CONST)
deriveFieldsWith UseDirective gql dir
dir (forall (kind :: TypeCategory) (gql :: * -> Constraint)
       (dir :: * -> Constraint)
       (derive :: TypeCategory -> * -> Constraint).
CatContext kind
-> UseDirective gql dir
-> UseDeriveType derive
-> DeriveTypeOptions kind gql (derive kind) (TyContentM kind)
toFieldContent CatContext IN
InputContext UseDirective gql dir
dir UseDeriveType derive
ops) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> CatType IN a
inputType

instance (KnownSymbol name, derive IN a, gql a) => DeriveArgs gql derive CUSTOM (Arg name a) where
  deriveArgs :: forall (dir :: * -> Constraint) (f :: DerivingKind -> * -> *).
UseDirective gql dir
-> UseDeriveType derive
-> f CUSTOM (Arg name a)
-> SchemaT IN (ArgumentsDefinition CONST)
deriveArgs UseDirective gql dir
dir UseDeriveType derive
ops f CUSTOM (Arg name a)
_ = do
    forall (derive :: TypeCategory -> * -> Constraint).
UseDeriveType derive
-> forall (c :: TypeCategory) a.
   derive c a =>
   CatType c a -> SchemaT c ()
useDeriveType UseDeriveType derive
ops CatType 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 :: CatType IN a
      proxy :: CatType IN a
proxy = forall {k} (a :: k). CatType IN a
InputType
      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 = TypeRef {typeConName :: TypeName
typeConName = TypeName
gqlTypeName, typeWrappers :: TypeWrapper
typeWrappers = TypeWrapper
gqlWrappers}
      TypeData {TypeName
gqlTypeName :: TypeData -> TypeName
gqlTypeName :: TypeName
gqlTypeName, TypeWrapper
gqlWrappers :: TypeData -> TypeWrapper
gqlWrappers :: TypeWrapper
gqlWrappers} = forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (f :: * -> *) a. gql a => f a -> TypeCategory -> TypeData
__useTypeData (forall (gql :: * -> Constraint) (args :: * -> Constraint).
UseDirective gql args -> UseGQLType gql
dirGQL UseDirective gql dir
dir) CatType IN a
proxy TypeCategory
IN