{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.App.Internal.Resolving.Resolver
( Resolver,
LiftOperation,
lift,
subscribe,
ResponseEvent (..),
ResponseStream,
WithOperation,
ResolverContext (..),
unsafeInternalContext,
withArguments,
getArguments,
SubscriptionField (..),
liftResolverState,
runResolver,
getArgument,
)
where
import Control.Monad.Except (MonadError (..))
import Control.Monad.Trans.Reader (mapReaderT)
import Data.Morpheus.App.Internal.Resolving.Event
( EventHandler (..),
ResponseEvent (..),
)
import Data.Morpheus.App.Internal.Resolving.ResolverState
( ResolverContext (..),
ResolverState,
ResolverStateT (..),
clearStateResolverEvents,
resolverFailureMessage,
runResolverState,
runResolverStateT,
runResolverStateValueM,
toResolverStateT,
)
import Data.Morpheus.Internal.Ext
( GQLResult,
PushEvents (..),
Result (..),
ResultT (..),
cleanEvents,
mapEvent,
)
import Data.Morpheus.Internal.Utils (selectOr)
import Data.Morpheus.Types.IO
( GQLResponse,
renderResponse,
)
import Data.Morpheus.Types.Internal.AST
( Argument (argumentValue),
Arguments,
FieldName,
GQLError,
MUTATION,
OperationType (..),
QUERY,
SUBSCRIPTION,
Selection (..),
VALID,
ValidValue,
Value (..),
msg,
)
import Relude hiding
( Show,
empty,
show,
)
import Prelude (Show (..))
type WithOperation (o :: OperationType) = LiftOperation o
type ResponseStream event (m :: Type -> Type) = ResultT (ResponseEvent event m) m
data SubscriptionField (a :: Type) where
SubscriptionField ::
{ SubscriptionField a
-> forall e (m :: * -> *) v.
(a ~ Resolver SUBSCRIPTION e m v) =>
Channel e
channel :: forall e m v. a ~ Resolver SUBSCRIPTION e m v => Channel e,
SubscriptionField a -> a
unSubscribe :: a
} ->
SubscriptionField a
data Resolver (o :: OperationType) event (m :: Type -> Type) value where
ResolverQ :: {Resolver QUERY event m value -> ResolverStateT () m value
runResolverQ :: ResolverStateT () m value} -> Resolver QUERY event m value
ResolverM :: {Resolver MUTATION event m value -> ResolverStateT event m value
runResolverM :: ResolverStateT event m value} -> Resolver MUTATION event m value
ResolverS :: {Resolver SUBSCRIPTION event m value
-> ResolverStateT () m (SubEventRes event m value)
runResolverS :: ResolverStateT () m (SubEventRes event m value)} -> Resolver SUBSCRIPTION event m value
type SubEventRes event m value = ReaderT event (ResolverStateT () m) value
instance Show (Resolver o e m value) where
show :: Resolver o e m value -> String
show ResolverQ {} = String
"Resolver QUERY e m a"
show ResolverM {} = String
"Resolver MUTATION e m a"
show ResolverS {} = String
"Resolver SUBSCRIPTION e m a"
deriving instance (Functor m) => Functor (Resolver o e m)
instance (LiftOperation o, Monad m) => Applicative (Resolver o e m) where
pure :: a -> Resolver o e m a
pure = ResolverStateT e m a -> Resolver o e m a
forall (o :: OperationType) (m :: * -> *) e a.
(LiftOperation o, Monad m) =>
ResolverStateT e m a -> Resolver o e m a
packResolver (ResolverStateT e m a -> Resolver o e m a)
-> (a -> ResolverStateT e m a) -> a -> Resolver o e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ResolverStateT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
ResolverQ ResolverStateT () m (a -> b)
r1 <*> :: Resolver o e m (a -> b) -> Resolver o e m a -> Resolver o e m b
<*> ResolverQ ResolverStateT () m a
r2 = ResolverStateT () m b -> Resolver QUERY e m b
forall (m :: * -> *) value event.
ResolverStateT () m value -> Resolver QUERY event m value
ResolverQ (ResolverStateT () m b -> Resolver QUERY e m b)
-> ResolverStateT () m b -> Resolver QUERY e m b
forall a b. (a -> b) -> a -> b
$ ResolverStateT () m (a -> b)
r1 ResolverStateT () m (a -> b)
-> ResolverStateT () m a -> ResolverStateT () m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ResolverStateT () m a
r2
ResolverM ResolverStateT e m (a -> b)
r1 <*> ResolverM ResolverStateT e m a
r2 = ResolverStateT e m b -> Resolver MUTATION e m b
forall event (m :: * -> *) value.
ResolverStateT event m value -> Resolver MUTATION event m value
ResolverM (ResolverStateT e m b -> Resolver MUTATION e m b)
-> ResolverStateT e m b -> Resolver MUTATION e m b
forall a b. (a -> b) -> a -> b
$ ResolverStateT e m (a -> b)
r1 ResolverStateT e m (a -> b)
-> ResolverStateT e m a -> ResolverStateT e m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ResolverStateT e m a
r2
ResolverS ResolverStateT () m (SubEventRes e m (a -> b))
r1 <*> ResolverS ResolverStateT () m (SubEventRes e m a)
r2 = ResolverStateT () m (SubEventRes e m b)
-> Resolver SUBSCRIPTION e m b
forall (m :: * -> *) event value.
ResolverStateT () m (SubEventRes event m value)
-> Resolver SUBSCRIPTION event m value
ResolverS (ResolverStateT () m (SubEventRes e m b)
-> Resolver SUBSCRIPTION e m b)
-> ResolverStateT () m (SubEventRes e m b)
-> Resolver SUBSCRIPTION e m b
forall a b. (a -> b) -> a -> b
$ SubEventRes e m (a -> b) -> SubEventRes e m a -> SubEventRes e m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (SubEventRes e m (a -> b)
-> SubEventRes e m a -> SubEventRes e m b)
-> ResolverStateT () m (SubEventRes e m (a -> b))
-> ResolverStateT () m (SubEventRes e m a -> SubEventRes e m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResolverStateT () m (SubEventRes e m (a -> b))
r1 ResolverStateT () m (SubEventRes e m a -> SubEventRes e m b)
-> ResolverStateT () m (SubEventRes e m a)
-> ResolverStateT () m (SubEventRes e m b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ResolverStateT () m (SubEventRes e m a)
r2
instance (Monad m, LiftOperation o) => Monad (Resolver o e m) where
return :: a -> Resolver o e m a
return = a -> Resolver o e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(ResolverQ ResolverStateT () m a
x) >>= :: Resolver o e m a -> (a -> Resolver o e m b) -> Resolver o e m b
>>= a -> Resolver o e m b
m2 = ResolverStateT () m b -> Resolver QUERY e m b
forall (m :: * -> *) value event.
ResolverStateT () m value -> Resolver QUERY event m value
ResolverQ (ResolverStateT () m a
x ResolverStateT () m a
-> (a -> ResolverStateT () m b) -> ResolverStateT () m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Resolver QUERY e m b -> ResolverStateT () m b
forall event (m :: * -> *) value.
Resolver QUERY event m value -> ResolverStateT () m value
runResolverQ (Resolver QUERY e m b -> ResolverStateT () m b)
-> (a -> Resolver QUERY e m b) -> a -> ResolverStateT () m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Resolver o e m b
a -> Resolver QUERY e m b
m2)
(ResolverM ResolverStateT e m a
x) >>= a -> Resolver o e m b
m2 = ResolverStateT e m b -> Resolver MUTATION e m b
forall event (m :: * -> *) value.
ResolverStateT event m value -> Resolver MUTATION event m value
ResolverM (ResolverStateT e m a
x ResolverStateT e m a
-> (a -> ResolverStateT e m b) -> ResolverStateT e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Resolver MUTATION e m b -> ResolverStateT e m b
forall event (m :: * -> *) value.
Resolver MUTATION event m value -> ResolverStateT event m value
runResolverM (Resolver MUTATION e m b -> ResolverStateT e m b)
-> (a -> Resolver MUTATION e m b) -> a -> ResolverStateT e m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Resolver o e m b
a -> Resolver MUTATION e m b
m2)
(ResolverS ResolverStateT () m (SubEventRes e m a)
res) >>= a -> Resolver o e m b
m2 = ResolverStateT () m (SubEventRes e m b)
-> Resolver SUBSCRIPTION e m b
forall (m :: * -> *) event value.
ResolverStateT () m (SubEventRes event m value)
-> Resolver SUBSCRIPTION event m value
ResolverS ((a -> Resolver SUBSCRIPTION e m b)
-> SubEventRes e m a -> SubEventRes e m b
forall (m :: * -> *) t r a.
Monad m =>
(t -> Resolver SUBSCRIPTION r m a)
-> ReaderT r (ResolverStateT () m) t
-> ReaderT r (ResolverStateT () m) a
liftSubResolver a -> Resolver o e m b
a -> Resolver SUBSCRIPTION e m b
m2 (SubEventRes e m a -> SubEventRes e m b)
-> ResolverStateT () m (SubEventRes e m a)
-> ResolverStateT () m (SubEventRes e m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResolverStateT () m (SubEventRes e m a)
res)
liftSubResolver ::
(Monad m) =>
(t -> Resolver SUBSCRIPTION r m a) ->
ReaderT r (ResolverStateT () m) t ->
ReaderT r (ResolverStateT () m) a
liftSubResolver :: (t -> Resolver SUBSCRIPTION r m a)
-> ReaderT r (ResolverStateT () m) t
-> ReaderT r (ResolverStateT () m) a
liftSubResolver t -> Resolver SUBSCRIPTION r m a
m2 ReaderT r (ResolverStateT () m) t
readResA = (r -> ResolverStateT () m a) -> ReaderT r (ResolverStateT () m) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> ResolverStateT () m a) -> ReaderT r (ResolverStateT () m) a)
-> (r -> ResolverStateT () m a)
-> ReaderT r (ResolverStateT () m) a
forall a b. (a -> b) -> a -> b
$ \r
e -> do
t
a <- ReaderT r (ResolverStateT () m) t -> r -> ResolverStateT () m t
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r (ResolverStateT () m) t
readResA r
e
ReaderT r (ResolverStateT () m) a
readResB <- Resolver SUBSCRIPTION r m a
-> ResolverStateT () m (ReaderT r (ResolverStateT () m) a)
forall event (m :: * -> *) value.
Resolver SUBSCRIPTION event m value
-> ResolverStateT () m (SubEventRes event m value)
runResolverS (t -> Resolver SUBSCRIPTION r m a
m2 t
a)
ReaderT r (ResolverStateT () m) a -> r -> ResolverStateT () m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r (ResolverStateT () m) a
readResB r
e
instance (MonadIO m, LiftOperation o) => MonadIO (Resolver o e m) where
liftIO :: IO a -> Resolver o e m a
liftIO = m a -> Resolver o e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Resolver o e m a)
-> (IO a -> m a) -> IO a -> Resolver o e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance (LiftOperation o) => MonadTrans (Resolver o e) where
lift :: m a -> Resolver o e m a
lift = ResolverStateT e m a -> Resolver o e m a
forall (o :: OperationType) (m :: * -> *) e a.
(LiftOperation o, Monad m) =>
ResolverStateT e m a -> Resolver o e m a
packResolver (ResolverStateT e m a -> Resolver o e m a)
-> (m a -> ResolverStateT e m a) -> m a -> Resolver o e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ResolverStateT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance (LiftOperation o, Monad m) => MonadError GQLError (Resolver o e m) where
throwError :: GQLError -> Resolver o e m a
throwError = ResolverStateT e m a -> Resolver o e m a
forall (o :: OperationType) (m :: * -> *) e a.
(LiftOperation o, Monad m) =>
ResolverStateT e m a -> Resolver o e m a
packResolver (ResolverStateT e m a -> Resolver o e m a)
-> (GQLError -> ResolverStateT e m a)
-> GQLError
-> Resolver o e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLError -> ResolverStateT e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: Resolver o e m a
-> (GQLError -> Resolver o e m a) -> Resolver o e m a
catchError (ResolverQ ResolverStateT () m a
r) GQLError -> Resolver o e m a
f = ResolverStateT () m a -> Resolver QUERY e m a
forall (m :: * -> *) value event.
ResolverStateT () m value -> Resolver QUERY event m value
ResolverQ (ResolverStateT () m a -> Resolver QUERY e m a)
-> ResolverStateT () m a -> Resolver QUERY e m a
forall a b. (a -> b) -> a -> b
$ ResolverStateT () m a
-> (GQLError -> ResolverStateT () m a) -> ResolverStateT () m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ResolverStateT () m a
r (Resolver QUERY e m a -> ResolverStateT () m a
forall event (m :: * -> *) value.
Resolver QUERY event m value -> ResolverStateT () m value
runResolverQ (Resolver QUERY e m a -> ResolverStateT () m a)
-> (GQLError -> Resolver QUERY e m a)
-> GQLError
-> ResolverStateT () m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLError -> Resolver o e m a
GQLError -> Resolver QUERY e m a
f)
catchError (ResolverM ResolverStateT e m a
r) GQLError -> Resolver o e m a
f = ResolverStateT e m a -> Resolver MUTATION e m a
forall event (m :: * -> *) value.
ResolverStateT event m value -> Resolver MUTATION event m value
ResolverM (ResolverStateT e m a -> Resolver MUTATION e m a)
-> ResolverStateT e m a -> Resolver MUTATION e m a
forall a b. (a -> b) -> a -> b
$ ResolverStateT e m a
-> (GQLError -> ResolverStateT e m a) -> ResolverStateT e m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ResolverStateT e m a
r (Resolver MUTATION e m a -> ResolverStateT e m a
forall event (m :: * -> *) value.
Resolver MUTATION event m value -> ResolverStateT event m value
runResolverM (Resolver MUTATION e m a -> ResolverStateT e m a)
-> (GQLError -> Resolver MUTATION e m a)
-> GQLError
-> ResolverStateT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLError -> Resolver o e m a
GQLError -> Resolver MUTATION e m a
f)
catchError (ResolverS ResolverStateT () m (SubEventRes e m a)
r) GQLError -> Resolver o e m a
f = ResolverStateT () m (SubEventRes e m a)
-> Resolver SUBSCRIPTION e m a
forall (m :: * -> *) event value.
ResolverStateT () m (SubEventRes event m value)
-> Resolver SUBSCRIPTION event m value
ResolverS (ResolverStateT () m (SubEventRes e m a)
-> Resolver SUBSCRIPTION e m a)
-> ResolverStateT () m (SubEventRes e m a)
-> Resolver SUBSCRIPTION e m a
forall a b. (a -> b) -> a -> b
$ ResolverStateT () m (SubEventRes e m a)
-> (GQLError -> ResolverStateT () m (SubEventRes e m a))
-> ResolverStateT () m (SubEventRes e m a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ResolverStateT () m (SubEventRes e m a)
r (Resolver SUBSCRIPTION e m a
-> ResolverStateT () m (SubEventRes e m a)
forall event (m :: * -> *) value.
Resolver SUBSCRIPTION event m value
-> ResolverStateT () m (SubEventRes event m value)
runResolverS (Resolver SUBSCRIPTION e m a
-> ResolverStateT () m (SubEventRes e m a))
-> (GQLError -> Resolver SUBSCRIPTION e m a)
-> GQLError
-> ResolverStateT () m (SubEventRes e m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLError -> Resolver o e m a
GQLError -> Resolver SUBSCRIPTION e m a
f)
instance (Monad m, LiftOperation o) => MonadFail (Resolver o e m) where
fail :: String -> Resolver o e m a
fail = GQLError -> Resolver o e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> Resolver o e m a)
-> (String -> GQLError) -> String -> Resolver o e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GQLError
forall a. Msg a => a -> GQLError
msg
instance (Monad m) => PushEvents e (Resolver MUTATION e m) where
pushEvents :: [e] -> Resolver MUTATION e m ()
pushEvents = ResolverStateT e m () -> Resolver MUTATION e m ()
forall (o :: OperationType) (m :: * -> *) e a.
(LiftOperation o, Monad m) =>
ResolverStateT e m a -> Resolver o e m a
packResolver (ResolverStateT e m () -> Resolver MUTATION e m ())
-> ([e] -> ResolverStateT e m ())
-> [e]
-> Resolver MUTATION e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> ResolverStateT e m ()
forall e (m :: * -> *). PushEvents e m => [e] -> m ()
pushEvents
instance (Monad m, Semigroup a, LiftOperation o) => Semigroup (Resolver o e m a) where
Resolver o e m a
x <> :: Resolver o e m a -> Resolver o e m a -> Resolver o e m a
<> Resolver o e m a
y = (a -> a -> a) -> Resolver o e m a -> Resolver o e m (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) Resolver o e m a
x Resolver o e m (a -> a) -> Resolver o e m a -> Resolver o e m a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Resolver o e m a
y
instance (LiftOperation o, Monad m) => MonadReader ResolverContext (Resolver o e m) where
ask :: Resolver o e m ResolverContext
ask = ResolverStateT e m ResolverContext
-> Resolver o e m ResolverContext
forall (o :: OperationType) (m :: * -> *) e a.
(LiftOperation o, Monad m) =>
ResolverStateT e m a -> Resolver o e m a
packResolver ResolverStateT e m ResolverContext
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: (ResolverContext -> ResolverContext)
-> Resolver o e m a -> Resolver o e m a
local ResolverContext -> ResolverContext
f (ResolverQ ResolverStateT () m a
res) = ResolverStateT () m a -> Resolver QUERY e m a
forall (m :: * -> *) value event.
ResolverStateT () m value -> Resolver QUERY event m value
ResolverQ ((ResolverContext -> ResolverContext)
-> ResolverStateT () m a -> ResolverStateT () m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ResolverContext -> ResolverContext
f ResolverStateT () m a
res)
local ResolverContext -> ResolverContext
f (ResolverM ResolverStateT e m a
res) = ResolverStateT e m a -> Resolver MUTATION e m a
forall event (m :: * -> *) value.
ResolverStateT event m value -> Resolver MUTATION event m value
ResolverM ((ResolverContext -> ResolverContext)
-> ResolverStateT e m a -> ResolverStateT e m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ResolverContext -> ResolverContext
f ResolverStateT e m a
res)
local ResolverContext -> ResolverContext
f (ResolverS ResolverStateT () m (SubEventRes e m a)
resM) = ResolverStateT () m (SubEventRes e m a)
-> Resolver SUBSCRIPTION e m a
forall (m :: * -> *) event value.
ResolverStateT () m (SubEventRes event m value)
-> Resolver SUBSCRIPTION event m value
ResolverS (ResolverStateT () m (SubEventRes e m a)
-> Resolver SUBSCRIPTION e m a)
-> ResolverStateT () m (SubEventRes e m a)
-> Resolver SUBSCRIPTION e m a
forall a b. (a -> b) -> a -> b
$ (ResolverStateT () m a -> ResolverStateT () m a)
-> SubEventRes e m a -> SubEventRes e m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((ResolverContext -> ResolverContext)
-> ResolverStateT () m a -> ResolverStateT () m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ResolverContext -> ResolverContext
f) (SubEventRes e m a -> SubEventRes e m a)
-> ResolverStateT () m (SubEventRes e m a)
-> ResolverStateT () m (SubEventRes e m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResolverStateT () m (SubEventRes e m a)
resM
unsafeInternalContext :: (Monad m, LiftOperation o) => Resolver o e m ResolverContext
unsafeInternalContext :: Resolver o e m ResolverContext
unsafeInternalContext = Resolver o e m ResolverContext
forall r (m :: * -> *). MonadReader r m => m r
ask
liftResolverState :: (LiftOperation o, Monad m) => ResolverState a -> Resolver o e m a
liftResolverState :: ResolverState a -> Resolver o e m a
liftResolverState = ResolverStateT e m a -> Resolver o e m a
forall (o :: OperationType) (m :: * -> *) e a.
(LiftOperation o, Monad m) =>
ResolverStateT e m a -> Resolver o e m a
packResolver (ResolverStateT e m a -> Resolver o e m a)
-> (ResolverState a -> ResolverStateT e m a)
-> ResolverState a
-> Resolver o e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverState a -> ResolverStateT e m a
forall (m :: * -> *) a e.
Applicative m =>
ResolverState a -> ResolverStateT e m a
toResolverStateT
class LiftOperation (o :: OperationType) where
packResolver :: Monad m => ResolverStateT e m a -> Resolver o e m a
instance LiftOperation QUERY where
packResolver :: ResolverStateT e m a -> Resolver QUERY e m a
packResolver = ResolverStateT () m a -> Resolver QUERY e m a
forall (m :: * -> *) value event.
ResolverStateT () m value -> Resolver QUERY event m value
ResolverQ (ResolverStateT () m a -> Resolver QUERY e m a)
-> (ResolverStateT e m a -> ResolverStateT () m a)
-> ResolverStateT e m a
-> Resolver QUERY e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverStateT e m a -> ResolverStateT () m a
forall (m :: * -> *) e a e'.
Functor m =>
ResolverStateT e m a -> ResolverStateT e' m a
clearStateResolverEvents
instance LiftOperation MUTATION where
packResolver :: ResolverStateT e m a -> Resolver MUTATION e m a
packResolver = ResolverStateT e m a -> Resolver MUTATION e m a
forall event (m :: * -> *) value.
ResolverStateT event m value -> Resolver MUTATION event m value
ResolverM
instance LiftOperation SUBSCRIPTION where
packResolver :: ResolverStateT e m a -> Resolver SUBSCRIPTION e m a
packResolver = ResolverStateT () m (SubEventRes e m a)
-> Resolver SUBSCRIPTION e m a
forall (m :: * -> *) event value.
ResolverStateT () m (SubEventRes event m value)
-> Resolver SUBSCRIPTION event m value
ResolverS (ResolverStateT () m (SubEventRes e m a)
-> Resolver SUBSCRIPTION e m a)
-> (ResolverStateT e m a
-> ResolverStateT () m (SubEventRes e m a))
-> ResolverStateT e m a
-> Resolver SUBSCRIPTION e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubEventRes e m a -> ResolverStateT () m (SubEventRes e m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubEventRes e m a -> ResolverStateT () m (SubEventRes e m a))
-> (ResolverStateT e m a -> SubEventRes e m a)
-> ResolverStateT e m a
-> ResolverStateT () m (SubEventRes e m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverStateT () m a -> SubEventRes e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResolverStateT () m a -> SubEventRes e m a)
-> (ResolverStateT e m a -> ResolverStateT () m a)
-> ResolverStateT e m a
-> SubEventRes e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverStateT e m a -> ResolverStateT () m a
forall (m :: * -> *) e a e'.
Functor m =>
ResolverStateT e m a -> ResolverStateT e' m a
clearStateResolverEvents
subscribe ::
(Monad m) =>
Channel e ->
Resolver QUERY e m (e -> Resolver SUBSCRIPTION e m a) ->
SubscriptionField (Resolver SUBSCRIPTION e m a)
subscribe :: Channel e
-> Resolver QUERY e m (e -> Resolver SUBSCRIPTION e m a)
-> SubscriptionField (Resolver SUBSCRIPTION e m a)
subscribe Channel e
ch Resolver QUERY e m (e -> Resolver SUBSCRIPTION e m a)
res =
(forall e (m :: * -> *) v.
(Resolver SUBSCRIPTION e m a ~ Resolver SUBSCRIPTION e m v) =>
Channel e)
-> Resolver SUBSCRIPTION e m a
-> SubscriptionField (Resolver SUBSCRIPTION e m a)
forall a.
(forall e (m :: * -> *) v.
(a ~ Resolver SUBSCRIPTION e m v) =>
Channel e)
-> a -> SubscriptionField a
SubscriptionField Channel e
forall e (m :: * -> *) v.
(Resolver SUBSCRIPTION e m a ~ Resolver SUBSCRIPTION e m v) =>
Channel e
ch
(Resolver SUBSCRIPTION e m a
-> SubscriptionField (Resolver SUBSCRIPTION e m a))
-> Resolver SUBSCRIPTION e m a
-> SubscriptionField (Resolver SUBSCRIPTION e m a)
forall a b. (a -> b) -> a -> b
$ ResolverStateT () m (SubEventRes e m a)
-> Resolver SUBSCRIPTION e m a
forall (m :: * -> *) event value.
ResolverStateT () m (SubEventRes event m value)
-> Resolver SUBSCRIPTION event m value
ResolverS
(ResolverStateT () m (SubEventRes e m a)
-> Resolver SUBSCRIPTION e m a)
-> ResolverStateT () m (SubEventRes e m a)
-> Resolver SUBSCRIPTION e m a
forall a b. (a -> b) -> a -> b
$ (e -> Resolver SUBSCRIPTION e m a) -> SubEventRes e m a
forall (m :: * -> *) e a.
Monad m =>
(e -> Resolver SUBSCRIPTION e m a)
-> ReaderT e (ResolverStateT () m) a
fromSub ((e -> Resolver SUBSCRIPTION e m a) -> SubEventRes e m a)
-> ResolverStateT () m (e -> Resolver SUBSCRIPTION e m a)
-> ResolverStateT () m (SubEventRes e m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Resolver QUERY e m (e -> Resolver SUBSCRIPTION e m a)
-> ResolverStateT () m (e -> Resolver SUBSCRIPTION e m a)
forall event (m :: * -> *) value.
Resolver QUERY event m value -> ResolverStateT () m value
runResolverQ Resolver QUERY e m (e -> Resolver SUBSCRIPTION e m a)
res
where
fromSub :: Monad m => (e -> Resolver SUBSCRIPTION e m a) -> ReaderT e (ResolverStateT () m) a
fromSub :: (e -> Resolver SUBSCRIPTION e m a)
-> ReaderT e (ResolverStateT () m) a
fromSub e -> Resolver SUBSCRIPTION e m a
f = ReaderT e (ResolverStateT () m) (ReaderT e (ResolverStateT () m) a)
-> ReaderT e (ResolverStateT () m) a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((e -> ResolverStateT () m (ReaderT e (ResolverStateT () m) a))
-> ReaderT
e (ResolverStateT () m) (ReaderT e (ResolverStateT () m) a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (Resolver SUBSCRIPTION e m a
-> ResolverStateT () m (ReaderT e (ResolverStateT () m) a)
forall event (m :: * -> *) value.
Resolver SUBSCRIPTION event m value
-> ResolverStateT () m (SubEventRes event m value)
runResolverS (Resolver SUBSCRIPTION e m a
-> ResolverStateT () m (ReaderT e (ResolverStateT () m) a))
-> (e -> Resolver SUBSCRIPTION e m a)
-> e
-> ResolverStateT () m (ReaderT e (ResolverStateT () m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Resolver SUBSCRIPTION e m a
f))
withArguments ::
(LiftOperation o, Monad m) =>
(Arguments VALID -> Resolver o e m a) ->
Resolver o e m a
withArguments :: (Arguments VALID -> Resolver o e m a) -> Resolver o e m a
withArguments = (Resolver o e m (Arguments VALID)
forall (o :: OperationType) (m :: * -> *) e.
(LiftOperation o, Monad m) =>
Resolver o e m (Arguments VALID)
getArguments Resolver o e m (Arguments VALID)
-> (Arguments VALID -> Resolver o e m a) -> Resolver o e m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
getArguments ::
(LiftOperation o, Monad m) =>
Resolver o e m (Arguments VALID)
getArguments :: Resolver o e m (Arguments VALID)
getArguments = Selection VALID -> Arguments VALID
forall (s :: Stage). Selection s -> Arguments s
selectionArguments (Selection VALID -> Arguments VALID)
-> (ResolverContext -> Selection VALID)
-> ResolverContext
-> Arguments VALID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverContext -> Selection VALID
currentSelection (ResolverContext -> Arguments VALID)
-> Resolver o e m ResolverContext
-> Resolver o e m (Arguments VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Resolver o e m ResolverContext
forall (m :: * -> *) (o :: OperationType) e.
(Monad m, LiftOperation o) =>
Resolver o e m ResolverContext
unsafeInternalContext
getArgument ::
(LiftOperation o, Monad m) =>
FieldName ->
Resolver o e m (Value VALID)
getArgument :: FieldName -> Resolver o e m (Value VALID)
getArgument FieldName
name = Value VALID
-> (Argument VALID -> Value VALID)
-> FieldName
-> Arguments VALID
-> Value VALID
forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr Value VALID
forall (stage :: Stage). Value stage
Null Argument VALID -> Value VALID
forall (valid :: Stage). Argument valid -> Value valid
argumentValue FieldName
name (Arguments VALID -> Value VALID)
-> Resolver o e m (Arguments VALID) -> Resolver o e m (Value VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Resolver o e m (Arguments VALID)
forall (o :: OperationType) (m :: * -> *) e.
(LiftOperation o, Monad m) =>
Resolver o e m (Arguments VALID)
getArguments
runResolver ::
Monad m =>
Maybe (Selection VALID -> ResolverState (Channel event)) ->
Resolver o event m ValidValue ->
ResolverContext ->
ResponseStream event m ValidValue
runResolver :: 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))
_ (ResolverQ ResolverStateT () m (Value VALID)
resT) ResolverContext
sel = ResultT () m (Value VALID) -> ResponseStream event m (Value VALID)
forall (m :: * -> *) e a e'.
Functor m =>
ResultT e m a -> ResultT e' m a
cleanEvents (ResultT () m (Value VALID)
-> ResponseStream event m (Value VALID))
-> ResultT () m (Value VALID)
-> ResponseStream event m (Value VALID)
forall a b. (a -> b) -> a -> b
$ ResolverStateT () m (Value VALID)
-> ResolverContext -> ResultT () m (Value VALID)
forall e (m :: * -> *) a.
ResolverStateT e m a -> ResolverContext -> ResultT e m a
runResolverStateT ResolverStateT () m (Value VALID)
resT ResolverContext
sel
runResolver Maybe (Selection VALID -> ResolverState (Channel event))
_ (ResolverM ResolverStateT event m (Value VALID)
resT) ResolverContext
sel = (event -> ResponseEvent event m)
-> ResultT event m (Value VALID)
-> ResponseStream event m (Value VALID)
forall (m :: * -> *) e e' value.
Monad m =>
(e -> e') -> ResultT e m value -> ResultT e' m value
mapEvent event -> ResponseEvent event m
forall event (m :: * -> *). event -> ResponseEvent event m
Publish (ResultT event m (Value VALID)
-> ResponseStream event m (Value VALID))
-> ResultT event m (Value VALID)
-> ResponseStream event m (Value VALID)
forall a b. (a -> b) -> a -> b
$ ResolverStateT event m (Value VALID)
-> ResolverContext -> ResultT event m (Value VALID)
forall e (m :: * -> *) a.
ResolverStateT e m a -> ResolverContext -> ResultT e m a
runResolverStateT ResolverStateT event m (Value VALID)
resT ResolverContext
sel
runResolver Maybe (Selection VALID -> ResolverState (Channel event))
toChannel (ResolverS ResolverStateT () m (SubEventRes event m (Value VALID))
resT) ResolverContext
ctx = m (Result GQLError ([ResponseEvent event m], Value VALID))
-> ResponseStream event m (Value VALID)
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([ResponseEvent event m], Value VALID))
-> ResponseStream event m (Value VALID))
-> m (Result GQLError ([ResponseEvent event m], Value VALID))
-> ResponseStream event m (Value VALID)
forall a b. (a -> b) -> a -> b
$ do
Result GQLError (SubEventRes event m (Value VALID))
readResValue <- ResolverStateT () m (SubEventRes event m (Value VALID))
-> ResolverContext
-> m (Result GQLError (SubEventRes event m (Value VALID)))
forall (m :: * -> *) e a.
Functor m =>
ResolverStateT e m a -> ResolverContext -> m (Result GQLError a)
runResolverStateValueM ResolverStateT () m (SubEventRes event m (Value VALID))
resT ResolverContext
ctx
Result GQLError ([ResponseEvent event m], Value VALID)
-> m (Result GQLError ([ResponseEvent event m], Value VALID))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result GQLError ([ResponseEvent event m], Value VALID)
-> m (Result GQLError ([ResponseEvent event m], Value VALID)))
-> Result GQLError ([ResponseEvent event m], Value VALID)
-> m (Result GQLError ([ResponseEvent event m], Value VALID))
forall a b. (a -> b) -> a -> b
$ case Result GQLError (SubEventRes event m (Value VALID))
readResValue Result GQLError (SubEventRes event m (Value VALID))
-> (SubEventRes event m (Value VALID)
-> Result GQLError (ResponseEvent event m))
-> Result GQLError (ResponseEvent event m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ResolverContext
-> Maybe (Selection VALID -> ResolverState (Channel event))
-> (event -> m GQLResponse)
-> Result GQLError (ResponseEvent event m)
forall e (m :: * -> *).
ResolverContext
-> Maybe (Selection VALID -> ResolverState (Channel e))
-> (e -> m GQLResponse)
-> GQLResult (ResponseEvent e m)
subscriptionEvents ResolverContext
ctx Maybe (Selection VALID -> ResolverState (Channel event))
toChannel ((event -> m GQLResponse)
-> Result GQLError (ResponseEvent event m))
-> (SubEventRes event m (Value VALID) -> event -> m GQLResponse)
-> SubEventRes event m (Value VALID)
-> Result GQLError (ResponseEvent event m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverContext
-> SubEventRes event m (Value VALID) -> event -> m GQLResponse
forall (m :: * -> *) event.
Monad m =>
ResolverContext
-> SubEventRes event m (Value VALID) -> event -> m GQLResponse
toEventResolver ResolverContext
ctx of
Failure NonEmpty GQLError
x -> NonEmpty GQLError
-> Result GQLError ([ResponseEvent event m], Value VALID)
forall err a. NonEmpty err -> Result err a
Failure NonEmpty GQLError
x
Success {[GQLError]
warnings :: forall err a. Result err a -> [err]
warnings :: [GQLError]
warnings, ResponseEvent event m
result :: forall err a. Result err a -> a
result :: ResponseEvent event m
result} ->
Success :: forall err a. a -> [err] -> Result err a
Success
{ [GQLError]
warnings :: [GQLError]
warnings :: [GQLError]
warnings,
result :: ([ResponseEvent event m], Value VALID)
result = ([ResponseEvent event m
result], Value VALID
forall (stage :: Stage). Value stage
Null)
}
toEventResolver :: Monad m => ResolverContext -> SubEventRes event m ValidValue -> (event -> m GQLResponse)
toEventResolver :: ResolverContext
-> SubEventRes event m (Value VALID) -> event -> m GQLResponse
toEventResolver ResolverContext
sel (ReaderT event -> ResolverStateT () m (Value VALID)
subRes) event
event = Result GQLError (Value VALID) -> GQLResponse
renderResponse (Result GQLError (Value VALID) -> GQLResponse)
-> m (Result GQLError (Value VALID)) -> m GQLResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResolverStateT () m (Value VALID)
-> ResolverContext -> m (Result GQLError (Value VALID))
forall (m :: * -> *) e a.
Functor m =>
ResolverStateT e m a -> ResolverContext -> m (Result GQLError a)
runResolverStateValueM (event -> ResolverStateT () m (Value VALID)
subRes event
event) ResolverContext
sel
subscriptionEvents ::
ResolverContext ->
Maybe (Selection VALID -> ResolverState (Channel e)) ->
(e -> m GQLResponse) ->
GQLResult (ResponseEvent e m)
subscriptionEvents :: ResolverContext
-> Maybe (Selection VALID -> ResolverState (Channel e))
-> (e -> m GQLResponse)
-> GQLResult (ResponseEvent e m)
subscriptionEvents ctx :: ResolverContext
ctx@ResolverContext {Selection VALID
currentSelection :: Selection VALID
currentSelection :: ResolverContext -> Selection VALID
currentSelection} (Just Selection VALID -> ResolverState (Channel e)
channelGenerator) e -> m GQLResponse
res =
ResolverState (ResponseEvent e m)
-> ResolverContext -> GQLResult (ResponseEvent e m)
forall a. ResolverState a -> ResolverContext -> GQLResult a
runResolverState ResolverState (ResponseEvent e m)
handle ResolverContext
ctx
where
handle :: ResolverState (ResponseEvent e m)
handle = do
Channel e
channel <- Selection VALID -> ResolverState (Channel e)
channelGenerator Selection VALID
currentSelection
ResponseEvent e m -> ResolverState (ResponseEvent e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResponseEvent e m -> ResolverState (ResponseEvent e m))
-> ResponseEvent e m -> ResolverState (ResponseEvent e m)
forall a b. (a -> b) -> a -> b
$ Channel e -> (e -> m GQLResponse) -> ResponseEvent e m
forall event (m :: * -> *).
Channel event -> (event -> m GQLResponse) -> ResponseEvent event m
Subscribe Channel e
channel e -> m GQLResponse
res
subscriptionEvents ResolverContext
ctx Maybe (Selection VALID -> ResolverState (Channel e))
Nothing e -> m GQLResponse
_ = GQLError -> GQLResult (ResponseEvent e m)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLResult (ResponseEvent e m))
-> GQLError -> GQLResult (ResponseEvent e m)
forall a b. (a -> b) -> a -> b
$ ResolverContext -> GQLError -> GQLError
resolverFailureMessage ResolverContext
ctx GQLError
"channel Resolver is not defined"