{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Server.Deriving.Resolvers ( deriveResolvers, deriveNamedResolvers, DERIVE_RESOLVERS, DERIVE_NAMED_RESOLVERS, ) where import Data.Morpheus.App.Internal.Resolving ( MonadResolver (MonadMutation, MonadQuery, MonadSubscription), NamedResolver (..), Resolver, ResolverValue, RootResolverValue (..), ) import Data.Morpheus.Internal.Ext (GQLResult) import Data.Morpheus.Server.Deriving.Internal.Resolve.Explore ( EXPLORE, useObjectResolvers, ) import Data.Morpheus.Server.Deriving.Kinded.Channels ( CHANNELS, resolverChannels, ) import Data.Morpheus.Server.Deriving.Kinded.NamedResolver ( KindedNamedResolver (..), ) import Data.Morpheus.Server.Deriving.Kinded.NamedResolverFun (KindedNamedFunValue (..)) import Data.Morpheus.Server.Deriving.Utils.GScan ( ScanRef, Scanner (..), scan, ) import Data.Morpheus.Server.Deriving.Utils.Proxy ( ContextValue (..), ) import Data.Morpheus.Server.Deriving.Utils.Use (UseNamedResolver (..)) import Data.Morpheus.Server.Resolvers ( NamedResolverT (..), NamedResolvers (..), RootResolver (..), ) import Data.Morpheus.Server.Types.GQLType ( GQLResolver, GQLType (..), GQLValue, ignoreUndefined, kindedProxy, withDir, withRes, ) import Data.Morpheus.Types.Internal.AST ( QUERY, ) import Relude class GQLNamedResolverFun (m :: Type -> Type) a where deriveNamedResFun :: a -> m (ResolverValue m) class GQLType a => GQLNamedResolver (m :: Type -> Type) a where deriveNamedRes :: f a -> [NamedResolver m] deriveNamedRefs :: f a -> [ScanRef (GQLNamedResolver m)] instance (GQLType a, KindedNamedResolver GQLNamedResolver GQLNamedResolverFun GQLType GQLValue m (KIND a) a) => GQLNamedResolver m a where deriveNamedRes :: forall (f :: * -> *). f a -> [NamedResolver m] deriveNamedRes = forall {k} (namedRes :: (* -> *) -> * -> Constraint) (resFun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint) (m :: * -> *) (k :: DerivingKind) (a :: k) (f :: DerivingKind -> k -> *). KindedNamedResolver namedRes resFun gql val m k a => UseNamedResolver namedRes resFun gql val -> f k a -> [NamedResolver m] kindedNamedResolver UseNamedResolver GQLNamedResolver GQLNamedResolverFun GQLType GQLValue withNamed forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. f a -> KindedProxy (KIND a) a kindedProxy deriveNamedRefs :: forall (f :: * -> *). f a -> [ScanRef (GQLNamedResolver m)] deriveNamedRefs = forall {k} (namedRes :: (* -> *) -> * -> Constraint) (resFun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint) (m :: * -> *) (k :: DerivingKind) (a :: k) (f :: DerivingKind -> k -> *). KindedNamedResolver namedRes resFun gql val m k a => UseNamedResolver namedRes resFun gql val -> f k a -> [ScanRef (namedRes m)] kindedNamedRefs UseNamedResolver GQLNamedResolver GQLNamedResolverFun GQLType GQLValue withNamed forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. f a -> KindedProxy (KIND a) a kindedProxy instance KindedNamedFunValue GQLNamedResolverFun GQLType GQLValue (KIND a) m a => GQLNamedResolverFun m a where deriveNamedResFun :: a -> m (ResolverValue m) deriveNamedResFun a resolver = forall (res :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint) (k :: DerivingKind) (m :: * -> *) a (namedRes :: (* -> *) -> * -> Constraint). KindedNamedFunValue res gql val k m a => UseNamedResolver namedRes res gql val -> ContextValue k a -> m (ResolverValue m) kindedNamedFunValue UseNamedResolver GQLNamedResolver GQLNamedResolverFun GQLType GQLValue withNamed (forall (kind :: DerivingKind) a. a -> ContextValue kind a ContextValue a resolver :: ContextValue (KIND a) a) withNamed :: UseNamedResolver GQLNamedResolver GQLNamedResolverFun GQLType GQLValue withNamed :: UseNamedResolver GQLNamedResolver GQLNamedResolverFun GQLType GQLValue withNamed = UseNamedResolver { namedDrv :: UseDeriving GQLType GQLValue namedDrv = UseDeriving GQLType GQLValue withDir, useNamedFieldResolver :: forall a (m :: * -> *). GQLNamedResolverFun m a => a -> m (ResolverValue m) useNamedFieldResolver = forall (m :: * -> *) a. GQLNamedResolverFun m a => a -> m (ResolverValue m) deriveNamedResFun, useDeriveNamedResolvers :: forall (f :: * -> *) a (m :: * -> *). GQLNamedResolver m a => f a -> [NamedResolver m] useDeriveNamedResolvers = forall (m :: * -> *) a (f :: * -> *). GQLNamedResolver m a => f a -> [NamedResolver m] deriveNamedRes, useDeriveNamedRefs :: forall (f :: * -> *) a (m :: * -> *). GQLNamedResolver m a => f a -> [ScanRef (GQLNamedResolver m)] useDeriveNamedRefs = forall (m :: * -> *) a (f :: * -> *). GQLNamedResolver m a => f a -> [ScanRef (GQLNamedResolver m)] deriveNamedRefs } deriveNamedResolver :: Scanner (GQLNamedResolver m) (NamedResolver m) deriveNamedResolver :: forall (m :: * -> *). Scanner (GQLNamedResolver m) (NamedResolver m) deriveNamedResolver = Scanner {scannerFun :: forall (f :: * -> *) a. GQLNamedResolver m a => f a -> [NamedResolver m] scannerFun = forall (m :: * -> *) a (f :: * -> *). GQLNamedResolver m a => f a -> [NamedResolver m] deriveNamedRes, scannerRefs :: forall (f :: * -> *) a. GQLNamedResolver m a => f a -> [ScanRef (GQLNamedResolver m)] scannerRefs = forall (m :: * -> *) a (f :: * -> *). GQLNamedResolver m a => f a -> [ScanRef (GQLNamedResolver m)] deriveNamedRefs} type ROOT (m :: Type -> Type) a = EXPLORE GQLType GQLResolver m (a m) type DERIVE_RESOLVERS m query mut sub = ( CHANNELS GQLType GQLValue sub (MonadSubscription m), ROOT (MonadQuery m) query, ROOT (MonadMutation m) mut, ROOT (MonadSubscription m) sub ) type DERIVE_NAMED_RESOLVERS m query = ( GQLType (query (NamedResolverT m)), KindedNamedResolver GQLNamedResolver GQLNamedResolverFun GQLType GQLValue m (KIND (query (NamedResolverT m))) (query (NamedResolverT m)) ) deriveResolvers :: (Monad m, DERIVE_RESOLVERS (Resolver QUERY e m) query mut sub) => RootResolver m e query mut sub -> GQLResult (RootResolverValue e m) deriveResolvers :: forall (m :: * -> *) e (query :: (* -> *) -> *) (mut :: (* -> *) -> *) (sub :: (* -> *) -> *). (Monad m, DERIVE_RESOLVERS (Resolver QUERY e m) query mut sub) => RootResolver m e query mut sub -> GQLResult (RootResolverValue e m) deriveResolvers RootResolver {query (Resolver QUERY e m) mut (Resolver MUTATION e m) sub (Resolver SUBSCRIPTION e m) subscriptionResolver :: forall (m :: * -> *) event (query :: (* -> *) -> *) (mutation :: (* -> *) -> *) (subscription :: (* -> *) -> *). RootResolver m event query mutation subscription -> subscription (Resolver SUBSCRIPTION event m) mutationResolver :: forall (m :: * -> *) event (query :: (* -> *) -> *) (mutation :: (* -> *) -> *) (subscription :: (* -> *) -> *). RootResolver m event query mutation subscription -> mutation (Resolver MUTATION event m) queryResolver :: forall (m :: * -> *) event (query :: (* -> *) -> *) (mutation :: (* -> *) -> *) (subscription :: (* -> *) -> *). RootResolver m event query mutation subscription -> query (Resolver QUERY event m) subscriptionResolver :: sub (Resolver SUBSCRIPTION e m) mutationResolver :: mut (Resolver MUTATION e m) queryResolver :: query (Resolver QUERY e m) ..} = forall (f :: * -> *) a. Applicative f => a -> f a pure RootResolverValue { queryResolver :: ResolverState (ObjectTypeResolver (Resolver QUERY e m)) queryResolver = 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 GQLResolver GQLType GQLValue withRes query (Resolver QUERY e m) queryResolver, mutationResolver :: ResolverState (ObjectTypeResolver (Resolver MUTATION e m)) mutationResolver = 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 GQLResolver GQLType GQLValue withRes mut (Resolver MUTATION e m) mutationResolver, subscriptionResolver :: ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m)) subscriptionResolver = 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 GQLResolver GQLType GQLValue withRes sub (Resolver SUBSCRIPTION e m) subscriptionResolver, channelMap :: Maybe (Selection VALID -> ResolverState (Channel e)) channelMap = forall (f :: * -> *) a. GQLType a => f a -> Maybe (f a) ignoreUndefined (forall a. a -> Identity a Identity sub (Resolver SUBSCRIPTION e m) subscriptionResolver) forall (f :: * -> *) a b. Functor f => f a -> b -> f b $> forall (m :: * -> *) (subs :: (* -> *) -> *) (gql :: * -> Constraint) (val :: * -> Constraint). CHANNELS gql val subs m => UseDeriving gql val -> subs m -> Selection VALID -> ResolverState (Channel (MonadEvent m)) resolverChannels UseDeriving GQLType GQLValue withDir sub (Resolver SUBSCRIPTION e m) subscriptionResolver } deriveNamedResolvers :: forall e m query mut sub. (Monad m, DERIVE_NAMED_RESOLVERS (Resolver QUERY e m) query) => NamedResolvers m e query mut sub -> RootResolverValue e m deriveNamedResolvers :: forall e (m :: * -> *) (query :: (* -> *) -> *) (mut :: (* -> *) -> *) (sub :: (* -> *) -> *). (Monad m, DERIVE_NAMED_RESOLVERS (Resolver QUERY e m) query) => NamedResolvers m e query mut sub -> RootResolverValue e m deriveNamedResolvers NamedResolvers m e query mut sub NamedResolvers = forall e (m :: * -> *). ResolverMap (Resolver QUERY e m) -> RootResolverValue e m NamedResolversValue forall a b. (a -> b) -> a -> b $ forall k b (c :: * -> Constraint). (Hashable k, Eq k) => (b -> k) -> Scanner c b -> [ScanRef c] -> HashMap k b scan forall (m :: * -> *). NamedResolver m -> TypeName resolverName forall (m :: * -> *). Scanner (GQLNamedResolver m) (NamedResolver m) deriveNamedResolver (forall (m :: * -> *) a (f :: * -> *). GQLNamedResolver m a => f a -> [ScanRef (GQLNamedResolver m)] deriveNamedRefs (forall {k} (t :: k). Proxy t Proxy @(query (NamedResolverT (Resolver QUERY e m)))))