{-# 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,
    ResponseEvent (..),
    ResponseStream,
    WithOperation,
    SubscriptionField (..),
  )
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.MonadResolver
  ( MonadIOResolver,
    MonadResolver (..),
    SubscriptionField (..),
  )
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.Types.IO
  ( GQLResponse,
    renderResponse,
  )
import Data.Morpheus.Types.Internal.AST
  ( 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

-- GraphQL resolver
---------------------------------------------------------------
data Resolver (o :: OperationType) event (m :: Type -> Type) value where
  ResolverQ :: {forall (m :: * -> *) value event.
Resolver 'OPERATION_QUERY event m value
-> ResolverStateT () m value
runResolverQ :: ResolverStateT () m value} -> Resolver QUERY event m value
  ResolverM :: {forall event (m :: * -> *) value.
Resolver 'OPERATION_MUTATION event m value
-> ResolverStateT event m value
runResolverM :: ResolverStateT event m value} -> Resolver MUTATION event m value
  ResolverS :: {forall (m :: * -> *) event value.
Resolver 'OPERATION_SUBSCRIPTION event m value
-> ResolverStateT () m (SubEventRes event m value)
runResolverS :: ResolverStateT () m (SubEventRes event m value)} -> Resolver SUBSCRIPTION event m value

instance (LiftOperation o, Monad m, MonadIO m) => MonadIOResolver (Resolver o e m)

instance (LiftOperation o, Monad m) => MonadResolver (Resolver o e m) where
  type MonadOperation (Resolver o e m) = o
  type MonadEvent (Resolver o e m) = e
  type MonadQuery (Resolver o e m) = (Resolver QUERY e m)
  type MonadMutation (Resolver o e m) = (Resolver MUTATION e m)
  type MonadSubscription (Resolver o e m) = (Resolver SUBSCRIPTION e m)
  type MonadParam (Resolver o e m) = m
  getArguments :: Resolver o e m (Arguments VALID)
getArguments = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (s :: Stage). Selection s -> Arguments s
selectionArguments forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverContext -> Selection VALID
currentSelection)
  liftState :: forall a. ResolverState a -> Resolver o e m a
liftState = forall (o :: OperationType) (m :: * -> *) e a.
(LiftOperation o, Monad m) =>
ResolverStateT e m a -> Resolver o e m a
packResolver forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a e.
Applicative m =>
ResolverState a -> ResolverStateT e m a
toResolverStateT
  subscribe :: forall a.
(MonadOperation (Resolver o e m) ~ 'OPERATION_SUBSCRIPTION) =>
Channel (MonadEvent (Resolver o e m))
-> MonadQuery
     (Resolver o e m) (MonadEvent (Resolver o e m) -> Resolver o e m a)
-> SubscriptionField (Resolver o e m a)
subscribe Channel (MonadEvent (Resolver o e m))
ch MonadQuery
  (Resolver o e m) (MonadEvent (Resolver o e m) -> Resolver o e m a)
res = forall a.
(forall (m :: * -> *) v.
 (a ~ m v, MonadResolver m,
  MonadOperation m ~ 'OPERATION_SUBSCRIPTION) =>
 Channel (MonadEvent m))
-> a -> SubscriptionField a
SubscriptionField Channel (MonadEvent (Resolver o e m))
ch (forall (m :: * -> *) event value.
ResolverStateT () m (SubEventRes event m value)
-> Resolver 'OPERATION_SUBSCRIPTION event m value
ResolverS (forall {m :: * -> *} {r} {a}.
Monad m =>
(r -> Resolver 'OPERATION_SUBSCRIPTION r m a)
-> ReaderT r (ResolverStateT () m) a
runSubscription forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) value event.
Resolver 'OPERATION_QUERY event m value
-> ResolverStateT () m value
runResolverQ MonadQuery
  (Resolver o e m) (MonadEvent (Resolver o e m) -> Resolver o e m a)
res))
    where
      runSubscription :: (r -> Resolver 'OPERATION_SUBSCRIPTION r m a)
-> ReaderT r (ResolverStateT () m) a
runSubscription r -> Resolver 'OPERATION_SUBSCRIPTION r m a
f = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (forall (m :: * -> *) event value.
Resolver 'OPERATION_SUBSCRIPTION event m value
-> ResolverStateT () m (SubEventRes event m value)
runResolverS forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Resolver 'OPERATION_SUBSCRIPTION r m a
f))
  publish :: (MonadOperation (Resolver o e m) ~ 'OPERATION_MUTATION) =>
[MonadEvent (Resolver o e m)] -> Resolver o e m ()
publish = forall e (m :: * -> *). PushEvents e m => [e] -> m ()
pushEvents
  runResolver :: Maybe
  (Selection VALID
   -> ResolverState (Channel (MonadEvent (Resolver o e m))))
-> Resolver o e m ValidValue
-> ResolverContext
-> ResponseStream
     (MonadEvent (Resolver o e m))
     (MonadParam (Resolver o e m))
     ValidValue
runResolver Maybe
  (Selection VALID
   -> ResolverState (Channel (MonadEvent (Resolver o e m))))
_ (ResolverQ ResolverStateT () m ValidValue
resT) ResolverContext
sel = forall (m :: * -> *) e a e'.
Functor m =>
ResultT e m a -> ResultT e' m a
cleanEvents forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
ResolverStateT e m a -> ResolverContext -> ResultT e m a
runResolverStateT ResolverStateT () m ValidValue
resT ResolverContext
sel
  runResolver Maybe
  (Selection VALID
   -> ResolverState (Channel (MonadEvent (Resolver o e m))))
_ (ResolverM ResolverStateT e m ValidValue
resT) ResolverContext
sel = forall (m :: * -> *) e e' value.
Monad m =>
(e -> e') -> ResultT e m value -> ResultT e' m value
mapEvent forall event (m :: * -> *). event -> ResponseEvent event m
Publish forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
ResolverStateT e m a -> ResolverContext -> ResultT e m a
runResolverStateT ResolverStateT e m ValidValue
resT ResolverContext
sel
  runResolver Maybe
  (Selection VALID
   -> ResolverState (Channel (MonadEvent (Resolver o e m))))
toChannel (ResolverS ResolverStateT () m (SubEventRes e m ValidValue)
resT) ResolverContext
ctx = forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT forall a b. (a -> b) -> a -> b
$ do
    Result GQLError (SubEventRes e m ValidValue)
readResValue <- forall (m :: * -> *) e a.
Functor m =>
ResolverStateT e m a -> ResolverContext -> m (Result GQLError a)
runResolverStateValueM ResolverStateT () m (SubEventRes e m ValidValue)
resT ResolverContext
ctx
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Result GQLError (SubEventRes e m ValidValue)
readResValue forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 (MonadEvent (Resolver o e m))))
toChannel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) event.
Monad m =>
ResolverContext
-> SubEventRes event m ValidValue -> event -> m GQLResponse
toEventResolver ResolverContext
ctx of
      Failure NonEmpty GQLError
x -> 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 e m
result :: forall err a. Result err a -> a
result :: ResponseEvent e m
result} -> Success {[GQLError]
warnings :: [GQLError]
warnings :: [GQLError]
warnings, result :: ([ResponseEvent e m], ValidValue)
result = ([ResponseEvent e m
result], forall (stage :: Stage). Value stage
Null)}

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)

-- Applicative
instance (LiftOperation o, Monad m) => Applicative (Resolver o e m) where
  pure :: forall a. a -> Resolver o e m a
pure = forall (o :: OperationType) (m :: * -> *) e a.
(LiftOperation o, Monad m) =>
ResolverStateT e m a -> Resolver o e m a
packResolver forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ResolverQ ResolverStateT () m (a -> b)
r1 <*> :: forall a b.
Resolver o e m (a -> b) -> Resolver o e m a -> Resolver o e m b
<*> ResolverQ ResolverStateT () m a
r2 = forall (m :: * -> *) value event.
ResolverStateT () m value
-> Resolver 'OPERATION_QUERY event m value
ResolverQ forall a b. (a -> b) -> a -> b
$ ResolverStateT () m (a -> b)
r1 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 = forall event (m :: * -> *) value.
ResolverStateT event m value
-> Resolver 'OPERATION_MUTATION event m value
ResolverM forall a b. (a -> b) -> a -> b
$ ResolverStateT e m (a -> b)
r1 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 = forall (m :: * -> *) event value.
ResolverStateT () m (SubEventRes event m value)
-> Resolver 'OPERATION_SUBSCRIPTION event m value
ResolverS forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResolverStateT () m (SubEventRes e m (a -> b))
r1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ResolverStateT () m (SubEventRes e m a)
r2

-- Monad
instance (Monad m, LiftOperation o) => Monad (Resolver o e m) where
  return :: forall a. a -> Resolver o e m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  (ResolverQ ResolverStateT () m a
x) >>= :: forall a b.
Resolver o e m a -> (a -> Resolver o e m b) -> Resolver o e m b
>>= a -> Resolver o e m b
m2 = forall (m :: * -> *) value event.
ResolverStateT () m value
-> Resolver 'OPERATION_QUERY event m value
ResolverQ (ResolverStateT () m a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) value event.
Resolver 'OPERATION_QUERY event m value
-> ResolverStateT () m value
runResolverQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Resolver o e m b
m2)
  (ResolverM ResolverStateT e m a
x) >>= a -> Resolver o e m b
m2 = forall event (m :: * -> *) value.
ResolverStateT event m value
-> Resolver 'OPERATION_MUTATION event m value
ResolverM (ResolverStateT e m a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall event (m :: * -> *) value.
Resolver 'OPERATION_MUTATION event m value
-> ResolverStateT event m value
runResolverM forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Resolver o e m b
m2)
  (ResolverS ResolverStateT () m (SubEventRes e m a)
res) >>= a -> Resolver o e m b
m2 = forall (m :: * -> *) event value.
ResolverStateT () m (SubEventRes event m value)
-> Resolver 'OPERATION_SUBSCRIPTION event m value
ResolverS (forall (m :: * -> *) t r a.
Monad m =>
(t -> Resolver 'OPERATION_SUBSCRIPTION r m a)
-> ReaderT r (ResolverStateT () m) t
-> ReaderT r (ResolverStateT () m) a
liftSubResolver a -> Resolver o e m b
m2 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 :: forall (m :: * -> *) t r a.
Monad m =>
(t -> Resolver 'OPERATION_SUBSCRIPTION r m a)
-> ReaderT r (ResolverStateT () m) t
-> ReaderT r (ResolverStateT () m) a
liftSubResolver t -> Resolver 'OPERATION_SUBSCRIPTION r m a
m2 ReaderT r (ResolverStateT () m) t
readResA = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
e -> do
  t
a <- 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 <- forall (m :: * -> *) event value.
Resolver 'OPERATION_SUBSCRIPTION event m value
-> ResolverStateT () m (SubEventRes event m value)
runResolverS (t -> Resolver 'OPERATION_SUBSCRIPTION r m a
m2 t
a)
  forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r (ResolverStateT () m) a
readResB r
e

-- MonadIO
instance (MonadIO m, LiftOperation o) => MonadIO (Resolver o e m) where
  liftIO :: forall a. IO a -> Resolver o e m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- Monad Transformers
instance (LiftOperation o) => MonadTrans (Resolver o e) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> Resolver o e m a
lift = forall (o :: OperationType) (m :: * -> *) e a.
(LiftOperation o, Monad m) =>
ResolverStateT e m a -> Resolver o e m a
packResolver forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- Failure
instance (LiftOperation o, Monad m) => MonadError GQLError (Resolver o e m) where
  throwError :: forall a. GQLError -> Resolver o e m a
throwError = forall (o :: OperationType) (m :: * -> *) e a.
(LiftOperation o, Monad m) =>
ResolverStateT e m a -> Resolver o e m a
packResolver forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a.
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 = forall (m :: * -> *) value event.
ResolverStateT () m value
-> Resolver 'OPERATION_QUERY event m value
ResolverQ forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ResolverStateT () m a
r (forall (m :: * -> *) value event.
Resolver 'OPERATION_QUERY event m value
-> ResolverStateT () m value
runResolverQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLError -> Resolver o e m a
f)
  catchError (ResolverM ResolverStateT e m a
r) GQLError -> Resolver o e m a
f = forall event (m :: * -> *) value.
ResolverStateT event m value
-> Resolver 'OPERATION_MUTATION event m value
ResolverM forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ResolverStateT e m a
r (forall event (m :: * -> *) value.
Resolver 'OPERATION_MUTATION event m value
-> ResolverStateT event m value
runResolverM forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLError -> Resolver o e m a
f)
  catchError (ResolverS ResolverStateT () m (SubEventRes e m a)
r) GQLError -> Resolver o e m a
f = forall (m :: * -> *) event value.
ResolverStateT () m (SubEventRes event m value)
-> Resolver 'OPERATION_SUBSCRIPTION event m value
ResolverS forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ResolverStateT () m (SubEventRes e m a)
r (forall (m :: * -> *) event value.
Resolver 'OPERATION_SUBSCRIPTION event m value
-> ResolverStateT () m (SubEventRes event m value)
runResolverS forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLError -> Resolver o e m a
f)

instance (Monad m, LiftOperation o) => MonadFail (Resolver o e m) where
  fail :: forall a. String -> Resolver o e m a
fail = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Msg a => a -> GQLError
msg

-- PushEvents
instance (Monad m) => PushEvents e (Resolver MUTATION e m) where
  pushEvents :: [e] -> Resolver 'OPERATION_MUTATION e m ()
pushEvents = forall (o :: OperationType) (m :: * -> *) e a.
(LiftOperation o, Monad m) =>
ResolverStateT e m a -> Resolver o e m a
packResolver forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Semigroup a => a -> a -> a
(<>) Resolver o e m a
x 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 = forall (o :: OperationType) (m :: * -> *) e a.
(LiftOperation o, Monad m) =>
ResolverStateT e m a -> Resolver o e m a
packResolver forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a.
(ResolverContext -> ResolverContext)
-> Resolver o e m a -> Resolver o e m a
local ResolverContext -> ResolverContext
f (ResolverQ ResolverStateT () m a
res) = forall (m :: * -> *) value event.
ResolverStateT () m value
-> Resolver 'OPERATION_QUERY event m value
ResolverQ (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) = forall event (m :: * -> *) value.
ResolverStateT event m value
-> Resolver 'OPERATION_MUTATION event m value
ResolverM (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) = forall (m :: * -> *) event value.
ResolverStateT () m (SubEventRes event m value)
-> Resolver 'OPERATION_SUBSCRIPTION event m value
ResolverS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ResolverContext -> ResolverContext
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResolverStateT () m (SubEventRes e m a)
resM

class LiftOperation (o :: OperationType) where
  packResolver :: Monad m => ResolverStateT e m a -> Resolver o e m a

instance LiftOperation QUERY where
  packResolver :: forall (m :: * -> *) e a.
Monad m =>
ResolverStateT e m a -> Resolver 'OPERATION_QUERY e m a
packResolver = forall (m :: * -> *) value event.
ResolverStateT () m value
-> Resolver 'OPERATION_QUERY event m value
ResolverQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a e'.
Functor m =>
ResolverStateT e m a -> ResolverStateT e' m a
clearStateResolverEvents

instance LiftOperation MUTATION where
  packResolver :: forall (m :: * -> *) e a.
Monad m =>
ResolverStateT e m a -> Resolver 'OPERATION_MUTATION e m a
packResolver = forall event (m :: * -> *) value.
ResolverStateT event m value
-> Resolver 'OPERATION_MUTATION event m value
ResolverM

instance LiftOperation SUBSCRIPTION where
  packResolver :: forall (m :: * -> *) e a.
Monad m =>
ResolverStateT e m a -> Resolver 'OPERATION_SUBSCRIPTION e m a
packResolver = forall (m :: * -> *) event value.
ResolverStateT () m (SubEventRes event m value)
-> Resolver 'OPERATION_SUBSCRIPTION event m value
ResolverS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a e'.
Functor m =>
ResolverStateT e m a -> ResolverStateT e' m a
clearStateResolverEvents

toEventResolver :: Monad m => ResolverContext -> SubEventRes event m ValidValue -> (event -> m GQLResponse)
toEventResolver :: forall (m :: * -> *) event.
Monad m =>
ResolverContext
-> SubEventRes event m ValidValue -> event -> m GQLResponse
toEventResolver ResolverContext
sel (ReaderT event -> ResolverStateT () m ValidValue
subRes) event
event = Result GQLError ValidValue -> GQLResponse
renderResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) e a.
Functor m =>
ResolverStateT e m a -> ResolverContext -> m (Result GQLError a)
runResolverStateValueM (event -> ResolverStateT () m ValidValue
subRes event
event) ResolverContext
sel

subscriptionEvents ::
  ResolverContext ->
  Maybe (Selection VALID -> ResolverState (Channel e)) ->
  (e -> m GQLResponse) ->
  GQLResult (ResponseEvent e m)
subscriptionEvents :: forall e (m :: * -> *).
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 =
  forall a. ResolverState a -> ResolverContext -> GQLResult a
runResolverState ResolverStateT () Identity (ResponseEvent e m)
handle ResolverContext
ctx
  where
    handle :: ResolverStateT () Identity (ResponseEvent e m)
handle = do
      Channel e
channel <- Selection VALID -> ResolverState (Channel e)
channelGenerator Selection VALID
currentSelection
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ ResolverContext -> GQLError -> GQLError
resolverFailureMessage ResolverContext
ctx GQLError
"channel Resolver is not defined"