{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Server.Types.GQLType
( DeriveDirective,
GQLType (KIND, directives, __type),
InputTypeNamespace (..),
deriveFingerprint,
deriveTypename,
encodeArguments,
__isEmptyType,
__typeData,
withGQL,
withDir,
withDeriveType,
DeriveType,
)
where
import Control.Monad.Except (MonadError (throwError))
import Data.Morpheus.App.Internal.Resolving
( Resolver,
SubscriptionField,
)
import Data.Morpheus.Internal.Ext
import Data.Morpheus.Internal.Utils
import Data.Morpheus.Server.Deriving.Schema.DeriveKinded
import Data.Morpheus.Server.Deriving.Schema.Directive (UseDirective (..))
import Data.Morpheus.Server.Deriving.Schema.Internal
import Data.Morpheus.Server.Deriving.Utils (ConsRep (..), DataType (..), DeriveWith, FieldRep (..))
import Data.Morpheus.Server.Deriving.Utils.DeriveGType (DeriveValueOptions (..), deriveValue)
import Data.Morpheus.Server.Deriving.Utils.Kinded (KindedProxy (KindedProxy), inputType)
import Data.Morpheus.Server.Deriving.Utils.Proxy (ContextValue (..))
import Data.Morpheus.Server.Deriving.Utils.Use (UseArguments (..), UseDeriveType (..), UseGQLType (..))
import Data.Morpheus.Server.NamedResolvers (NamedResolverT (..))
import Data.Morpheus.Server.Types.Directives
( GDirectiveUsages (..),
GQLDirective (..),
applyTypeName,
typeDirective,
)
import Data.Morpheus.Server.Types.Internal
( TypeData (..),
mkTypeData,
)
import Data.Morpheus.Server.Types.Kind
( CUSTOM,
DerivingKind,
SCALAR,
TYPE,
WRAPPER,
)
import Data.Morpheus.Server.Types.SchemaT (SchemaT, withInput)
import Data.Morpheus.Server.Types.TypeName (TypeFingerprint (..), getFingerprint, getTypename)
import Data.Morpheus.Server.Types.Types
( Arg,
Pair,
TypeGuard,
Undefined (..),
__typenameUndefined,
)
import Data.Morpheus.Server.Types.Visitors (VisitType (..))
import Data.Morpheus.Types.GQLScalar (EncodeScalar (..))
import Data.Morpheus.Types.GQLWrapper (EncodeWrapperValue (..))
import Data.Morpheus.Types.ID (ID)
import Data.Morpheus.Types.Internal.AST
( Argument (..),
Arguments,
ArgumentsDefinition,
CONST,
DirectiveLocation (..),
GQLError,
IN,
OUT,
ObjectEntry (..),
Position (..),
TypeCategory (..),
TypeName,
TypeWrapper (..),
Value (..),
internal,
mkBaseType,
toNullable,
unitTypeName,
)
import Data.Sequence (Seq)
import Data.Vector (Vector)
import GHC.Generics
import GHC.TypeLits (KnownSymbol)
import Relude hiding (Seq, Undefined, fromList, intercalate)
__isEmptyType :: forall f a. GQLType a => f a -> Bool
__isEmptyType :: forall (f :: * -> *) a. GQLType a => f a -> Bool
__isEmptyType f a
_ = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeFingerprint
deriveFingerprint (forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT a) forall a. Eq a => a -> a -> Bool
== TypeName -> TypeFingerprint
InternalFingerprint TypeName
__typenameUndefined
__typeData :: (GQLType a) => CatType cat a -> TypeData
__typeData :: forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__typeData proxy :: CatType cat a
proxy@CatType cat a
InputType = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type CatType cat a
proxy TypeCategory
IN
__typeData proxy :: CatType cat a
proxy@CatType cat a
OutputType = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type CatType cat a
proxy TypeCategory
OUT
deriveTypename :: (GQLType a) => CatType cat a -> TypeName
deriveTypename :: forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeName
deriveTypename CatType cat a
proxy = TypeData -> TypeName
gqlTypeName forall a b. (a -> b) -> a -> b
$ forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__typeData CatType cat a
proxy
deriveFingerprint :: (GQLType a) => CatType cat a -> TypeFingerprint
deriveFingerprint :: forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeFingerprint
deriveFingerprint CatType cat a
proxy = TypeData -> TypeFingerprint
gqlFingerprint forall a b. (a -> b) -> a -> b
$ forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__typeData CatType cat a
proxy
deriveTypeData ::
Typeable a =>
f a ->
DirectiveUsages ->
TypeCategory ->
TypeData
deriveTypeData :: forall a (f :: * -> *).
Typeable a =>
f a -> DirectiveUsages -> TypeCategory -> TypeData
deriveTypeData f a
proxy GDirectiveUsages {[GDirectiveUsage GQLType DeriveDirective]
typeDirectives :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsages gql args -> [GDirectiveUsage gql args]
typeDirectives :: [GDirectiveUsage GQLType DeriveDirective]
typeDirectives} TypeCategory
cat =
TypeData
{ gqlTypeName :: TypeName
gqlTypeName = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Bool -> TypeName -> TypeName
`applyTypeName` (TypeCategory
cat forall a. Eq a => a -> a -> Bool
== TypeCategory
IN)) (forall a (f :: * -> *). Typeable a => f a -> TypeName
getTypename f a
proxy) [GDirectiveUsage GQLType DeriveDirective]
typeDirectives,
gqlWrappers :: TypeWrapper
gqlWrappers = TypeWrapper
mkBaseType,
gqlFingerprint :: TypeFingerprint
gqlFingerprint = forall a (f :: * -> *).
Typeable a =>
TypeCategory -> f a -> TypeFingerprint
getFingerprint TypeCategory
cat f a
proxy
}
list :: TypeWrapper -> TypeWrapper
list :: TypeWrapper -> TypeWrapper
list = forall a b c. (a -> b -> c) -> b -> a -> c
flip TypeWrapper -> Bool -> TypeWrapper
TypeList Bool
True
wrapper :: (TypeWrapper -> TypeWrapper) -> TypeData -> TypeData
wrapper :: (TypeWrapper -> TypeWrapper) -> TypeData -> TypeData
wrapper TypeWrapper -> TypeWrapper
f TypeData {TypeWrapper
TypeName
TypeFingerprint
gqlFingerprint :: TypeFingerprint
gqlWrappers :: TypeWrapper
gqlTypeName :: TypeName
gqlWrappers :: TypeData -> TypeWrapper
gqlFingerprint :: TypeData -> TypeFingerprint
gqlTypeName :: TypeData -> TypeName
..} = TypeData {gqlWrappers :: TypeWrapper
gqlWrappers = TypeWrapper -> TypeWrapper
f TypeWrapper
gqlWrappers, TypeName
TypeFingerprint
gqlFingerprint :: TypeFingerprint
gqlTypeName :: TypeName
gqlFingerprint :: TypeFingerprint
gqlTypeName :: TypeName
..}
class GQLType a where
type KIND a :: DerivingKind
type KIND a = TYPE
directives :: f a -> DirectiveUsages
directives f a
_ = forall a. Monoid a => a
mempty
__type :: f a -> TypeCategory -> TypeData
default __type :: Typeable a => f a -> TypeCategory -> TypeData
__type f a
proxy = forall a (f :: * -> *).
Typeable a =>
f a -> DirectiveUsages -> TypeCategory -> TypeData
deriveTypeData f a
proxy (forall a (f :: * -> *). GQLType a => f a -> DirectiveUsages
directives f a
proxy)
instance GQLType Int where
type KIND Int = SCALAR
__type :: forall (f :: * -> *). f Int -> TypeCategory -> TypeData
__type f Int
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"Int"
instance GQLType Double where
type KIND Double = SCALAR
__type :: forall (f :: * -> *). f Double -> TypeCategory -> TypeData
__type f Double
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"Float"
instance GQLType Float where
type KIND Float = SCALAR
__type :: forall (f :: * -> *). f Float -> TypeCategory -> TypeData
__type f Float
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"Float32"
instance GQLType Text where
type KIND Text = SCALAR
__type :: forall (f :: * -> *). f Text -> TypeCategory -> TypeData
__type f Text
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"String"
instance GQLType Bool where
type KIND Bool = SCALAR
__type :: forall (f :: * -> *). f Bool -> TypeCategory -> TypeData
__type f Bool
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"Boolean"
instance GQLType ID where
type KIND ID = SCALAR
__type :: forall (f :: * -> *). f ID -> TypeCategory -> TypeData
__type f ID
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"ID"
instance GQLType (Value CONST) where
type KIND (Value CONST) = CUSTOM
__type :: forall (f :: * -> *). f (Value CONST) -> TypeCategory -> TypeData
__type f (Value CONST)
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"INTERNAL_VALUE"
instance GQLType () where
__type :: forall (f :: * -> *). f () -> TypeCategory -> TypeData
__type f ()
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
unitTypeName
instance Typeable m => GQLType (Undefined m) where
type KIND (Undefined m) = CUSTOM
__type :: forall (f :: * -> *). f (Undefined m) -> TypeCategory -> TypeData
__type f (Undefined m)
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
__typenameUndefined
instance GQLType a => GQLType (Maybe a) where
type KIND (Maybe a) = WRAPPER
__type :: forall (f :: * -> *). f (Maybe a) -> TypeCategory -> TypeData
__type f (Maybe a)
_ = (TypeWrapper -> TypeWrapper) -> TypeData -> TypeData
wrapper forall a. Nullable a => a -> a
toNullable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type (forall {k} (t :: k). Proxy t
Proxy @a)
instance GQLType a => GQLType [a] where
type KIND [a] = WRAPPER
__type :: forall (f :: * -> *). f [a] -> TypeCategory -> TypeData
__type f [a]
_ = (TypeWrapper -> TypeWrapper) -> TypeData -> TypeData
wrapper TypeWrapper -> TypeWrapper
list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type (forall {k} (t :: k). Proxy t
Proxy @a)
instance GQLType a => GQLType (Set a) where
type KIND (Set a) = WRAPPER
__type :: forall (f :: * -> *). f (Set a) -> TypeCategory -> TypeData
__type f (Set a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @[a]
instance GQLType a => GQLType (NonEmpty a) where
type KIND (NonEmpty a) = WRAPPER
__type :: forall (f :: * -> *). f (NonEmpty a) -> TypeCategory -> TypeData
__type f (NonEmpty a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @[a]
instance GQLType a => GQLType (Seq a) where
type KIND (Seq a) = WRAPPER
__type :: forall (f :: * -> *). f (Seq a) -> TypeCategory -> TypeData
__type f (Seq a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @[a]
instance GQLType a => GQLType (Vector a) where
type KIND (Vector a) = WRAPPER
__type :: forall (f :: * -> *). f (Vector a) -> TypeCategory -> TypeData
__type f (Vector a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @[a]
instance GQLType a => GQLType (SubscriptionField a) where
type KIND (SubscriptionField a) = WRAPPER
__type :: forall (f :: * -> *).
f (SubscriptionField a) -> TypeCategory -> TypeData
__type f (SubscriptionField a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @a
instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (Pair a b) where
directives :: forall (f :: * -> *). f (Pair a b) -> DirectiveUsages
directives f (Pair a b)
_ = forall a (gql :: * -> Constraint) (args :: * -> Constraint).
(GQLDirective a, gql a, args a) =>
a -> GDirectiveUsages gql args
typeDirective InputTypeNamespace {inputTypeNamespace :: Text
inputTypeNamespace = Text
"Input"}
instance GQLType b => GQLType (a -> b) where
type KIND (a -> b) = CUSTOM
__type :: forall (f :: * -> *). f (a -> b) -> TypeCategory -> TypeData
__type f (a -> b)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @b
instance (GQLType k, GQLType v, Typeable k, Typeable v) => GQLType (Map k v) where
type KIND (Map k v) = CUSTOM
__type :: forall (f :: * -> *). f (Map k v) -> TypeCategory -> TypeData
__type f (Map k v)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @[Pair k v]
instance GQLType a => GQLType (Resolver o e m a) where
type KIND (Resolver o e m a) = CUSTOM
__type :: forall (f :: * -> *).
f (Resolver o e m a) -> TypeCategory -> TypeData
__type f (Resolver o e m a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @a
instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (a, b) where
__type :: forall (f :: * -> *). f (a, b) -> TypeCategory -> TypeData
__type f (a, b)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @(Pair a b)
directives :: forall (f :: * -> *). f (a, b) -> DirectiveUsages
directives f (a, b)
_ = forall a (gql :: * -> Constraint) (args :: * -> Constraint).
(GQLDirective a, gql a, args a) =>
a -> GDirectiveUsages gql args
typeDirective InputTypeNamespace {inputTypeNamespace :: Text
inputTypeNamespace = Text
"Input"}
instance (GQLType value) => GQLType (Arg name value) where
type KIND (Arg name value) = CUSTOM
__type :: forall (f :: * -> *).
f (Arg name value) -> TypeCategory -> TypeData
__type f (Arg name value)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type (forall {k} (t :: k). Proxy t
Proxy @value)
instance (GQLType interface) => GQLType (TypeGuard interface possibleTypes) where
type KIND (TypeGuard interface possibleTypes) = CUSTOM
__type :: forall (f :: * -> *).
f (TypeGuard interface possibleTypes) -> TypeCategory -> TypeData
__type f (TypeGuard interface possibleTypes)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type (forall {k} (t :: k). Proxy t
Proxy @interface)
instance (GQLType a) => GQLType (Proxy a) where
type KIND (Proxy a) = KIND a
__type :: forall (f :: * -> *). f (Proxy a) -> TypeCategory -> TypeData
__type f (Proxy a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type (forall {k} (t :: k). Proxy t
Proxy @a)
instance (GQLType a) => GQLType (NamedResolverT m a) where
type KIND (NamedResolverT m a) = CUSTOM
__type :: forall (f :: * -> *).
f (NamedResolverT m a) -> TypeCategory -> TypeData
__type f (NamedResolverT m a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
type EncodeValue a = EncodeKind (KIND a) a
encodeArguments :: forall m a. (MonadError GQLError m, EncodeValue a) => a -> m (Arguments CONST)
encodeArguments :: forall (m :: * -> *) a.
(MonadError GQLError m, EncodeValue a) =>
a -> m (Arguments CONST)
encodeArguments a
x = forall err a' a.
(NonEmpty err -> a') -> (a -> a') -> Result err a -> a'
resultOr (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
err) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. EncodeValue a => a -> GQLResult (Value CONST)
encode a
x) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {f :: * -> *} {valid :: Stage}.
MonadError GQLError f =>
Value valid -> f (OrdMap FieldName (Argument valid))
unpackValue
where
err :: GQLError
err = GQLError -> GQLError
internal GQLError
"could not encode arguments. Arguments should be an object like type!"
unpackValue :: Value valid -> f (OrdMap FieldName (Argument valid))
unpackValue (Object Object valid
v) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {valid :: Stage}. ObjectEntry valid -> Argument valid
toArgument Object valid
v
unpackValue Value valid
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
err
toArgument :: ObjectEntry valid -> Argument valid
toArgument ObjectEntry {Value valid
FieldName
entryName :: forall (s :: Stage). ObjectEntry s -> FieldName
entryValue :: forall (s :: Stage). ObjectEntry s -> Value s
entryValue :: Value valid
entryName :: FieldName
..} = forall (valid :: Stage).
Position -> FieldName -> Value valid -> Argument valid
Argument (Int -> Int -> Position
Position Int
0 Int
0) FieldName
entryName Value valid
entryValue
encode :: forall a. EncodeValue a => a -> GQLResult (Value CONST)
encode :: forall a. EncodeValue a => a -> GQLResult (Value CONST)
encode a
x = forall (kind :: DerivingKind) a.
EncodeKind kind a =>
ContextValue kind a -> GQLResult (Value CONST)
encodeKind (forall (kind :: DerivingKind) a. a -> ContextValue kind a
ContextValue a
x :: ContextValue (KIND a) a)
class EncodeKind (kind :: DerivingKind) (a :: Type) where
encodeKind :: ContextValue kind a -> GQLResult (Value CONST)
instance (EncodeWrapperValue f, EncodeValue a) => EncodeKind WRAPPER (f a) where
encodeKind :: ContextValue WRAPPER (f a) -> GQLResult (Value CONST)
encodeKind = forall (f :: * -> *) (m :: * -> *) a.
(EncodeWrapperValue f, Monad m) =>
(a -> m (Value CONST)) -> f a -> m (Value CONST)
encodeWrapperValue forall a. EncodeValue a => a -> GQLResult (Value CONST)
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue
instance (EncodeScalar a) => EncodeKind SCALAR a where
encodeKind :: ContextValue SCALAR a -> GQLResult (Value CONST)
encodeKind = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (stage :: Stage). ScalarValue -> Value stage
Scalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncodeScalar a => a -> ScalarValue
encodeScalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue
instance (EncodeConstraint a) => EncodeKind TYPE a where
encodeKind :: ContextValue TYPE a -> GQLResult (Value CONST)
encodeKind = forall a. EncodeConstraint a => a -> GQLResult (Value CONST)
exploreResolvers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue
instance EncodeKind CUSTOM (Value CONST) where
encodeKind :: ContextValue CUSTOM (Value CONST) -> GQLResult (Value CONST)
encodeKind = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue
instance (KnownSymbol name) => EncodeKind CUSTOM (Arg name a) where
encodeKind :: ContextValue CUSTOM (Arg name a) -> GQLResult (Value CONST)
encodeKind ContextValue CUSTOM (Arg name a)
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"directives cant be tagged arguments"
convertNode ::
DataType (GQLResult (Value CONST)) ->
GQLResult (Value CONST)
convertNode :: DataType (GQLResult (Value CONST)) -> GQLResult (Value CONST)
convertNode
DataType
{ Bool
tyIsUnion :: forall v. DataType v -> Bool
tyIsUnion :: Bool
tyIsUnion,
tyCons :: forall v. DataType v -> ConsRep v
tyCons = ConsRep {[FieldRep (GQLResult (Value CONST))]
consFields :: forall v. ConsRep v -> [FieldRep v]
consFields :: [FieldRep (GQLResult (Value CONST))]
consFields, TypeName
consName :: forall v. ConsRep v -> TypeName
consName :: TypeName
consName}
} = [FieldRep (GQLResult (Value CONST))] -> GQLResult (Value CONST)
encodeTypeFields [FieldRep (GQLResult (Value CONST))]
consFields
where
encodeTypeFields ::
[FieldRep (GQLResult (Value CONST))] -> GQLResult (Value CONST)
encodeTypeFields :: [FieldRep (GQLResult (Value CONST))] -> GQLResult (Value CONST)
encodeTypeFields [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (stage :: Stage). TypeName -> Value stage
Enum TypeName
consName
encodeTypeFields [FieldRep (GQLResult (Value CONST))]
fields | Bool -> Bool
not Bool
tyIsUnion = forall (stage :: Stage). Object stage -> Value stage
Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *} {s :: Stage}.
Monad m =>
FieldRep (m (Value s)) -> m (ObjectEntry s)
fromField [FieldRep (GQLResult (Value CONST))]
fields forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems)
where
fromField :: FieldRep (m (Value s)) -> m (ObjectEntry s)
fromField FieldRep {FieldName
fieldSelector :: forall a. FieldRep a -> FieldName
fieldSelector :: FieldName
fieldSelector, m (Value s)
fieldValue :: forall a. FieldRep a -> a
fieldValue :: m (Value s)
fieldValue} = do
Value s
entryValue <- m (Value s)
fieldValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure ObjectEntry {entryName :: FieldName
entryName = FieldName
fieldSelector, Value s
entryValue :: Value s
entryValue :: Value s
entryValue}
encodeTypeFields [FieldRep (GQLResult (Value CONST))]
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal GQLError
"input unions are not supported")
class (EncodeKind (KIND a) a) => ExplorerConstraint a
instance (EncodeKind (KIND a) a) => ExplorerConstraint a
exploreResolvers :: forall a. EncodeConstraint a => a -> GQLResult (Value CONST)
exploreResolvers :: forall a. EncodeConstraint a => a -> GQLResult (Value CONST)
exploreResolvers =
DataType (GQLResult (Value CONST)) -> GQLResult (Value CONST)
convertNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (gql :: * -> Constraint)
(constraint :: * -> Constraint) value (kind :: k).
(Generic a, DeriveWith gql constraint value (Rep a)) =>
DeriveValueOptions kind gql constraint value -> a -> DataType value
deriveValue
( DeriveValueOptions
{ __valueApply :: forall a. ExplorerConstraint a => a -> GQLResult (Value CONST)
__valueApply = forall a. EncodeValue a => a -> GQLResult (Value CONST)
encode,
__valueTypeName :: TypeName
__valueTypeName = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeName
deriveTypename (forall {k} (a :: k). CatType 'IN a
InputType :: CatType IN a),
__valueGetType :: forall (f :: * -> *) a. GQLType a => f a -> TypeData
__valueGetType = forall a (cat :: TypeCategory).
GQLType a =>
CatType cat a -> TypeData
__typeData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> CatType 'IN a
inputType
} ::
DeriveValueOptions IN GQLType ExplorerConstraint (GQLResult (Value CONST))
)
type EncodeConstraint a =
( Generic a,
GQLType a,
DeriveWith GQLType ExplorerConstraint (GQLResult (Value CONST)) (Rep a)
)
type DeriveArguments a = DeriveArgs GQLType DeriveType (KIND a) a
type DirectiveUsages = GDirectiveUsages GQLType DeriveDirective
deriveArguments :: DeriveArgs GQLType DeriveType k a => f k a -> SchemaT OUT (ArgumentsDefinition CONST)
deriveArguments :: forall (k :: DerivingKind) a (f :: DerivingKind -> * -> *).
DeriveArgs GQLType DeriveType k a =>
f k a -> SchemaT OUT (ArgumentsDefinition CONST)
deriveArguments = forall a. SchemaT 'IN a -> SchemaT OUT a
withInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (gql :: * -> Constraint)
(derive :: TypeCategory -> * -> Constraint) (k :: DerivingKind)
(a :: k) (dir :: * -> Constraint) (f :: DerivingKind -> k -> *).
DeriveArgs gql derive k a =>
UseDirective gql dir
-> UseDeriveType derive
-> f k a
-> SchemaT 'IN (ArgumentsDefinition CONST)
deriveArgs UseDirective GQLType DeriveDirective
withDir UseDeriveType DeriveType
withDeriveType
class (EncodeValue a, DeriveArguments a) => DeriveDirective a
instance (EncodeValue a, DeriveArguments a) => DeriveDirective a
newtype InputTypeNamespace = InputTypeNamespace {InputTypeNamespace -> Text
inputTypeNamespace :: Text}
deriving (forall x. Rep InputTypeNamespace x -> InputTypeNamespace
forall x. InputTypeNamespace -> Rep InputTypeNamespace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InputTypeNamespace x -> InputTypeNamespace
$cfrom :: forall x. InputTypeNamespace -> Rep InputTypeNamespace x
Generic)
deriving anyclass
(forall a.
(forall (f :: * -> *). f a -> DirectiveUsages)
-> (forall (f :: * -> *). f a -> TypeCategory -> TypeData)
-> GQLType a
forall (f :: * -> *). f InputTypeNamespace -> DirectiveUsages
forall (f :: * -> *).
f InputTypeNamespace -> TypeCategory -> TypeData
__type :: forall (f :: * -> *).
f InputTypeNamespace -> TypeCategory -> TypeData
$c__type :: forall (f :: * -> *).
f InputTypeNamespace -> TypeCategory -> TypeData
directives :: forall (f :: * -> *). f InputTypeNamespace -> DirectiveUsages
$cdirectives :: forall (f :: * -> *). f InputTypeNamespace -> DirectiveUsages
GQLType)
instance GQLDirective InputTypeNamespace where
excludeFromSchema :: forall (f :: * -> *). f InputTypeNamespace -> Bool
excludeFromSchema f InputTypeNamespace
_ = Bool
True
type
DIRECTIVE_LOCATIONS InputTypeNamespace =
'[ 'LOCATION_OBJECT,
'LOCATION_ENUM,
'LOCATION_INPUT_OBJECT,
'LOCATION_UNION,
'LOCATION_SCALAR,
'LOCATION_INTERFACE
]
instance VisitType InputTypeNamespace where
visitTypeName :: InputTypeNamespace -> Bool -> Text -> Text
visitTypeName InputTypeNamespace {Text
inputTypeNamespace :: Text
inputTypeNamespace :: InputTypeNamespace -> Text
inputTypeNamespace} Bool
isInput Text
name
| Bool
isInput = Text
inputTypeNamespace forall a. Semigroup a => a -> a -> a
<> Text
name
| Bool
otherwise = Text
name
withArgs :: UseArguments DeriveDirective
withArgs :: UseArguments DeriveDirective
withArgs =
UseArguments
{ useDeriveArguments :: forall (f :: * -> *) a.
DeriveDirective a =>
f a -> SchemaT OUT (ArgumentsDefinition CONST)
useDeriveArguments = forall (k :: DerivingKind) a (f :: DerivingKind -> * -> *).
DeriveArgs GQLType DeriveType k a =>
f k a -> SchemaT OUT (ArgumentsDefinition CONST)
deriveArguments forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. f a -> KindedProxy (KIND a) a
withKind,
useEncodeArguments :: forall (k :: TypeCategory) a.
DeriveDirective a =>
a -> SchemaT k (Arguments CONST)
useEncodeArguments = forall (m :: * -> *) a.
(MonadError GQLError m, EncodeValue a) =>
a -> m (Arguments CONST)
encodeArguments
}
withGQL :: UseGQLType GQLType
withGQL :: UseGQLType GQLType
withGQL =
UseGQLType
{ __useFingerprint :: forall (f :: * -> *) a.
GQLType a =>
TypeCategory -> f a -> TypeFingerprint
__useFingerprint = \TypeCategory
c f a
v -> TypeData -> TypeFingerprint
gqlFingerprint (forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type f a
v TypeCategory
c),
__useTypename :: forall (f :: * -> *) a.
GQLType a =>
TypeCategory -> f a -> TypeName
__useTypename = \TypeCategory
c f a
v -> TypeData -> TypeName
gqlTypeName (forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type f a
v TypeCategory
c),
__useTypeData :: forall (f :: * -> *) a.
GQLType a =>
f a -> TypeCategory -> TypeData
__useTypeData = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type
}
withDir :: UseDirective GQLType DeriveDirective
withDir :: UseDirective GQLType DeriveDirective
withDir =
UseDirective
{ __directives :: forall (f :: * -> *) a. GQLType a => f a -> DirectiveUsages
__directives = forall a (f :: * -> *). GQLType a => f a -> DirectiveUsages
directives,
dirGQL :: UseGQLType GQLType
dirGQL = UseGQLType GQLType
withGQL,
dirArgs :: UseArguments DeriveDirective
dirArgs = UseArguments DeriveDirective
withArgs
}
withKind :: f a -> KindedProxy (KIND a) a
withKind :: forall (f :: * -> *) a. f a -> KindedProxy (KIND a) a
withKind f a
_ = forall {k} {k} (k :: k) (a :: k). KindedProxy k a
KindedProxy
withDeriveType :: UseDeriveType DeriveType
withDeriveType :: UseDeriveType DeriveType
withDeriveType =
UseDeriveType
{ useDeriveType :: forall (c :: TypeCategory) a.
DeriveType c a =>
CatType c a -> SchemaT c ()
useDeriveType = forall (c :: TypeCategory) a.
DeriveType c a =>
CatType c a -> SchemaT c ()
deriveType,
useDeriveContent :: forall (c :: TypeCategory) a.
DeriveType c a =>
CatType c a -> TyContentM c
useDeriveContent = forall (c :: TypeCategory) a.
DeriveType c a =>
CatType c a -> TyContentM c
deriveContent
}
class DeriveType (c :: TypeCategory) (a :: Type) where
deriveType :: CatType c a -> SchemaT c ()
deriveContent :: CatType c a -> TyContentM c
instance (GQLType a, DeriveKindedType GQLType DeriveType DeriveDirective cat (KIND a) a) => DeriveType cat a where
deriveType :: CatType cat a -> SchemaT cat ()
deriveType = forall {k} (gql :: * -> Constraint)
(derive :: TypeCategory -> * -> Constraint)
(dir :: * -> Constraint) (cat :: TypeCategory)
(kind :: DerivingKind) (a :: k) {k} (f :: DerivingKind -> k -> k).
DeriveKindedType gql derive dir cat kind a =>
UseDirective gql dir
-> UseDeriveType derive -> CatType cat (f kind a) -> SchemaT cat ()
deriveKindedType UseDirective GQLType DeriveDirective
withDir UseDeriveType DeriveType
withDeriveType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (cat :: TypeCategory) a (f :: DerivingKind -> * -> *).
CatType cat a -> CatType cat (f (KIND a) a)
liftKind
deriveContent :: CatType cat a -> TyContentM cat
deriveContent = forall {k} (gql :: * -> Constraint)
(derive :: TypeCategory -> * -> Constraint)
(dir :: * -> Constraint) (cat :: TypeCategory)
(kind :: DerivingKind) (a :: k) {k} (f :: DerivingKind -> k -> k).
DeriveKindedType gql derive dir cat kind a =>
UseDirective gql dir
-> UseDeriveType derive -> CatType cat (f kind a) -> TyContentM cat
deriveKindedContent UseDirective GQLType DeriveDirective
withDir UseDeriveType DeriveType
withDeriveType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (cat :: TypeCategory) a (f :: DerivingKind -> * -> *).
CatType cat a -> CatType cat (f (KIND a) a)
liftKind
liftKind :: CatType cat a -> CatType cat (f (KIND a) a)
liftKind :: forall (cat :: TypeCategory) a (f :: DerivingKind -> * -> *).
CatType cat a -> CatType cat (f (KIND a) a)
liftKind CatType cat a
InputType = forall {k} (a :: k). CatType 'IN a
InputType
liftKind CatType cat a
OutputType = forall {k} (a :: k). CatType OUT a
OutputType