{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Server.Deriving.Internal.Resolve.Explore
( useExploreResolvers,
useObjectResolvers,
EXPLORE,
)
where
import Control.Monad.Except (MonadError)
import Data.Morpheus.App.Internal.Resolving
( ObjectTypeResolver (..),
ResolverState,
ResolverValue (..),
mkEnum,
mkObject,
mkUnion,
requireObject,
)
import Data.Morpheus.Server.Deriving.Internal.Schema.Directive
( toFieldRes,
visitEnumName,
)
import Data.Morpheus.Server.Deriving.Utils.GRep
( ConsRep (..),
FieldRep (..),
GRep,
RepContext (..),
TypeRep (..),
deriveValue,
isUnionRef,
)
import Data.Morpheus.Server.Deriving.Utils.Kinded (inputType)
import Data.Morpheus.Server.Deriving.Utils.Use
( UseDeriving (..),
UseGQLType (..),
UseResolver (..),
)
import Data.Morpheus.Types.Internal.AST
( GQLError,
TypeRef (..),
)
import GHC.Generics (Generic (Rep))
import Relude
convertNode ::
gql a =>
(MonadError GQLError m) =>
UseDeriving gql val ->
f a ->
TypeRep (m (ResolverValue m)) ->
ResolverValue m
convertNode :: forall (gql :: * -> Constraint) a (m :: * -> *)
(val :: * -> Constraint) (f :: * -> *).
(gql a, MonadError GQLError m) =>
UseDeriving gql val
-> f a -> TypeRep (m (ResolverValue m)) -> ResolverValue m
convertNode
UseDeriving gql val
drv
f a
proxy
TypeRep
{ TypeName
dataTypeName :: forall v. TypeRep v -> TypeName
dataTypeName :: TypeName
dataTypeName,
Bool
tyIsUnion :: forall v. TypeRep v -> Bool
tyIsUnion :: Bool
tyIsUnion,
tyCons :: forall v. TypeRep v -> ConsRep v
tyCons = cons :: ConsRep (m (ResolverValue m))
cons@ConsRep {[FieldRep (m (ResolverValue m))]
consFields :: forall v. ConsRep v -> [FieldRep v]
consFields :: [FieldRep (m (ResolverValue m))]
consFields, TypeName
consName :: forall v. ConsRep v -> TypeName
consName :: TypeName
consName}
} = forall (m :: * -> *).
MonadError GQLError m =>
[FieldRep (m (ResolverValue m))] -> ResolverValue m
encodeTypeFields [FieldRep (m (ResolverValue m))]
consFields
where
encodeTypeFields :: (MonadError GQLError m) => [FieldRep (m (ResolverValue m))] -> ResolverValue m
encodeTypeFields :: forall (m :: * -> *).
MonadError GQLError m =>
[FieldRep (m (ResolverValue m))] -> ResolverValue m
encodeTypeFields [] = forall (m :: * -> *). TypeName -> ResolverValue m
mkEnum (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> TypeName -> TypeName
visitEnumName UseDeriving gql val
drv f a
proxy TypeName
consName)
encodeTypeFields [FieldRep (m (ResolverValue m))]
fields
| Bool -> Bool
not Bool
tyIsUnion = forall (m :: * -> *).
TypeName -> [ResolverEntry m] -> ResolverValue m
mkObject TypeName
dataTypeName (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *) v.
gql a =>
UseDeriving gql args -> f a -> FieldRep v -> (FieldName, v)
toFieldRes UseDeriving gql val
drv f a
proxy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldRep (m (ResolverValue m))]
fields)
encodeTypeFields [FieldRep {TypeRef
fieldTypeRef :: forall a. FieldRep a -> TypeRef
fieldTypeRef :: TypeRef
fieldTypeRef, m (ResolverValue m)
fieldValue :: forall a. FieldRep a -> a
fieldValue :: m (ResolverValue m)
fieldValue}]
| forall k. TypeName -> ConsRep k -> Bool
isUnionRef TypeName
dataTypeName ConsRep (m (ResolverValue m))
cons = forall (m :: * -> *). m (ResolverValue m) -> ResolverValue m
ResLazy (forall (m :: * -> *).
Maybe TypeName -> ObjectTypeResolver m -> ResolverValue m
ResObject (forall a. a -> Maybe a
Just (TypeRef -> TypeName
typeConName TypeRef
fieldTypeRef)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m (ResolverValue m)
fieldValue forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) (m :: * -> *).
MonadError GQLError f =>
ResolverValue m -> f (ObjectTypeResolver m)
requireObject))
encodeTypeFields [FieldRep (m (ResolverValue m))]
fields = forall (m :: * -> *).
Monad m =>
TypeName -> [ResolverEntry m] -> ResolverValue m
mkUnion TypeName
consName (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *) v.
gql a =>
UseDeriving gql args -> f a -> FieldRep v -> (FieldName, v)
toFieldRes UseDeriving gql val
drv f a
proxy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldRep (m (ResolverValue m))]
fields)
toOptions :: UseResolver res gql val -> RepContext gql (res m) Identity (m (ResolverValue m))
toOptions :: forall (res :: (* -> *) -> * -> Constraint)
(gql :: * -> Constraint) (val :: * -> Constraint) (m :: * -> *).
UseResolver res gql val
-> RepContext gql (res m) Identity (m (ResolverValue m))
toOptions UseResolver {UseDeriving gql val
forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
resDrv :: forall (res :: (* -> *) -> * -> Constraint)
(gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val -> UseDeriving gql val
useEncodeResolver :: forall (res :: (* -> *) -> * -> Constraint)
(gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
resDrv :: UseDeriving gql val
useEncodeResolver :: forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
..} =
RepContext
{ optApply :: forall a. res m a => Identity a -> m (ResolverValue m)
optApply = forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
useEncodeResolver forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity,
optTypeData :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeData
optTypeData = forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeData
useTypeData (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL UseDeriving gql val
resDrv) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> CatType IN a
inputType
}
useExploreResolvers ::
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val ->
a ->
ResolverValue m
useExploreResolvers :: forall (m :: * -> *) (gql :: * -> Constraint)
(res :: (* -> *) -> * -> Constraint) a (val :: * -> Constraint).
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val -> a -> ResolverValue m
useExploreResolvers UseResolver res gql val
res a
v = forall (gql :: * -> Constraint) a (m :: * -> *)
(val :: * -> Constraint) (f :: * -> *).
(gql a, MonadError GQLError m) =>
UseDeriving gql val
-> f a -> TypeRep (m (ResolverValue m)) -> ResolverValue m
convertNode (forall (res :: (* -> *) -> * -> Constraint)
(gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val -> UseDeriving gql val
resDrv UseResolver res gql val
res) Identity a
proxy (forall a (gql :: * -> Constraint) (constraint :: * -> Constraint)
value.
(Generic a, GRep gql constraint value (Rep a), gql a) =>
RepContext gql constraint Identity value -> a -> TypeRep value
deriveValue (forall (res :: (* -> *) -> * -> Constraint)
(gql :: * -> Constraint) (val :: * -> Constraint) (m :: * -> *).
UseResolver res gql val
-> RepContext gql (res m) Identity (m (ResolverValue m))
toOptions UseResolver res gql val
res) a
v)
where
proxy :: Identity a
proxy = forall a. a -> Identity a
Identity a
v
useObjectResolvers ::
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val ->
a ->
ResolverState (ObjectTypeResolver m)
useObjectResolvers :: forall (m :: * -> *) (gql :: * -> Constraint)
(res :: (* -> *) -> * -> Constraint) a (val :: * -> Constraint).
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val
-> a -> ResolverState (ObjectTypeResolver m)
useObjectResolvers UseResolver res gql val
ctx a
value = forall (f :: * -> *) (m :: * -> *).
MonadError GQLError f =>
ResolverValue m -> f (ObjectTypeResolver m)
requireObject (forall (m :: * -> *) (gql :: * -> Constraint)
(res :: (* -> *) -> * -> Constraint) a (val :: * -> Constraint).
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val -> a -> ResolverValue m
useExploreResolvers UseResolver res gql val
ctx a
value)
type EXPLORE gql res (m :: Type -> Type) a =
( Generic a,
GRep gql (res m) (m (ResolverValue m)) (Rep a),
gql a
)