{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# 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,
description,
getDescriptions,
typeOptions,
getDirectives,
defaultValues,
directives,
__type,
__isEmptyType
),
__typeData,
deriveTypename,
deriveFingerprint,
encodeArguments,
DirectiveUsage (..),
DeriveArguments (..),
applyOnTypeName,
DirectiveUsages (..),
typeDirective,
fieldDirective,
enumDirective,
)
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.Kind
( CUSTOM,
DerivingKind (..),
SCALAR,
TYPE,
WRAPPER,
)
import Data.Morpheus.NamedResolvers (NamedResolverT (..))
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.Types.Directives
( GQLDirective (..),
ToLocations,
visitTypeName,
)
import Data.Morpheus.Server.Types.Internal
( GQLTypeOptions (..),
TypeData (..),
defaultTypeOptions,
mkTypeData,
prefixInputs,
)
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 (..),
)
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,
Directives,
FieldName,
IN,
OUT,
ObjectEntry (..),
Position (..),
TypeCategory (..),
TypeName,
TypeWrapper (..),
Value (..),
internal,
mkBaseType,
packName,
toNullable,
unpackName,
)
import Data.Sequence (Seq)
import Data.Text
( pack,
unpack,
)
import Data.Vector (Vector)
import GHC.Generics
import Relude hiding (Seq, Undefined, fromList, intercalate)
__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 -> (Bool -> String -> String) -> TypeCategory -> TypeData
deriveTypeData :: forall a (f :: * -> *).
Typeable a =>
f a -> (Bool -> String -> String) -> TypeCategory -> TypeData
deriveTypeData f a
proxy Bool -> String -> String
typeNameModifier TypeCategory
cat =
TypeData
{ gqlTypeName :: TypeName
gqlTypeName = forall a (t :: NAME). NamePacking a => a -> Name t
packName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall a b. (a -> b) -> a -> b
$ Bool -> String -> String
typeNameModifier (TypeCategory
cat forall a. Eq a => a -> a -> Bool
== TypeCategory
IN) String
originalTypeName,
gqlWrappers :: TypeWrapper
gqlWrappers = TypeWrapper
mkBaseType,
gqlFingerprint :: TypeFingerprint
gqlFingerprint = forall a (f :: * -> *).
Typeable a =>
TypeCategory -> f a -> TypeFingerprint
getFingerprint TypeCategory
cat f a
proxy
}
where
originalTypeName :: String
originalTypeName = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: NAME). NamePacking a => Name t -> a
unpackName forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *). Typeable a => f a -> TypeName
getTypename 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
..}
{-# DEPRECATED getDirectives "use: directives" #-}
class GQLType a where
type KIND a :: DerivingKind
type KIND a = TYPE
description :: f a -> Maybe Text
description f a
_ = forall a. Maybe a
Nothing
directives :: f a -> DirectiveUsages
directives f a
_ = forall a. Monoid a => a
mempty
getDescriptions :: f a -> Map Text Description
getDescriptions f a
_ = forall a. Monoid a => a
mempty
typeOptions :: f a -> GQLTypeOptions -> GQLTypeOptions
typeOptions f a
_ = forall a. a -> a
id
getDirectives :: f a -> Map Text (Directives CONST)
getDirectives f a
_ = forall a. Monoid a => a
mempty
defaultValues :: f a -> Map Text (Value CONST)
defaultValues f a
_ = forall a. Monoid a => a
mempty
__isEmptyType :: f a -> Bool
__isEmptyType f a
_ = Bool
False
__type :: f a -> TypeCategory -> TypeData
default __type :: Typeable a => f a -> TypeCategory -> TypeData
__type f a
proxy TypeCategory
category = TypeData -> DirectiveUsages -> TypeData
editTypeData TypeData
derivedType (forall a (f :: * -> *). GQLType a => f a -> DirectiveUsages
directives f a
proxy)
where
derivedType :: TypeData
derivedType = forall a (f :: * -> *).
Typeable a =>
f a -> (Bool -> String -> String) -> TypeCategory -> TypeData
deriveTypeData f a
proxy Bool -> String -> String
typeNameModifier TypeCategory
category
GQLTypeOptions {Bool -> String -> String
typeNameModifier :: GQLTypeOptions -> Bool -> String -> String
typeNameModifier :: Bool -> String -> String
typeNameModifier} = forall a (f :: * -> *).
GQLType a =>
f a -> GQLTypeOptions -> GQLTypeOptions
typeOptions f a
proxy GQLTypeOptions
defaultTypeOptions
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 ()
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
typeOptions :: forall (f :: * -> *).
f (Pair a b) -> GQLTypeOptions -> GQLTypeOptions
typeOptions f (Pair a b)
_ = GQLTypeOptions -> GQLTypeOptions
prefixInputs
instance Typeable m => GQLType (Undefined m) where
type KIND (Undefined m) = CUSTOM
__isEmptyType :: forall (f :: * -> *). f (Undefined m) -> Bool
__isEmptyType f (Undefined m)
_ = Bool
True
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)
typeOptions :: forall (f :: * -> *). f (a, b) -> GQLTypeOptions -> GQLTypeOptions
typeOptions f (a, b)
_ = GQLTypeOptions -> GQLTypeOptions
prefixInputs
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 a. Decode a => a -> GQLResult (Arguments CONST)
encodeArguments :: forall a. Decode a => a -> GQLResult (Arguments CONST)
encodeArguments a
x = 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
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 -> GQLError
internal GQLError
"TODO: expected arguments!")
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
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
"TODO: union 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} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy IN a),
__valueGQLOptions :: GQLTypeOptions
__valueGQLOptions = forall a (f :: * -> *).
GQLType a =>
f a -> GQLTypeOptions -> GQLTypeOptions
typeOptions (forall {k} (t :: k). Proxy t
Proxy @a) GQLTypeOptions
defaultTypeOptions,
__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
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) (HashMap FieldName [DirectiveUsage]
fd1 forall a. Semigroup a => a -> a -> a
<> HashMap FieldName [DirectiveUsage]
fd2) (HashMap TypeName [DirectiveUsage]
ed1 forall a. Semigroup a => a -> a -> a
<> 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
fieldName 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
fieldName [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
enumDirective :: TypeDirectiveConstraint a => TypeName -> a -> DirectiveUsages
enumDirective :: forall a.
TypeDirectiveConstraint a =>
TypeName -> a -> DirectiveUsages
enumDirective TypeName
fieldName 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
fieldName [forall a.
(GQLDirective a, GQLType a, Decode a, DeriveArguments (KIND a) a,
ToLocations (DIRECTIVE_LOCATIONS a)) =>
a -> DirectiveUsage
DirectiveUsage a
x])
data DirectiveUsage where
DirectiveUsage :: (GQLDirective a, GQLType a, Decode a, DeriveArguments (KIND a) a, ToLocations (DIRECTIVE_LOCATIONS a)) => a -> DirectiveUsage
applyOnTypeName :: DirectiveUsage -> TypeName -> TypeName
applyOnTypeName :: DirectiveUsage -> TypeName -> TypeName
applyOnTypeName (DirectiveUsage a
x) = forall a. GQLDirective a => a -> TypeName -> TypeName
visitTypeName a
x
typeNameWithDirectives :: TypeName -> [DirectiveUsage] -> TypeName
typeNameWithDirectives :: TypeName -> [DirectiveUsage] -> TypeName
typeNameWithDirectives = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DirectiveUsage -> TypeName -> TypeName
applyOnTypeName
editTypeData :: TypeData -> DirectiveUsages -> TypeData
editTypeData :: TypeData -> DirectiveUsages -> TypeData
editTypeData TypeData {TypeWrapper
TypeName
TypeFingerprint
gqlFingerprint :: TypeFingerprint
gqlWrappers :: TypeWrapper
gqlTypeName :: TypeName
gqlWrappers :: TypeData -> TypeWrapper
gqlFingerprint :: TypeData -> TypeFingerprint
gqlTypeName :: TypeData -> TypeName
..} DirectiveUsages {[DirectiveUsage]
typeDirectives :: [DirectiveUsage]
typeDirectives :: DirectiveUsages -> [DirectiveUsage]
typeDirectives} = TypeData {gqlTypeName :: TypeName
gqlTypeName = TypeName -> [DirectiveUsage] -> TypeName
typeNameWithDirectives TypeName
gqlTypeName [DirectiveUsage]
typeDirectives, TypeWrapper
TypeFingerprint
gqlFingerprint :: TypeFingerprint
gqlWrappers :: TypeWrapper
gqlWrappers :: TypeWrapper
gqlFingerprint :: TypeFingerprint
..}