{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.App.Internal.Resolving.RootResolverValue ( runRootResolverValue, RootResolverValue (..), ) where import Control.Monad.Except (MonadError, throwError) import qualified Data.Aeson as A import Data.Morpheus.App.Internal.Resolving.Event ( EventHandler (..), ) import Data.Morpheus.App.Internal.Resolving.ResolveValue import Data.Morpheus.App.Internal.Resolving.Resolver ( LiftOperation, Resolver, ResponseStream, runResolver, ) import Data.Morpheus.App.Internal.Resolving.ResolverState ( ResolverContext (..), ResolverState, runResolverStateT, toResolverStateT, ) import Data.Morpheus.App.Internal.Resolving.SchemaAPI (schemaAPI) import Data.Morpheus.App.Internal.Resolving.Types import Data.Morpheus.App.Internal.Resolving.Utils ( lookupResJSON, ) import Data.Morpheus.Internal.Ext (merge) import Data.Morpheus.Internal.Utils ( empty, ) import Data.Morpheus.Types.Internal.AST ( GQLError, MUTATION, Operation (..), OperationType (..), QUERY, SUBSCRIPTION, Selection, SelectionContent (SelectionSet), SelectionSet, VALID, ValidValue, Value (..), internal, splitSystemSelection, ) import Relude hiding ( Show, empty, show, ) data RootResolverValue e m = RootResolverValue { forall e (m :: * -> *). RootResolverValue e m -> ResolverState (ObjectTypeResolver (Resolver QUERY e m)) queryResolver :: ResolverState (ObjectTypeResolver (Resolver QUERY e m)), forall e (m :: * -> *). RootResolverValue e m -> ResolverState (ObjectTypeResolver (Resolver MUTATION e m)) mutationResolver :: ResolverState (ObjectTypeResolver (Resolver MUTATION e m)), forall e (m :: * -> *). RootResolverValue e m -> ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m)) subscriptionResolver :: ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m)), forall e (m :: * -> *). RootResolverValue e m -> Maybe (Selection VALID -> ResolverState (Channel e)) channelMap :: Maybe (Selection VALID -> ResolverState (Channel e)) } | NamedResolversValue {forall e (m :: * -> *). RootResolverValue e m -> ResolverMap (Resolver QUERY e m) queryResolverMap :: ResolverMap (Resolver QUERY e m)} instance Monad m => A.FromJSON (RootResolverValue e m) where parseJSON :: Value -> Parser (RootResolverValue e m) parseJSON Value res = forall (f :: * -> *) a. Applicative f => a -> f a pure RootResolverValue { queryResolver :: ResolverState (ObjectTypeResolver (Resolver QUERY e m)) queryResolver = forall (f :: * -> *) (m :: * -> *). (MonadError GQLError f, MonadReader ResolverContext f, MonadReader ResolverContext m) => FieldName -> Value -> f (ObjectTypeResolver m) lookupResJSON FieldName "query" Value res, mutationResolver :: ResolverState (ObjectTypeResolver (Resolver MUTATION e m)) mutationResolver = forall (f :: * -> *) (m :: * -> *). (MonadError GQLError f, MonadReader ResolverContext f, MonadReader ResolverContext m) => FieldName -> Value -> f (ObjectTypeResolver m) lookupResJSON FieldName "mutation" Value res, subscriptionResolver :: ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m)) subscriptionResolver = forall (f :: * -> *) (m :: * -> *). (MonadError GQLError f, MonadReader ResolverContext f, MonadReader ResolverContext m) => FieldName -> Value -> f (ObjectTypeResolver m) lookupResJSON FieldName "subscription" Value res, channelMap :: Maybe (Selection VALID -> ResolverState (Channel e)) channelMap = forall a. Maybe a Nothing } runRootDataResolver :: (Monad m, LiftOperation o) => Maybe (Selection VALID -> ResolverState (Channel e)) -> ResolverState (ObjectTypeResolver (Resolver o e m)) -> ResolverContext -> SelectionSet VALID -> ResponseStream e m (Value VALID) runRootDataResolver :: forall (m :: * -> *) (o :: OperationType) e. (Monad m, LiftOperation o) => Maybe (Selection VALID -> ResolverState (Channel e)) -> ResolverState (ObjectTypeResolver (Resolver o e m)) -> ResolverContext -> SelectionSet VALID -> ResponseStream e m (Value VALID) runRootDataResolver Maybe (Selection VALID -> ResolverState (Channel e)) channels ResolverState (ObjectTypeResolver (Resolver o e m)) res ResolverContext ctx SelectionSet VALID selection = do ObjectTypeResolver (Resolver o e m) root <- forall e (m :: * -> *) a. ResolverStateT e m a -> ResolverContext -> ResultT e m a runResolverStateT (forall (m :: * -> *) a e. Applicative m => ResolverState a -> ResolverStateT e m a toResolverStateT ResolverState (ObjectTypeResolver (Resolver o e m)) res) ResolverContext ctx forall (m :: * -> *) event (o :: OperationType). Monad m => Maybe (Selection VALID -> ResolverState (Channel event)) -> Resolver o event m (Value VALID) -> ResolverContext -> ResponseStream event m (Value VALID) runResolver Maybe (Selection VALID -> ResolverState (Channel e)) channels (forall (m :: * -> *). (MonadReader ResolverContext m, MonadError GQLError m) => (LocalCache, ResolverMap m) -> ObjectTypeResolver m -> Maybe (SelectionSet VALID) -> m (Value VALID) resolveObject forall a. Monoid a => a mempty ObjectTypeResolver (Resolver o e m) root (forall a. a -> Maybe a Just SelectionSet VALID selection)) ResolverContext ctx runRootResolverValue :: Monad m => RootResolverValue e m -> ResolverContext -> ResponseStream e m (Value VALID) runRootResolverValue :: forall (m :: * -> *) e. Monad m => RootResolverValue e m -> ResolverContext -> ResponseStream e m (Value VALID) runRootResolverValue RootResolverValue { ResolverState (ObjectTypeResolver (Resolver QUERY e m)) queryResolver :: ResolverState (ObjectTypeResolver (Resolver QUERY e m)) queryResolver :: forall e (m :: * -> *). RootResolverValue e m -> ResolverState (ObjectTypeResolver (Resolver QUERY e m)) queryResolver, ResolverState (ObjectTypeResolver (Resolver MUTATION e m)) mutationResolver :: ResolverState (ObjectTypeResolver (Resolver MUTATION e m)) mutationResolver :: forall e (m :: * -> *). RootResolverValue e m -> ResolverState (ObjectTypeResolver (Resolver MUTATION e m)) mutationResolver, ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m)) subscriptionResolver :: ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m)) subscriptionResolver :: forall e (m :: * -> *). RootResolverValue e m -> ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m)) subscriptionResolver, Maybe (Selection VALID -> ResolverState (Channel e)) channelMap :: Maybe (Selection VALID -> ResolverState (Channel e)) channelMap :: forall e (m :: * -> *). RootResolverValue e m -> Maybe (Selection VALID -> ResolverState (Channel e)) channelMap } ctx :: ResolverContext ctx@ResolverContext {operation :: ResolverContext -> Operation VALID operation = Operation {OperationType operationType :: forall (s :: Stage). Operation s -> OperationType operationType :: OperationType operationType, SelectionSet VALID operationSelection :: forall (s :: Stage). Operation s -> SelectionSet s operationSelection :: SelectionSet VALID operationSelection}} = OperationType -> ResponseStream e m (Value VALID) selectByOperation OperationType operationType where selectByOperation :: OperationType -> ResponseStream e m (Value VALID) selectByOperation OperationType Query = forall (m :: * -> *) event. Monad m => (SelectionSet VALID -> ResponseStream event m (Value VALID)) -> ResolverContext -> ResponseStream event m (Value VALID) withIntrospection (forall (m :: * -> *) (o :: OperationType) e. (Monad m, LiftOperation o) => Maybe (Selection VALID -> ResolverState (Channel e)) -> ResolverState (ObjectTypeResolver (Resolver o e m)) -> ResolverContext -> SelectionSet VALID -> ResponseStream e m (Value VALID) runRootDataResolver Maybe (Selection VALID -> ResolverState (Channel e)) channelMap ResolverState (ObjectTypeResolver (Resolver QUERY e m)) queryResolver ResolverContext ctx) ResolverContext ctx selectByOperation OperationType Mutation = forall (m :: * -> *) (o :: OperationType) e. (Monad m, LiftOperation o) => Maybe (Selection VALID -> ResolverState (Channel e)) -> ResolverState (ObjectTypeResolver (Resolver o e m)) -> ResolverContext -> SelectionSet VALID -> ResponseStream e m (Value VALID) runRootDataResolver Maybe (Selection VALID -> ResolverState (Channel e)) channelMap ResolverState (ObjectTypeResolver (Resolver MUTATION e m)) mutationResolver ResolverContext ctx SelectionSet VALID operationSelection selectByOperation OperationType Subscription = forall (m :: * -> *) (o :: OperationType) e. (Monad m, LiftOperation o) => Maybe (Selection VALID -> ResolverState (Channel e)) -> ResolverState (ObjectTypeResolver (Resolver o e m)) -> ResolverContext -> SelectionSet VALID -> ResponseStream e m (Value VALID) runRootDataResolver Maybe (Selection VALID -> ResolverState (Channel e)) channelMap ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m)) subscriptionResolver ResolverContext ctx SelectionSet VALID operationSelection runRootResolverValue NamedResolversValue {ResolverMap (Resolver QUERY e m) queryResolverMap :: ResolverMap (Resolver QUERY e m) queryResolverMap :: forall e (m :: * -> *). RootResolverValue e m -> ResolverMap (Resolver QUERY e m) queryResolverMap} ctx :: ResolverContext ctx@ResolverContext {operation :: ResolverContext -> Operation VALID operation = Operation {OperationType operationType :: OperationType operationType :: forall (s :: Stage). Operation s -> OperationType operationType}} = OperationType -> ResponseStream e m (Value VALID) selectByOperation OperationType operationType where selectByOperation :: OperationType -> ResponseStream e m (Value VALID) selectByOperation OperationType Query = forall (m :: * -> *) event. Monad m => (SelectionSet VALID -> ResponseStream event m (Value VALID)) -> ResolverContext -> ResponseStream event m (Value VALID) withIntrospection (\SelectionSet VALID sel -> forall (m :: * -> *) event (o :: OperationType). Monad m => Maybe (Selection VALID -> ResolverState (Channel event)) -> Resolver o event m (Value VALID) -> ResolverContext -> ResponseStream event m (Value VALID) runResolver forall a. Maybe a Nothing (MergeMap 'False FieldName (Selection VALID) -> Resolver QUERY e m (Value VALID) resolvedValue SelectionSet VALID sel) ResolverContext ctx) ResolverContext ctx where resolvedValue :: MergeMap 'False FieldName (Selection VALID) -> Resolver QUERY e m (Value VALID) resolvedValue MergeMap 'False FieldName (Selection VALID) selection = forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => (LocalCache, ResolverMap m) -> NamedResolverRef -> SelectionContent VALID -> m (Value VALID) resolveRef (forall coll. Empty coll => coll empty, ResolverMap (Resolver QUERY e m) queryResolverMap) (Name 'TYPE -> NamedResolverArg -> NamedResolverRef NamedResolverRef Name 'TYPE "Query" [Value VALID "ROOT"]) (forall (s :: Stage). SelectionSet s -> SelectionContent s SelectionSet MergeMap 'False FieldName (Selection VALID) selection) selectByOperation OperationType _ = forall e (m :: * -> *) a. MonadError e m => e -> m a throwError GQLError "mutation and subscription is not supported for namedResolvers" withIntrospection :: Monad m => (SelectionSet VALID -> ResponseStream event m ValidValue) -> ResolverContext -> ResponseStream event m ValidValue withIntrospection :: forall (m :: * -> *) event. Monad m => (SelectionSet VALID -> ResponseStream event m (Value VALID)) -> ResolverContext -> ResponseStream event m (Value VALID) withIntrospection SelectionSet VALID -> ResponseStream event m (Value VALID) f ctx :: ResolverContext ctx@ResolverContext {Operation VALID operation :: Operation VALID operation :: ResolverContext -> Operation VALID operation} = case forall (s :: Stage). SelectionSet s -> (Maybe (SelectionSet s), Maybe (SelectionSet s)) splitSystemSelection (forall (s :: Stage). Operation s -> SelectionSet s operationSelection Operation VALID operation) of (Maybe (SelectionSet VALID) Nothing, Maybe (SelectionSet VALID) _) -> SelectionSet VALID -> ResponseStream event m (Value VALID) f (forall (s :: Stage). Operation s -> SelectionSet s operationSelection Operation VALID operation) (Just SelectionSet VALID intro, Maybe (SelectionSet VALID) Nothing) -> forall (m :: * -> *) event. Monad m => SelectionSet VALID -> ResolverContext -> ResponseStream event m (Value VALID) introspection SelectionSet VALID intro ResolverContext ctx (Just SelectionSet VALID intro, Just SelectionSet VALID selection) -> do Value VALID x <- SelectionSet VALID -> ResponseStream event m (Value VALID) f SelectionSet VALID selection Value VALID y <- forall (m :: * -> *) event. Monad m => SelectionSet VALID -> ResolverContext -> ResponseStream event m (Value VALID) introspection SelectionSet VALID intro ResolverContext ctx forall (m :: * -> *). MonadError GQLError m => Value VALID -> Value VALID -> m (Value VALID) mergeRoot Value VALID y Value VALID x introspection :: Monad m => SelectionSet VALID -> ResolverContext -> ResponseStream event m ValidValue introspection :: forall (m :: * -> *) event. Monad m => SelectionSet VALID -> ResolverContext -> ResponseStream event m (Value VALID) introspection SelectionSet VALID selection ctx :: ResolverContext ctx@ResolverContext {Schema VALID schema :: ResolverContext -> Schema VALID schema :: Schema VALID schema} = forall (m :: * -> *) event (o :: OperationType). Monad m => Maybe (Selection VALID -> ResolverState (Channel event)) -> Resolver o event m (Value VALID) -> ResolverContext -> ResponseStream event m (Value VALID) runResolver forall a. Maybe a Nothing (forall (m :: * -> *). (MonadReader ResolverContext m, MonadError GQLError m) => (LocalCache, ResolverMap m) -> ObjectTypeResolver m -> Maybe (SelectionSet VALID) -> m (Value VALID) resolveObject forall a. Monoid a => a mempty (forall (m :: * -> *) e. Monad m => Schema VALID -> ObjectTypeResolver (Resolver QUERY e m) schemaAPI Schema VALID schema) (forall a. a -> Maybe a Just SelectionSet VALID selection)) ResolverContext ctx mergeRoot :: MonadError GQLError m => ValidValue -> ValidValue -> m ValidValue mergeRoot :: forall (m :: * -> *). MonadError GQLError m => Value VALID -> Value VALID -> m (Value VALID) mergeRoot (Object Object VALID x) (Object Object VALID y) = forall (stage :: Stage). Object stage -> Value stage Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a merge Object VALID x Object VALID y mergeRoot Value VALID _ Value VALID _ = forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (GQLError -> GQLError internal GQLError "can't merge non object types")