{-# 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
( GQLType (KIND, directives, __type),
__typeData,
deriveTypename,
deriveFingerprint,
encodeArguments,
DirectiveUsage (..),
DeriveArguments (..),
DirectiveUsages (..),
typeDirective,
fieldDirective,
fieldDirective',
enumDirective,
enumDirective',
applyTypeName,
applyTypeDescription,
applyEnumName,
applyEnumDescription,
applyFieldName,
applyFieldDescription,
applyFieldDefaultValue,
applyTypeFieldNames,
applyTypeEnumNames,
__isEmptyType,
InputTypeNamespace (..),
)
where
import Control.Monad.Except (MonadError (throwError))
import qualified Data.HashMap.Strict as M
import Data.Morpheus.App.Internal.Resolving
( Resolver,
SubscriptionField,
)
import Data.Morpheus.Internal.Ext
import Data.Morpheus.Internal.Utils
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 (CategoryValue (..), KindedProxy (KindedProxy), kinded)
import Data.Morpheus.Server.Deriving.Utils.Proxy (ContextValue (..))
import Data.Morpheus.Server.NamedResolvers (NamedResolverT (..))
import Data.Morpheus.Server.Types.Directives
( GQLDirective (..),
ToLocations (..),
visitEnumDescription',
visitEnumName',
visitEnumNames',
visitFieldDefaultValue',
visitFieldDescription',
visitFieldName',
visitFieldNames',
visitTypeDescription',
visitTypeName',
)
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)
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,
Description,
DirectiveLocation (..),
FieldName,
GQLError,
IN,
OUT,
ObjectEntry (..),
Position (..),
TypeCategory (..),
TypeName,
TypeWrapper (..),
Value (..),
internal,
mkBaseType,
packName,
toNullable,
unitTypeName,
)
import Data.Sequence (Seq)
import Data.Vector (Vector)
import GHC.Generics
import qualified Language.Haskell.TH.Syntax as TH
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 (kind :: TypeCategory) (kinded :: TypeCategory -> * -> *).
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeFingerprint
deriveFingerprint (forall {k} {k} (k :: k) (a :: k). KindedProxy k a
KindedProxy :: KindedProxy OUT a) forall a. Eq a => a -> a -> Bool
== TypeName -> TypeFingerprint
InternalFingerprint TypeName
__typenameUndefined
__typeData ::
forall kinded (kind :: TypeCategory) (a :: Type).
(GQLType a, CategoryValue kind) =>
kinded kind a ->
TypeData
__typeData :: forall (kinded :: TypeCategory -> * -> *) (kind :: TypeCategory) a.
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeData
__typeData kinded kind a
proxy = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type kinded kind a
proxy (forall (c :: TypeCategory) (f :: TypeCategory -> *).
CategoryValue c =>
f c -> TypeCategory
categoryValue (forall {k} (t :: k). Proxy t
Proxy @kind))
deriveTypename :: (GQLType a, CategoryValue kind) => kinded kind a -> TypeName
deriveTypename :: forall a (kind :: TypeCategory) (kinded :: TypeCategory -> * -> *).
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeName
deriveTypename kinded kind a
proxy = TypeData -> TypeName
gqlTypeName forall a b. (a -> b) -> a -> b
$ forall (kinded :: TypeCategory -> * -> *) (kind :: TypeCategory) a.
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeData
__typeData kinded kind a
proxy
deriveFingerprint :: (GQLType a, CategoryValue kind) => kinded kind a -> TypeFingerprint
deriveFingerprint :: forall a (kind :: TypeCategory) (kinded :: TypeCategory -> * -> *).
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeFingerprint
deriveFingerprint kinded kind a
proxy = TypeData -> TypeFingerprint
gqlFingerprint forall a b. (a -> b) -> a -> b
$ forall (kinded :: TypeCategory -> * -> *) (kind :: TypeCategory) a.
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeData
__typeData kinded kind 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 DirectiveUsages {[DirectiveUsage]
typeDirectives :: DirectiveUsages -> [DirectiveUsage]
typeDirectives :: [DirectiveUsage]
typeDirectives} TypeCategory
cat =
TypeData
{ gqlTypeName :: TypeName
gqlTypeName = Bool -> TypeName -> [DirectiveUsage] -> TypeName
typeNameWithDirectives (TypeCategory
cat forall a. Eq a => a -> a -> Bool
== TypeCategory
IN) (forall a (f :: * -> *). Typeable a => f a -> TypeName
getTypename f a
proxy) [DirectiveUsage]
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, DeriveArguments TYPE InputTypeNamespace) => GQLType (Pair a b) where
directives :: forall (f :: * -> *). f (Pair a b) -> DirectiveUsages
directives f (Pair a b)
_ = forall a. TypeDirectiveConstraint a => a -> DirectiveUsages
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, DeriveArguments TYPE InputTypeNamespace) => 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, DeriveArguments TYPE InputTypeNamespace) => 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. TypeDirectiveConstraint a => a -> DirectiveUsages
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 Decode a = EncodeKind (KIND a) a
encodeArguments :: forall m a. (MonadError GQLError m, Decode a) => a -> m (Arguments CONST)
encodeArguments :: forall (m :: * -> *) a.
(MonadError GQLError m, Decode 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. Decode 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!"
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. Decode a => a -> GQLResult (Value CONST)
encode :: forall a. Decode 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, Decode 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. Decode 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
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, GQLType a) => ExplorerConstraint a
instance (EncodeKind (KIND a) a, GQLType 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 (kind :: TypeCategory) a (constraint :: * -> Constraint)
value.
(CategoryValue kind, Generic a,
DeriveWith constraint value (Rep a)) =>
DeriveValueOptions kind constraint value -> a -> DataType value
deriveValue
( DeriveValueOptions
{ __valueApply :: forall a. ExplorerConstraint a => a -> GQLResult (Value CONST)
__valueApply = forall a. Decode a => a -> GQLResult (Value CONST)
encode,
__valueTypeName :: TypeName
__valueTypeName = forall a (kind :: TypeCategory) (kinded :: TypeCategory -> * -> *).
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeName
deriveTypename (forall {k} {k} (k :: k) (a :: k). KindedProxy k a
KindedProxy :: KindedProxy IN a),
__valueGetType :: forall (f :: * -> *) a. ExplorerConstraint a => f a -> TypeData
__valueGetType = forall (kinded :: TypeCategory -> * -> *) (kind :: TypeCategory) a.
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeData
__typeData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (k3 :: k1) (f' :: k2 -> *)
(a :: k2).
f k3 -> f' a -> KindedProxy k3 a
kinded (forall {k} (t :: k). Proxy t
Proxy @IN)
} ::
DeriveValueOptions IN ExplorerConstraint (GQLResult (Value CONST))
)
type EncodeConstraint a =
( Generic a,
GQLType a,
DeriveWith ExplorerConstraint (GQLResult (Value CONST)) (Rep a)
)
class DeriveArguments (k :: DerivingKind) a where
deriveArgumentsDefinition :: f k a -> SchemaT OUT (ArgumentsDefinition CONST)
data DirectiveUsages = DirectiveUsages
{ DirectiveUsages -> [DirectiveUsage]
typeDirectives :: [DirectiveUsage],
DirectiveUsages -> HashMap FieldName [DirectiveUsage]
fieldDirectives :: M.HashMap FieldName [DirectiveUsage],
DirectiveUsages -> HashMap TypeName [DirectiveUsage]
enumValueDirectives :: M.HashMap TypeName [DirectiveUsage]
}
instance Monoid DirectiveUsages where
mempty :: DirectiveUsages
mempty = [DirectiveUsage]
-> HashMap FieldName [DirectiveUsage]
-> HashMap TypeName [DirectiveUsage]
-> DirectiveUsages
DirectiveUsages forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
mergeDirs :: (Eq k, Hashable k, Semigroup v) => HashMap k v -> HashMap k v -> HashMap k v
mergeDirs :: forall k v.
(Eq k, Hashable k, Semigroup v) =>
HashMap k v -> HashMap k v -> HashMap k v
mergeDirs HashMap k v
a HashMap k v
b = forall {k} {v}.
(Hashable k, Semigroup v) =>
HashMap k v -> [(k, v)] -> HashMap k v
update HashMap k v
a (forall k v. HashMap k v -> [(k, v)]
M.toList HashMap k v
b)
where
update :: HashMap k v -> [(k, v)] -> HashMap k v
update HashMap k v
m [] = HashMap k v
m
update HashMap k v
m ((k, v)
x : [(k, v)]
xs) = HashMap k v -> [(k, v)] -> HashMap k v
update (forall k v.
(Eq k, Hashable k, Semigroup v) =>
(k, v) -> HashMap k v -> HashMap k v
upsert (k, v)
x HashMap k v
m) [(k, v)]
xs
upsert :: (Eq k, Hashable k, Semigroup v) => (k, v) -> HashMap k v -> HashMap k v
upsert :: forall k v.
(Eq k, Hashable k, Semigroup v) =>
(k, v) -> HashMap k v -> HashMap k v
upsert (k
k, v
v) = forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
M.alter (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe v
v (v
v forall a. Semigroup a => a -> a -> a
<>)) k
k
instance Semigroup DirectiveUsages where
DirectiveUsages [DirectiveUsage]
td1 HashMap FieldName [DirectiveUsage]
fd1 HashMap TypeName [DirectiveUsage]
ed1 <> :: DirectiveUsages -> DirectiveUsages -> DirectiveUsages
<> DirectiveUsages [DirectiveUsage]
td2 HashMap FieldName [DirectiveUsage]
fd2 HashMap TypeName [DirectiveUsage]
ed2 =
[DirectiveUsage]
-> HashMap FieldName [DirectiveUsage]
-> HashMap TypeName [DirectiveUsage]
-> DirectiveUsages
DirectiveUsages ([DirectiveUsage]
td1 forall a. Semigroup a => a -> a -> a
<> [DirectiveUsage]
td2) (forall k v.
(Eq k, Hashable k, Semigroup v) =>
HashMap k v -> HashMap k v -> HashMap k v
mergeDirs HashMap FieldName [DirectiveUsage]
fd1 HashMap FieldName [DirectiveUsage]
fd2) (forall k v.
(Eq k, Hashable k, Semigroup v) =>
HashMap k v -> HashMap k v -> HashMap k v
mergeDirs HashMap TypeName [DirectiveUsage]
ed1 HashMap TypeName [DirectiveUsage]
ed2)
type TypeDirectiveConstraint a = (GQLDirective a, GQLType a, Decode a, DeriveArguments (KIND a) a, ToLocations (DIRECTIVE_LOCATIONS a))
typeDirective :: TypeDirectiveConstraint a => a -> DirectiveUsages
typeDirective :: forall a. TypeDirectiveConstraint a => a -> DirectiveUsages
typeDirective a
x = [DirectiveUsage]
-> HashMap FieldName [DirectiveUsage]
-> HashMap TypeName [DirectiveUsage]
-> DirectiveUsages
DirectiveUsages [forall a.
(GQLDirective a, GQLType a, Decode a, DeriveArguments (KIND a) a,
ToLocations (DIRECTIVE_LOCATIONS a)) =>
a -> DirectiveUsage
DirectiveUsage a
x] forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
fieldDirective :: TypeDirectiveConstraint a => FieldName -> a -> DirectiveUsages
fieldDirective :: forall a.
TypeDirectiveConstraint a =>
FieldName -> a -> DirectiveUsages
fieldDirective FieldName
name a
x = [DirectiveUsage]
-> HashMap FieldName [DirectiveUsage]
-> HashMap TypeName [DirectiveUsage]
-> DirectiveUsages
DirectiveUsages forall a. Monoid a => a
mempty (forall k v. Hashable k => k -> v -> HashMap k v
M.singleton FieldName
name [forall a.
(GQLDirective a, GQLType a, Decode a, DeriveArguments (KIND a) a,
ToLocations (DIRECTIVE_LOCATIONS a)) =>
a -> DirectiveUsage
DirectiveUsage a
x]) forall a. Monoid a => a
mempty
fieldDirective' :: TypeDirectiveConstraint a => TH.Name -> a -> DirectiveUsages
fieldDirective' :: forall a. TypeDirectiveConstraint a => Name -> a -> DirectiveUsages
fieldDirective' Name
name = forall a.
TypeDirectiveConstraint a =>
FieldName -> a -> DirectiveUsages
fieldDirective (forall a (t :: NAME). NamePacking a => a -> Name t
packName Name
name)
enumDirective :: TypeDirectiveConstraint a => TypeName -> a -> DirectiveUsages
enumDirective :: forall a.
TypeDirectiveConstraint a =>
TypeName -> a -> DirectiveUsages
enumDirective TypeName
name a
x = [DirectiveUsage]
-> HashMap FieldName [DirectiveUsage]
-> HashMap TypeName [DirectiveUsage]
-> DirectiveUsages
DirectiveUsages forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty (forall k v. Hashable k => k -> v -> HashMap k v
M.singleton TypeName
name [forall a.
(GQLDirective a, GQLType a, Decode a, DeriveArguments (KIND a) a,
ToLocations (DIRECTIVE_LOCATIONS a)) =>
a -> DirectiveUsage
DirectiveUsage a
x])
enumDirective' :: TypeDirectiveConstraint a => TH.Name -> a -> DirectiveUsages
enumDirective' :: forall a. TypeDirectiveConstraint a => Name -> a -> DirectiveUsages
enumDirective' Name
name = forall a.
TypeDirectiveConstraint a =>
TypeName -> a -> DirectiveUsages
enumDirective (forall a (t :: NAME). NamePacking a => a -> Name t
packName Name
name)
data DirectiveUsage where
DirectiveUsage :: (GQLDirective a, GQLType a, Decode a, DeriveArguments (KIND a) a, ToLocations (DIRECTIVE_LOCATIONS a)) => a -> DirectiveUsage
applyTypeName :: DirectiveUsage -> Bool -> TypeName -> TypeName
applyTypeName :: DirectiveUsage -> Bool -> TypeName -> TypeName
applyTypeName (DirectiveUsage a
x) = forall a. GQLDirective a => a -> Bool -> TypeName -> TypeName
visitTypeName' a
x
typeNameWithDirectives :: Bool -> TypeName -> [DirectiveUsage] -> TypeName
typeNameWithDirectives :: Bool -> TypeName -> [DirectiveUsage] -> TypeName
typeNameWithDirectives Bool
x = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (DirectiveUsage -> Bool -> TypeName -> TypeName
`applyTypeName` Bool
x)
applyTypeFieldNames :: DirectiveUsage -> FieldName -> FieldName
applyTypeFieldNames :: DirectiveUsage -> FieldName -> FieldName
applyTypeFieldNames (DirectiveUsage a
x) = forall a. GQLDirective a => a -> FieldName -> FieldName
visitFieldNames' a
x
applyTypeEnumNames :: DirectiveUsage -> TypeName -> TypeName
applyTypeEnumNames :: DirectiveUsage -> TypeName -> TypeName
applyTypeEnumNames (DirectiveUsage a
x) = forall a. GQLDirective a => a -> TypeName -> TypeName
visitEnumNames' a
x
applyEnumDescription :: DirectiveUsage -> Maybe Description -> Maybe Description
applyEnumDescription :: DirectiveUsage -> Maybe Text -> Maybe Text
applyEnumDescription (DirectiveUsage a
x) = forall a. GQLDirective a => a -> Maybe Text -> Maybe Text
visitEnumDescription' a
x
applyEnumName :: DirectiveUsage -> TypeName -> TypeName
applyEnumName :: DirectiveUsage -> TypeName -> TypeName
applyEnumName (DirectiveUsage a
x) = forall a. GQLDirective a => a -> TypeName -> TypeName
visitEnumName' a
x
applyFieldName :: DirectiveUsage -> FieldName -> FieldName
applyFieldName :: DirectiveUsage -> FieldName -> FieldName
applyFieldName (DirectiveUsage a
x) = forall a. GQLDirective a => a -> FieldName -> FieldName
visitFieldName' a
x
applyFieldDescription :: DirectiveUsage -> Maybe Description -> Maybe Description
applyFieldDescription :: DirectiveUsage -> Maybe Text -> Maybe Text
applyFieldDescription (DirectiveUsage a
x) = forall a. GQLDirective a => a -> Maybe Text -> Maybe Text
visitFieldDescription' a
x
applyFieldDefaultValue :: DirectiveUsage -> Maybe (Value CONST) -> Maybe (Value CONST)
applyFieldDefaultValue :: DirectiveUsage -> Maybe (Value CONST) -> Maybe (Value CONST)
applyFieldDefaultValue (DirectiveUsage a
x) = forall a.
GQLDirective a =>
a -> Maybe (Value CONST) -> Maybe (Value CONST)
visitFieldDefaultValue' a
x
applyTypeDescription :: DirectiveUsage -> Maybe Description -> Maybe Description
applyTypeDescription :: DirectiveUsage -> Maybe Text -> Maybe Text
applyTypeDescription (DirectiveUsage a
x) = forall a. GQLDirective a => a -> Maybe Text -> Maybe Text
visitTypeDescription' a
x
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 =
'[ 'OBJECT,
'ENUM,
'INPUT_OBJECT,
'UNION,
'SCALAR,
'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