{-# 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
{ RootResolverValue e m
-> ResolverState (ObjectTypeResolver (Resolver QUERY e m))
queryResolver :: ResolverState (ObjectTypeResolver (Resolver QUERY e m)),
RootResolverValue e m
-> ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
mutationResolver :: ResolverState (ObjectTypeResolver (Resolver MUTATION e m)),
RootResolverValue e m
-> ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
subscriptionResolver :: ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m)),
RootResolverValue e m
-> Maybe (Selection VALID -> ResolverState (Channel e))
channelMap :: Maybe (Selection VALID -> ResolverState (Channel e))
}
| NamedResolversValue
{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 =
RootResolverValue e m -> Parser (RootResolverValue e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
RootResolverValue :: forall e (m :: * -> *).
ResolverState (ObjectTypeResolver (Resolver QUERY e m))
-> ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
-> ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
-> Maybe (Selection VALID -> ResolverState (Channel e))
-> RootResolverValue e m
RootResolverValue
{ queryResolver :: ResolverState (ObjectTypeResolver (Resolver QUERY e m))
queryResolver = Text
-> Value -> ResolverState (ObjectTypeResolver (Resolver QUERY e m))
forall (f :: * -> *) (m :: * -> *).
(MonadError GQLError f, Monad m) =>
Text -> Value -> f (ObjectTypeResolver m)
lookupResJSON Text
"query" Value
res,
mutationResolver :: ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
mutationResolver = Text
-> Value
-> ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
forall (f :: * -> *) (m :: * -> *).
(MonadError GQLError f, Monad m) =>
Text -> Value -> f (ObjectTypeResolver m)
lookupResJSON Text
"mutation" Value
res,
subscriptionResolver :: ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
subscriptionResolver = Text
-> Value
-> ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
forall (f :: * -> *) (m :: * -> *).
(MonadError GQLError f, Monad m) =>
Text -> Value -> f (ObjectTypeResolver m)
lookupResJSON Text
"subscription" Value
res,
channelMap :: Maybe (Selection VALID -> ResolverState (Channel e))
channelMap = Maybe (Selection VALID -> ResolverState (Channel e))
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 :: 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 <- ResolverStateT
(ResponseEvent e m) m (ObjectTypeResolver (Resolver o e m))
-> ResolverContext
-> ResultT
(ResponseEvent e m) m (ObjectTypeResolver (Resolver o e m))
forall e (m :: * -> *) a.
ResolverStateT e m a -> ResolverContext -> ResultT e m a
runResolverStateT (ResolverState (ObjectTypeResolver (Resolver o e m))
-> ResolverStateT
(ResponseEvent e m) m (ObjectTypeResolver (Resolver o e m))
forall (m :: * -> *) a e.
Applicative m =>
ResolverState a -> ResolverStateT e m a
toResolverStateT ResolverState (ObjectTypeResolver (Resolver o e m))
res) ResolverContext
ctx
Maybe (Selection VALID -> ResolverState (Channel e))
-> Resolver o e m (Value VALID)
-> ResolverContext
-> ResponseStream e m (Value VALID)
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 (ResolverMap (Resolver o e m)
-> ObjectTypeResolver (Resolver o e m)
-> SelectionSet VALID
-> Resolver o e m (Value VALID)
forall (m :: * -> *).
(MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverMap m
-> ObjectTypeResolver m -> SelectionSet VALID -> m (Value VALID)
resolveObject ResolverMap (Resolver o e m)
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 :: 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 =
(ResolverContext
-> SelectionSet VALID -> ResponseStream e m (Value VALID))
-> ResolverContext -> ResponseStream e m (Value VALID)
forall (m :: * -> *) event.
Monad m =>
(ResolverContext
-> SelectionSet VALID -> ResponseStream event m (Value VALID))
-> ResolverContext -> ResponseStream event m (Value VALID)
withIntrospection (Maybe (Selection VALID -> ResolverState (Channel e))
-> ResolverState (ObjectTypeResolver (Resolver QUERY e m))
-> ResolverContext
-> SelectionSet VALID
-> ResponseStream e m (Value VALID)
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 =
Maybe (Selection VALID -> ResolverState (Channel e))
-> ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
-> ResolverContext
-> SelectionSet VALID
-> ResponseStream e m (Value VALID)
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 =
Maybe (Selection VALID -> ResolverState (Channel e))
-> ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
-> ResolverContext
-> SelectionSet VALID
-> ResponseStream e m (Value VALID)
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 = (ResolverContext
-> SelectionSet VALID -> ResponseStream e m (Value VALID))
-> ResolverContext -> ResponseStream e m (Value VALID)
forall (m :: * -> *) event.
Monad m =>
(ResolverContext
-> SelectionSet VALID -> ResponseStream event m (Value VALID))
-> ResolverContext -> ResponseStream event m (Value VALID)
withIntrospection (Maybe (Selection VALID -> ResolverState (Channel e))
-> TypeName
-> ResolverMap (Resolver QUERY e m)
-> ResolverContext
-> SelectionSet VALID
-> ResponseStream e m (Value VALID)
forall (m :: * -> *) (o :: OperationType) e.
(Monad m, LiftOperation o) =>
Maybe (Selection VALID -> ResolverState (Channel e))
-> TypeName
-> ResolverMap (Resolver o e m)
-> ResolverContext
-> SelectionSet VALID
-> ResponseStream e m (Value VALID)
runResolverMap Maybe (Selection VALID -> ResolverState (Channel e))
forall a. Maybe a
Nothing TypeName
"Query" ResolverMap (Resolver QUERY e m)
queryResolverMap) ResolverContext
ctx
selectByOperation OperationType
_ = GQLError -> ResponseStream e m (Value VALID)
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 :: (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 SelectionSet VALID
-> (Maybe (SelectionSet VALID), Maybe (SelectionSet VALID))
forall (s :: Stage).
SelectionSet s -> (Maybe (SelectionSet s), Maybe (SelectionSet s))
splitSystemSelection (Operation VALID -> SelectionSet VALID
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 (Operation VALID -> SelectionSet VALID
forall (s :: Stage). Operation s -> SelectionSet s
operationSelection Operation VALID
operation)
(Just SelectionSet VALID
intro, Maybe (SelectionSet VALID)
Nothing) -> SelectionSet VALID
-> ResolverContext -> ResponseStream event m (Value VALID)
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 <- SelectionSet VALID
-> ResolverContext -> ResponseStream event m (Value VALID)
forall (m :: * -> *) event.
Monad m =>
SelectionSet VALID
-> ResolverContext -> ResponseStream event m (Value VALID)
introspection SelectionSet VALID
intro ResolverContext
ctx
Value VALID -> Value VALID -> ResponseStream event m (Value VALID)
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 :: 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} = Maybe (Selection VALID -> ResolverState (Channel event))
-> Resolver QUERY event m (Value VALID)
-> ResolverContext
-> ResponseStream event m (Value VALID)
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 event))
forall a. Maybe a
Nothing (ResolverMap (Resolver QUERY event m)
-> ObjectTypeResolver (Resolver QUERY event m)
-> SelectionSet VALID
-> Resolver QUERY event m (Value VALID)
forall (m :: * -> *).
(MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverMap m
-> ObjectTypeResolver m -> SelectionSet VALID -> m (Value VALID)
resolveObject ResolverMap (Resolver QUERY event m)
forall a. Monoid a => a
mempty (Schema VALID -> ObjectTypeResolver (Resolver QUERY event m)
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 :: Value VALID -> Value VALID -> m (Value VALID)
mergeRoot (Object Object VALID
x) (Object Object VALID
y) = Object VALID -> Value VALID
forall (stage :: Stage). Object stage -> Value stage
Object (Object VALID -> Value VALID)
-> m (Object VALID) -> m (Value VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object VALID -> Object VALID -> m (Object VALID)
forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge Object VALID
x Object VALID
y
mergeRoot Value VALID
_ Value VALID
_ = GQLError -> m (Value VALID)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal GQLError
"can't merge non object types")