{-# 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.NamedResolver (runResolverMap)
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.Types.Internal.AST
( GQLError,
MUTATION,
Operation (..),
OperationType (..),
QUERY,
SUBSCRIPTION,
Selection,
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, Monad 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, Monad 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, Monad 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) =>
ResolverMap m
-> ObjectTypeResolver m -> SelectionSet VALID -> m (Value VALID)
resolveObject forall a. Monoid a => a
mempty ObjectTypeResolver (Resolver o e m)
root 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 =>
(ResolverContext
-> 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
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 =>
(ResolverContext
-> 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))
-> Name 'TYPE
-> ResolverMap (Resolver o e m)
-> ResolverContext
-> SelectionSet VALID
-> ResponseStream e m (Value VALID)
runResolverMap forall a. Maybe a
Nothing Name 'TYPE
"Query" ResolverMap (Resolver QUERY e m)
queryResolverMap) ResolverContext
ctx
selectByOperation OperationType
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"mutation and subscription is not yet supported"
withIntrospection :: Monad m => (ResolverContext -> SelectionSet VALID -> ResponseStream event m ValidValue) -> ResolverContext -> ResponseStream event m ValidValue
withIntrospection :: forall (m :: * -> *) event.
Monad m =>
(ResolverContext
-> SelectionSet VALID -> ResponseStream event m (Value VALID))
-> ResolverContext -> ResponseStream event m (Value VALID)
withIntrospection ResolverContext
-> 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)
_) -> ResolverContext
-> SelectionSet VALID -> ResponseStream event m (Value VALID)
f ResolverContext
ctx (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 <- ResolverContext
-> SelectionSet VALID -> ResponseStream event m (Value VALID)
f ResolverContext
ctx 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) =>
ResolverMap m
-> ObjectTypeResolver m -> 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) 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")