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

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

-- MORPHEUS

import Control.Applicative (Applicative (..))
import Control.Monad ((>=>), (>>=))
import Data.Functor (($>), (<$>), Functor (..))
import Data.Map (Map)
import Data.Maybe (Maybe (..))
import Data.Morpheus.Core (defaultConfig, validateSchema)
import Data.Morpheus.Internal.Utils
  ( Failure (..),
  )
import Data.Morpheus.Kind
  ( ENUM,
    GQL_KIND,
    INPUT,
    INTERFACE,
    OUTPUT,
    SCALAR,
  )
import Data.Morpheus.Server.Deriving.Schema.Internal
  ( KindedProxy (..),
    KindedType (..),
    TyContentM,
    UpdateDef (..),
    asObjectType,
    builder,
    fromSchema,
    inputType,
    outputType,
    setProxyType,
    unpackMs,
    updateByContent,
    withObject,
  )
import Data.Morpheus.Server.Deriving.Utils
  ( TypeConstraint (..),
    TypeRep (..),
    genericTo,
  )
import Data.Morpheus.Server.Types.GQLType
  ( GQLType (..),
    TypeData (..),
  )
import Data.Morpheus.Server.Types.SchemaT
  ( SchemaT,
    toSchema,
  )
import Data.Morpheus.Server.Types.Types
  ( MapKind,
    Pair,
  )
import Data.Morpheus.Types.GQLScalar (GQLScalar (..))
import Data.Morpheus.Types.Internal.AST
  ( ArgumentsDefinition,
    CONST,
    CONST,
    FieldContent (..),
    FieldsDefinition,
    GQLErrors,
    IN,
    LEAF,
    MUTATION,
    OBJECT,
    OUT,
    QUERY,
    SUBSCRIPTION,
    Schema (..),
    TRUE,
    TypeCategory,
    TypeContent (..),
    TypeDefinition (..),
    TypeName,
    fieldsToArguments,
  )
import Data.Morpheus.Types.Internal.Resolving
  ( Resolver,
    SubscriptionField (..),
    resultOr,
  )
import Data.Proxy (Proxy (..))
import Data.Set (Set)
import GHC.Generics (Generic, Rep)
import Language.Haskell.TH (Exp, Q)
import Prelude
  ( ($),
    (.),
    Bool (..),
  )

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

-- | 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 :: proxy (root m event qu mu su) -> Q Exp
compileTimeSchemaValidation =
  Eventless (Schema VALID) -> Q Exp
fromSchema
    (Eventless (Schema VALID) -> Q Exp)
-> (proxy (root m event qu mu su) -> Eventless (Schema VALID))
-> proxy (root m event qu mu su)
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (proxy (root m event qu mu su) -> Result () (Schema CONST)
forall k
       (root :: (* -> *)
                -> * -> ((* -> *) -> *) -> ((* -> *) -> *) -> ((* -> *) -> *) -> k)
       (proxy :: k -> *) (m :: * -> *) e (query :: (* -> *) -> *)
       (mut :: (* -> *) -> *) (subs :: (* -> *) -> *) (f :: * -> *).
(SchemaConstraints e m query mut subs, Failure GQLErrors f) =>
proxy (root m e query mut subs) -> f (Schema CONST)
deriveSchema (proxy (root m event qu mu su) -> Result () (Schema CONST))
-> (Schema CONST -> Eventless (Schema VALID))
-> proxy (root m event qu mu su)
-> Eventless (Schema VALID)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Bool -> Config -> Schema CONST -> Eventless (Schema VALID)
forall (s :: Stage).
ValidateSchema s =>
Bool -> Config -> Schema s -> Eventless (Schema VALID)
validateSchema Bool
True Config
defaultConfig)

deriveSchema ::
  forall
    root
    proxy
    m
    e
    query
    mut
    subs
    f.
  ( SchemaConstraints e m query mut subs,
    Failure GQLErrors f
  ) =>
  proxy (root m e query mut subs) ->
  f (Schema CONST)
deriveSchema :: proxy (root m e query mut subs) -> f (Schema CONST)
deriveSchema proxy (root m e query mut subs)
_ = (GQLErrors -> f (Schema CONST))
-> (Schema CONST -> f (Schema CONST))
-> Result () (Schema CONST)
-> f (Schema CONST)
forall a' a e. (GQLErrors -> a') -> (a -> a') -> Result e a -> a'
resultOr GQLErrors -> f (Schema CONST)
forall error (f :: * -> *) v. Failure error f => error -> f v
failure Schema CONST -> f (Schema CONST)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result () (Schema CONST)
schema
  where
    schema :: Result () (Schema CONST)
schema = SchemaT
  (TypeDefinition OBJECT CONST, TypeDefinition OBJECT CONST,
   TypeDefinition OBJECT CONST)
-> Result () (Schema CONST)
toSchema SchemaT
  (TypeDefinition OBJECT CONST, TypeDefinition OBJECT CONST,
   TypeDefinition OBJECT CONST)
schemaT
    schemaT ::
      SchemaT
        ( TypeDefinition OBJECT CONST,
          TypeDefinition OBJECT CONST,
          TypeDefinition OBJECT CONST
        )
    schemaT :: SchemaT
  (TypeDefinition OBJECT CONST, TypeDefinition OBJECT CONST,
   TypeDefinition OBJECT CONST)
schemaT =
      (,,)
        (TypeDefinition OBJECT CONST
 -> TypeDefinition OBJECT CONST
 -> TypeDefinition OBJECT CONST
 -> (TypeDefinition OBJECT CONST, TypeDefinition OBJECT CONST,
     TypeDefinition OBJECT CONST))
-> SchemaT (TypeDefinition OBJECT CONST)
-> SchemaT
     (TypeDefinition OBJECT CONST
      -> TypeDefinition OBJECT CONST
      -> (TypeDefinition OBJECT CONST, TypeDefinition OBJECT CONST,
          TypeDefinition OBJECT CONST))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (query (Resolver QUERY e m))
-> SchemaT (TypeDefinition OBJECT CONST)
forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT (TypeDefinition OBJECT CONST)
deriveObjectType (Proxy (query (Resolver QUERY e m))
forall k (t :: k). Proxy t
Proxy @(query (Resolver QUERY e m)))
        SchemaT
  (TypeDefinition OBJECT CONST
   -> TypeDefinition OBJECT CONST
   -> (TypeDefinition OBJECT CONST, TypeDefinition OBJECT CONST,
       TypeDefinition OBJECT CONST))
-> SchemaT (TypeDefinition OBJECT CONST)
-> SchemaT
     (TypeDefinition OBJECT CONST
      -> (TypeDefinition OBJECT CONST, TypeDefinition OBJECT CONST,
          TypeDefinition OBJECT CONST))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy (mut (Resolver MUTATION e m))
-> SchemaT (TypeDefinition OBJECT CONST)
forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT (TypeDefinition OBJECT CONST)
deriveObjectType (Proxy (mut (Resolver MUTATION e m))
forall k (t :: k). Proxy t
Proxy @(mut (Resolver MUTATION e m)))
        SchemaT
  (TypeDefinition OBJECT CONST
   -> (TypeDefinition OBJECT CONST, TypeDefinition OBJECT CONST,
       TypeDefinition OBJECT CONST))
-> SchemaT (TypeDefinition OBJECT CONST)
-> SchemaT
     (TypeDefinition OBJECT CONST, TypeDefinition OBJECT CONST,
      TypeDefinition OBJECT CONST)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy (subs (Resolver SUBSCRIPTION e m))
-> SchemaT (TypeDefinition OBJECT CONST)
forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT (TypeDefinition OBJECT CONST)
deriveObjectType (Proxy (subs (Resolver SUBSCRIPTION e m))
forall k (t :: k). Proxy t
Proxy @(subs (Resolver SUBSCRIPTION e m)))

instance {-# OVERLAPPABLE #-} (GQLType a, DeriveKindedType (KIND a) a) => DeriveType cat a where
  deriveType :: f cat a -> SchemaT ()
deriveType f cat a
_ = KindedProxy (KIND a) a -> SchemaT ()
forall k (kind :: GQL_KIND) (a :: k) (proxy :: GQL_KIND -> k -> *).
DeriveKindedType kind a =>
proxy kind a -> SchemaT ()
deriveKindedType (KindedProxy (KIND a) a
forall k k (k :: k) (a :: k). KindedProxy k a
KindedProxy :: KindedProxy (KIND a) a)

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

  deriveContent :: f kind a -> SchemaT (Maybe (FieldContent TRUE kind CONST))
  deriveContent f kind a
_ = Maybe (FieldContent TRUE kind CONST)
-> SchemaT (Maybe (FieldContent TRUE kind CONST))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (FieldContent TRUE kind CONST)
forall a. Maybe a
Nothing

deriveTypeWith :: DeriveType cat a => f a -> kinded cat b -> SchemaT ()
deriveTypeWith :: f a -> kinded cat b -> SchemaT ()
deriveTypeWith f a
x = KindedProxy cat a -> SchemaT ()
forall (kind :: TypeCategory) a (f :: TypeCategory -> * -> *).
DeriveType kind a =>
f kind a -> SchemaT ()
deriveType (KindedProxy cat a -> SchemaT ())
-> (kinded cat b -> KindedProxy cat a)
-> kinded cat b
-> SchemaT ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> kinded cat b -> KindedProxy cat a
forall k1 k2 k3 (f :: k1 -> *) (b :: k1) (kinded :: k2 -> k3 -> *)
       (k4 :: k2) (a :: k3).
f b -> kinded k4 a -> KindedProxy k4 b
setProxyType f a
x

-- Maybe
instance DeriveType cat a => DeriveType cat (Maybe a) where
  deriveType :: f cat (Maybe a) -> SchemaT ()
deriveType = Proxy a -> f cat (Maybe a) -> SchemaT ()
forall k (cat :: TypeCategory) a (f :: * -> *)
       (kinded :: TypeCategory -> k -> *) (b :: k).
DeriveType cat a =>
f a -> kinded cat b -> SchemaT ()
deriveTypeWith (Proxy a
forall k (t :: k). Proxy t
Proxy @a)

-- List
instance DeriveType cat a => DeriveType cat [a] where
  deriveType :: f cat [a] -> SchemaT ()
deriveType = Proxy a -> f cat [a] -> SchemaT ()
forall k (cat :: TypeCategory) a (f :: * -> *)
       (kinded :: TypeCategory -> k -> *) (b :: k).
DeriveType cat a =>
f a -> kinded cat b -> SchemaT ()
deriveTypeWith (Proxy a
forall k (t :: k). Proxy t
Proxy @a)

-- Tuple
instance DeriveType cat (Pair k v) => DeriveType cat (k, v) where
  deriveType :: f cat (k, v) -> SchemaT ()
deriveType = Proxy (Pair k v) -> f cat (k, v) -> SchemaT ()
forall k (cat :: TypeCategory) a (f :: * -> *)
       (kinded :: TypeCategory -> k -> *) (b :: k).
DeriveType cat a =>
f a -> kinded cat b -> SchemaT ()
deriveTypeWith (Proxy (Pair k v)
forall k (t :: k). Proxy t
Proxy @(Pair k v))

-- Set
instance DeriveType cat [a] => DeriveType cat (Set a) where
  deriveType :: f cat (Set a) -> SchemaT ()
deriveType = Proxy [a] -> f cat (Set a) -> SchemaT ()
forall k (cat :: TypeCategory) a (f :: * -> *)
       (kinded :: TypeCategory -> k -> *) (b :: k).
DeriveType cat a =>
f a -> kinded cat b -> SchemaT ()
deriveTypeWith (Proxy [a]
forall k (t :: k). Proxy t
Proxy @[a])

-- Map
instance DeriveType cat (MapKind k v Maybe) => DeriveType cat (Map k v) where
  deriveType :: f cat (Map k v) -> SchemaT ()
deriveType = Proxy (MapKind k v Maybe) -> f cat (Map k v) -> SchemaT ()
forall k (cat :: TypeCategory) a (f :: * -> *)
       (kinded :: TypeCategory -> k -> *) (b :: k).
DeriveType cat a =>
f a -> kinded cat b -> SchemaT ()
deriveTypeWith (Proxy (MapKind k v Maybe)
forall k (t :: k). Proxy t
Proxy @(MapKind k v Maybe))

-- Resolver : a -> Resolver b
instance
  ( GQLType b,
    DeriveType OUT b,
    DeriveTypeConstraint IN a
  ) =>
  DeriveType OUT (a -> m b)
  where
  deriveContent :: f OUT (a -> m b) -> SchemaT (Maybe (FieldContent TRUE OUT CONST))
deriveContent f OUT (a -> m b)
_ = FieldContent TRUE OUT CONST -> Maybe (FieldContent TRUE OUT CONST)
forall a. a -> Maybe a
Just (FieldContent TRUE OUT CONST
 -> Maybe (FieldContent TRUE OUT CONST))
-> (ArgumentsDefinition CONST -> FieldContent TRUE OUT CONST)
-> ArgumentsDefinition CONST
-> Maybe (FieldContent TRUE OUT CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArgumentsDefinition CONST -> FieldContent TRUE OUT CONST
forall (s :: Stage) (cat :: TypeCategory).
ArgumentsDefinition s -> FieldContent (ELEM OUT cat) cat s
FieldArgs (ArgumentsDefinition CONST -> Maybe (FieldContent TRUE OUT CONST))
-> SchemaT (ArgumentsDefinition CONST)
-> SchemaT (Maybe (FieldContent TRUE OUT CONST))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> SchemaT (ArgumentsDefinition CONST)
forall a (f :: * -> *).
DeriveTypeConstraint IN a =>
f a -> SchemaT (ArgumentsDefinition CONST)
deriveArgumentDefinition (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
  deriveType :: f OUT (a -> m b) -> SchemaT ()
deriveType f OUT (a -> m b)
_ = KindedType OUT b -> SchemaT ()
forall (kind :: TypeCategory) a (f :: TypeCategory -> * -> *).
DeriveType kind a =>
f kind a -> SchemaT ()
deriveType (Proxy b -> KindedType OUT b
forall k (f :: k -> *) (a :: k). f a -> KindedType OUT a
outputType (Proxy b -> KindedType OUT b) -> Proxy b -> KindedType OUT b
forall a b. (a -> b) -> a -> b
$ Proxy b
forall k (t :: k). Proxy t
Proxy @b)

instance (DeriveType OUT a) => DeriveType OUT (SubscriptionField a) where
  deriveType :: f OUT (SubscriptionField a) -> SchemaT ()
deriveType f OUT (SubscriptionField a)
_ = KindedProxy OUT a -> SchemaT ()
forall (kind :: TypeCategory) a (f :: TypeCategory -> * -> *).
DeriveType kind a =>
f kind a -> SchemaT ()
deriveType (KindedProxy OUT a
forall k k (k :: k) (a :: k). KindedProxy k a
KindedProxy :: KindedProxy OUT a)

--  GQL Resolver b, MUTATION, SUBSCRIPTION, QUERY
instance (DeriveType cat b) => DeriveType cat (Resolver fo e m b) where
  deriveType :: f cat (Resolver fo e m b) -> SchemaT ()
deriveType = Proxy b -> f cat (Resolver fo e m b) -> SchemaT ()
forall k (cat :: TypeCategory) a (f :: * -> *)
       (kinded :: TypeCategory -> k -> *) (b :: k).
DeriveType cat a =>
f a -> kinded cat b -> SchemaT ()
deriveTypeWith (Proxy b
forall k (t :: k). Proxy t
Proxy @b)

-- | DeriveType With specific Kind: 'kind': object, scalar, enum ...
class DeriveKindedType (kind :: GQL_KIND) a where
  deriveKindedType :: proxy kind a -> SchemaT ()

-- SCALAR
instance (GQLType a, GQLScalar a) => DeriveKindedType SCALAR a where
  deriveKindedType :: proxy SCALAR a -> SchemaT ()
deriveKindedType = (proxy SCALAR a -> SchemaT (TypeContent TRUE LEAF CONST))
-> proxy SCALAR a -> SchemaT ()
forall k a (f :: k -> * -> *) (kind :: k) (cat :: TypeCategory).
GQLType a =>
(f kind a -> SchemaT (TypeContent TRUE cat CONST))
-> f kind a -> SchemaT ()
updateByContent proxy SCALAR a -> SchemaT (TypeContent TRUE LEAF CONST)
forall a (f :: * -> *).
GQLScalar a =>
f a -> SchemaT (TypeContent TRUE LEAF CONST)
deriveScalarContent

-- ENUM
instance DeriveTypeConstraint IN a => DeriveKindedType ENUM a where
  deriveKindedType :: proxy ENUM a -> SchemaT ()
deriveKindedType = proxy ENUM a -> SchemaT ()
forall a (f :: * -> *).
DeriveTypeConstraint IN a =>
f a -> SchemaT ()
deriveInputType

instance DeriveTypeConstraint IN a => DeriveKindedType INPUT a where
  deriveKindedType :: proxy INPUT a -> SchemaT ()
deriveKindedType = proxy INPUT a -> SchemaT ()
forall a (f :: * -> *).
DeriveTypeConstraint IN a =>
f a -> SchemaT ()
deriveInputType

instance DeriveTypeConstraint OUT a => DeriveKindedType OUTPUT a where
  deriveKindedType :: proxy OUTPUT a -> SchemaT ()
deriveKindedType = proxy OUTPUT a -> SchemaT ()
forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT ()
deriveOutputType

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

instance DeriveTypeConstraint OUT a => DeriveKindedType INTERFACE a where
  deriveKindedType :: proxy INTERFACE a -> SchemaT ()
deriveKindedType = (proxy INTERFACE a -> SchemaT (TypeContent TRUE OUT CONST))
-> proxy INTERFACE a -> SchemaT ()
forall k a (f :: k -> * -> *) (kind :: k) (cat :: TypeCategory).
GQLType a =>
(f kind a -> SchemaT (TypeContent TRUE cat CONST))
-> f kind a -> SchemaT ()
updateByContent proxy INTERFACE a -> SchemaT (TypeContent TRUE OUT CONST)
forall a (f :: * -> *).
DeriveTypeConstraint OUT a =>
f a -> SchemaT (TypeContent TRUE OUT CONST)
deriveInterfaceContent

deriveScalarContent :: (GQLScalar a) => f a -> SchemaT (TypeContent TRUE LEAF CONST)
deriveScalarContent :: f a -> SchemaT (TypeContent TRUE LEAF CONST)
deriveScalarContent = TypeContent TRUE LEAF CONST
-> SchemaT (TypeContent TRUE LEAF CONST)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeContent TRUE LEAF CONST
 -> SchemaT (TypeContent TRUE LEAF CONST))
-> (f a -> TypeContent TRUE LEAF CONST)
-> f a
-> SchemaT (TypeContent TRUE LEAF CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarDefinition -> TypeContent TRUE LEAF CONST
forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> TypeContent (ELEM LEAF a) a s
DataScalar (ScalarDefinition -> TypeContent TRUE LEAF CONST)
-> (f a -> ScalarDefinition) -> f a -> TypeContent TRUE LEAF CONST
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> ScalarDefinition
forall a (f :: * -> *). GQLScalar a => f a -> ScalarDefinition
scalarValidator

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

deriveArgumentDefinition :: DeriveTypeConstraint IN a => f a -> SchemaT (ArgumentsDefinition CONST)
deriveArgumentDefinition :: f a -> SchemaT (ArgumentsDefinition CONST)
deriveArgumentDefinition = (FieldsDefinition IN CONST -> ArgumentsDefinition CONST)
-> SchemaT (FieldsDefinition IN CONST)
-> SchemaT (ArgumentsDefinition CONST)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldsDefinition IN CONST -> ArgumentsDefinition CONST
forall (s :: Stage). FieldsDefinition IN s -> ArgumentsDefinition s
fieldsToArguments (SchemaT (FieldsDefinition IN CONST)
 -> SchemaT (ArgumentsDefinition CONST))
-> (f a -> SchemaT (FieldsDefinition IN CONST))
-> f a
-> SchemaT (ArgumentsDefinition CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedType IN a -> SchemaT (FieldsDefinition IN CONST)
forall (kind :: TypeCategory) a.
DeriveTypeConstraint kind a =>
KindedType kind a -> SchemaT (FieldsDefinition kind CONST)
deriveFields (KindedType IN a -> SchemaT (FieldsDefinition IN CONST))
-> (f a -> KindedType IN a)
-> f a
-> SchemaT (FieldsDefinition IN CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> KindedType IN a
forall k (f :: k -> *) (a :: k). f a -> KindedType IN a
inputType

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

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

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

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

deriveImplementsInterface :: (GQLType a, DeriveType OUT a) => f a -> SchemaT TypeName
deriveImplementsInterface :: f a -> SchemaT TypeName
deriveImplementsInterface f a
x = KindedType OUT a -> SchemaT ()
forall (kind :: TypeCategory) a (f :: TypeCategory -> * -> *).
DeriveType kind a =>
f kind a -> SchemaT ()
deriveType (f a -> KindedType OUT a
forall k (f :: k -> *) (a :: k). f a -> KindedType OUT a
outputType f a
x) SchemaT () -> TypeName -> SchemaT TypeName
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeData -> TypeName
gqlTypeName (f a -> TypeData
forall a (f :: * -> *). GQLType a => f a -> TypeData
__type f a
x)

fieldContentConstraint :: f kind a -> TypeConstraint (DeriveType kind) (TyContentM kind) Proxy
fieldContentConstraint :: f kind a
-> TypeConstraint (DeriveType kind) (TyContentM kind) Proxy
fieldContentConstraint f kind a
_ = (forall a. DeriveType kind a => Proxy a -> TyContentM kind)
-> TypeConstraint (DeriveType kind) (TyContentM kind) Proxy
forall (c :: * -> Constraint) v (f :: * -> *).
(forall a. c a => f a -> v) -> TypeConstraint c v f
TypeConstraint forall a. DeriveType kind a => Proxy a -> TyContentM kind
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 :: f a -> TyContentM kind
deriveFieldContent f a
_ = KindedProxy kind a -> SchemaT ()
forall (kind :: TypeCategory) a (f :: TypeCategory -> * -> *).
DeriveType kind a =>
f kind a -> SchemaT ()
deriveType KindedProxy kind a
kinded SchemaT () -> TyContentM kind -> TyContentM kind
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> KindedProxy kind a -> TyContentM kind
forall (kind :: TypeCategory) a (f :: TypeCategory -> * -> *).
DeriveType kind a =>
f kind a -> SchemaT (Maybe (FieldContent TRUE kind CONST))
deriveContent KindedProxy kind a
kinded
  where
    kinded :: KindedProxy kind a
    kinded :: KindedProxy kind a
kinded = KindedProxy kind a
forall k k (k :: k) (a :: k). KindedProxy k a
KindedProxy

deriveTypeContent ::
  DeriveTypeConstraint kind a =>
  KindedType kind a ->
  SchemaT (TypeContent TRUE kind CONST)
deriveTypeContent :: KindedType kind a -> SchemaT (TypeContent TRUE kind CONST)
deriveTypeContent KindedType kind a
kinded =
  [ConsRep (TyContentM kind)] -> SchemaT [ConsRep (TyContent kind)]
forall (k :: TypeCategory).
[ConsRep (TyContentM k)] -> SchemaT [ConsRep (TyContent k)]
unpackMs (TypeConstraint (DeriveType kind) (TyContentM kind) Proxy
-> KindedType kind a -> [ConsRep (TyContentM kind)]
forall (f :: * -> *) (constraint :: * -> Constraint) value a.
(GQLType a, TypeRep constraint value (Rep a)) =>
TypeConstraint constraint value Proxy -> f a -> [ConsRep value]
genericTo (KindedType kind a
-> TypeConstraint (DeriveType kind) (TyContentM kind) Proxy
forall k (f :: TypeCategory -> k -> *) (kind :: TypeCategory)
       (a :: k).
f kind a
-> TypeConstraint (DeriveType kind) (TyContentM kind) Proxy
fieldContentConstraint KindedType kind a
kinded) KindedType kind a
kinded)
    SchemaT [ConsRep (TyContent kind)]
-> ([ConsRep (TyContent kind)]
    -> SchemaT (TypeContent TRUE kind CONST))
-> SchemaT (TypeContent TRUE kind CONST)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TypeContent TRUE kind CONST -> TypeContent TRUE kind CONST)
-> SchemaT (TypeContent TRUE kind CONST)
-> SchemaT (TypeContent TRUE kind CONST)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (KindedType kind a
-> TypeContent TRUE kind CONST -> TypeContent TRUE kind CONST
forall value a (f :: * -> *).
(UpdateDef value, GQLType a) =>
f a -> value -> value
updateDef KindedType kind a
kinded) (SchemaT (TypeContent TRUE kind CONST)
 -> SchemaT (TypeContent TRUE kind CONST))
-> ([ConsRep (TyContent kind)]
    -> SchemaT (TypeContent TRUE kind CONST))
-> [ConsRep (TyContent kind)]
-> SchemaT (TypeContent TRUE kind CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedType kind a
-> [ConsRep (TyContent kind)]
-> SchemaT (TypeContent TRUE kind CONST)
forall a (kind :: TypeCategory).
GQLType a =>
KindedType kind a
-> [ConsRep (TyContent kind)]
-> SchemaT (TypeContent TRUE kind CONST)
builder KindedType kind a
kinded