{-# 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 TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.App.Internal.Resolving.ResolverState
( ResolverContext (..),
ResolverStateT (..),
resolverFailureMessage,
clearStateResolverEvents,
ResolverState,
toResolverStateT,
runResolverStateT,
runResolverStateM,
runResolverState,
runResolverStateValueM,
updateCurrentType,
askFieldTypeName,
)
where
import Control.Monad.Except (MonadError (..))
import Control.Monad.Trans.Reader (mapReaderT)
import Data.Morpheus.Core
( Config (..),
RenderGQL,
render,
)
import Data.Morpheus.Internal.Ext
( GQLResult,
PushEvents (..),
Result,
ResultT (..),
cleanEvents,
)
import Data.Morpheus.Internal.Utils (selectOr)
import Data.Morpheus.Types.Internal.AST
( ANY,
FieldDefinition (fieldType),
FieldName,
GQLError,
Operation,
Schema,
Selection (..),
TypeContent (..),
TypeDefinition (..),
TypeName,
TypeRef (typeConName),
VALID,
at,
internal,
isInternal,
lookupDataType,
msg,
)
import Relude
data ResolverContext = ResolverContext
{ ResolverContext -> Selection VALID
currentSelection :: Selection VALID,
ResolverContext -> Schema VALID
schema :: Schema VALID,
ResolverContext -> Operation VALID
operation :: Operation VALID,
ResolverContext -> Config
config :: Config,
ResolverContext -> TypeDefinition ANY VALID
currentType :: TypeDefinition ANY VALID
}
deriving (Int -> ResolverContext -> ShowS
[ResolverContext] -> ShowS
ResolverContext -> String
(Int -> ResolverContext -> ShowS)
-> (ResolverContext -> String)
-> ([ResolverContext] -> ShowS)
-> Show ResolverContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolverContext] -> ShowS
$cshowList :: [ResolverContext] -> ShowS
show :: ResolverContext -> String
$cshow :: ResolverContext -> String
showsPrec :: Int -> ResolverContext -> ShowS
$cshowsPrec :: Int -> ResolverContext -> ShowS
Show)
updateCurrentType ::
( MonadReader ResolverContext m,
MonadError GQLError m
) =>
Maybe TypeName ->
m a ->
m a
updateCurrentType :: Maybe TypeName -> m a -> m a
updateCurrentType = (m a -> m a)
-> (TypeName -> m a -> m a) -> Maybe TypeName -> m a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a -> m a
forall a. a -> a
id TypeName -> m a -> m a
forall (m :: * -> *) a.
(MonadReader ResolverContext m, MonadError GQLError m) =>
TypeName -> m a -> m a
setCurrentType
setCurrentType ::
( MonadReader ResolverContext m,
MonadError GQLError m
) =>
TypeName ->
m a ->
m a
setCurrentType :: TypeName -> m a -> m a
setCurrentType TypeName
name m a
ma = do
Maybe (TypeDefinition ANY VALID)
t <- (ResolverContext -> Maybe (TypeDefinition ANY VALID))
-> m (Maybe (TypeDefinition ANY VALID))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (TypeName -> Schema VALID -> Maybe (TypeDefinition ANY VALID)
forall (s :: Stage).
TypeName -> Schema s -> Maybe (TypeDefinition ANY s)
lookupDataType TypeName
name (Schema VALID -> Maybe (TypeDefinition ANY VALID))
-> (ResolverContext -> Schema VALID)
-> ResolverContext
-> Maybe (TypeDefinition ANY VALID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverContext -> Schema VALID
schema)
(m a -> m a)
-> (TypeDefinition ANY VALID -> m a -> m a)
-> Maybe (TypeDefinition ANY VALID)
-> m a
-> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(m a -> m a -> m a
forall a b. a -> b -> a
const (m a -> m a -> m a) -> m a -> m a -> m a
forall a b. (a -> b) -> a -> b
$ GQLError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> m a) -> GQLError -> m a
forall a b. (a -> b) -> a -> b
$ GQLError -> GQLError
internal GQLError
"Unknown type \"" GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> TypeName -> GQLError
forall a. Msg a => a -> GQLError
msg TypeName
name GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
"\".")
(\TypeDefinition ANY VALID
currentType -> (ResolverContext -> ResolverContext) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ResolverContext
ctx -> ResolverContext
ctx {TypeDefinition ANY VALID
currentType :: TypeDefinition ANY VALID
currentType :: TypeDefinition ANY VALID
currentType}))
Maybe (TypeDefinition ANY VALID)
t
m a
ma
fieldTypeName :: FieldName -> TypeDefinition ANY VALID -> Maybe TypeName
fieldTypeName :: FieldName -> TypeDefinition ANY VALID -> Maybe TypeName
fieldTypeName FieldName
name TypeDefinition ANY VALID
t = case TypeDefinition ANY VALID -> TypeContent TRUE ANY VALID
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent TypeDefinition ANY VALID
t of
(DataObject [TypeName]
_ FieldsDefinition OUT VALID
fs) -> Maybe TypeName
-> (FieldDefinition OUT VALID -> Maybe TypeName)
-> FieldName
-> FieldsDefinition OUT VALID
-> Maybe TypeName
forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr Maybe TypeName
forall a. Maybe a
Nothing (TypeName -> Maybe TypeName
forall a. a -> Maybe a
Just (TypeName -> Maybe TypeName)
-> (FieldDefinition OUT VALID -> TypeName)
-> FieldDefinition OUT VALID
-> Maybe TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> TypeName
typeConName (TypeRef -> TypeName)
-> (FieldDefinition OUT VALID -> TypeRef)
-> FieldDefinition OUT VALID
-> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDefinition OUT VALID -> TypeRef
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType) FieldName
name FieldsDefinition OUT VALID
fs
(DataInterface FieldsDefinition OUT VALID
fs) -> Maybe TypeName
-> (FieldDefinition OUT VALID -> Maybe TypeName)
-> FieldName
-> FieldsDefinition OUT VALID
-> Maybe TypeName
forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr Maybe TypeName
forall a. Maybe a
Nothing (TypeName -> Maybe TypeName
forall a. a -> Maybe a
Just (TypeName -> Maybe TypeName)
-> (FieldDefinition OUT VALID -> TypeName)
-> FieldDefinition OUT VALID
-> Maybe TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> TypeName
typeConName (TypeRef -> TypeName)
-> (FieldDefinition OUT VALID -> TypeRef)
-> FieldDefinition OUT VALID
-> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDefinition OUT VALID -> TypeRef
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType) FieldName
name FieldsDefinition OUT VALID
fs
TypeContent TRUE ANY VALID
_ -> Maybe TypeName
forall a. Maybe a
Nothing
askFieldTypeName :: MonadReader ResolverContext m => FieldName -> m (Maybe TypeName)
askFieldTypeName :: FieldName -> m (Maybe TypeName)
askFieldTypeName FieldName
name = (ResolverContext -> Maybe TypeName) -> m (Maybe TypeName)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (FieldName -> TypeDefinition ANY VALID -> Maybe TypeName
fieldTypeName FieldName
name (TypeDefinition ANY VALID -> Maybe TypeName)
-> (ResolverContext -> TypeDefinition ANY VALID)
-> ResolverContext
-> Maybe TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverContext -> TypeDefinition ANY VALID
currentType)
type ResolverState = ResolverStateT () Identity
runResolverStateT :: ResolverStateT e m a -> ResolverContext -> ResultT e m a
runResolverStateT :: ResolverStateT e m a -> ResolverContext -> ResultT e m a
runResolverStateT = ReaderT ResolverContext (ResultT e m) a
-> ResolverContext -> ResultT e m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT ResolverContext (ResultT e m) a
-> ResolverContext -> ResultT e m a)
-> (ResolverStateT e m a
-> ReaderT ResolverContext (ResultT e m) a)
-> ResolverStateT e m a
-> ResolverContext
-> ResultT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverStateT e m a -> ReaderT ResolverContext (ResultT e m) a
forall event (m :: * -> *) a.
ResolverStateT event m a
-> ReaderT ResolverContext (ResultT event m) a
_runResolverStateT
runResolverStateM :: ResolverStateT e m a -> ResolverContext -> m (Result GQLError ([e], a))
runResolverStateM :: ResolverStateT e m a
-> ResolverContext -> m (Result GQLError ([e], a))
runResolverStateM ResolverStateT e m a
res = ResultT e m a -> m (Result GQLError ([e], a))
forall event (m :: * -> *) a.
ResultT event m a -> m (Result GQLError ([event], a))
runResultT (ResultT e m a -> m (Result GQLError ([e], a)))
-> (ResolverContext -> ResultT e m a)
-> ResolverContext
-> m (Result GQLError ([e], a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverStateT e m a -> ResolverContext -> ResultT e m a
forall e (m :: * -> *) a.
ResolverStateT e m a -> ResolverContext -> ResultT e m a
runResolverStateT ResolverStateT e m a
res
runResolverStateValueM :: Functor m => ResolverStateT e m a -> ResolverContext -> m (Result GQLError a)
runResolverStateValueM :: ResolverStateT e m a -> ResolverContext -> m (Result GQLError a)
runResolverStateValueM ResolverStateT e m a
res = (Result GQLError ([e], a) -> Result GQLError a)
-> m (Result GQLError ([e], a)) -> m (Result GQLError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([e], a) -> a) -> Result GQLError ([e], a) -> Result GQLError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([e], a) -> a
forall a b. (a, b) -> b
snd) (m (Result GQLError ([e], a)) -> m (Result GQLError a))
-> (ResolverContext -> m (Result GQLError ([e], a)))
-> ResolverContext
-> m (Result GQLError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverStateT e m a
-> ResolverContext -> m (Result GQLError ([e], a))
forall e (m :: * -> *) a.
ResolverStateT e m a
-> ResolverContext -> m (Result GQLError ([e], a))
runResolverStateM ResolverStateT e m a
res
runResolverState :: ResolverState a -> ResolverContext -> GQLResult a
runResolverState :: ResolverState a -> ResolverContext -> GQLResult a
runResolverState ResolverState a
res = (([()], a) -> a) -> Result GQLError ([()], a) -> GQLResult a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([()], a) -> a
forall a b. (a, b) -> b
snd (Result GQLError ([()], a) -> GQLResult a)
-> (ResolverContext -> Result GQLError ([()], a))
-> ResolverContext
-> GQLResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Result GQLError ([()], a)) -> Result GQLError ([()], a)
forall a. Identity a -> a
runIdentity (Identity (Result GQLError ([()], a)) -> Result GQLError ([()], a))
-> (ResolverContext -> Identity (Result GQLError ([()], a)))
-> ResolverContext
-> Result GQLError ([()], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverState a
-> ResolverContext -> Identity (Result GQLError ([()], a))
forall e (m :: * -> *) a.
ResolverStateT e m a
-> ResolverContext -> m (Result GQLError ([e], a))
runResolverStateM ResolverState a
res
newtype ResolverStateT event m a = ResolverStateT
{ ResolverStateT event m a
-> ReaderT ResolverContext (ResultT event m) a
_runResolverStateT :: ReaderT ResolverContext (ResultT event m) a
}
deriving
( a -> ResolverStateT event m b -> ResolverStateT event m a
(a -> b) -> ResolverStateT event m a -> ResolverStateT event m b
(forall a b.
(a -> b) -> ResolverStateT event m a -> ResolverStateT event m b)
-> (forall a b.
a -> ResolverStateT event m b -> ResolverStateT event m a)
-> Functor (ResolverStateT event m)
forall a b.
a -> ResolverStateT event m b -> ResolverStateT event m a
forall a b.
(a -> b) -> ResolverStateT event m a -> ResolverStateT event m b
forall event (m :: * -> *) a b.
Functor m =>
a -> ResolverStateT event m b -> ResolverStateT event m a
forall event (m :: * -> *) a b.
Functor m =>
(a -> b) -> ResolverStateT event m a -> ResolverStateT event m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ResolverStateT event m b -> ResolverStateT event m a
$c<$ :: forall event (m :: * -> *) a b.
Functor m =>
a -> ResolverStateT event m b -> ResolverStateT event m a
fmap :: (a -> b) -> ResolverStateT event m a -> ResolverStateT event m b
$cfmap :: forall event (m :: * -> *) a b.
Functor m =>
(a -> b) -> ResolverStateT event m a -> ResolverStateT event m b
Functor,
Functor (ResolverStateT event m)
a -> ResolverStateT event m a
Functor (ResolverStateT event m)
-> (forall a. a -> ResolverStateT event m a)
-> (forall a b.
ResolverStateT event m (a -> b)
-> ResolverStateT event m a -> ResolverStateT event m b)
-> (forall a b c.
(a -> b -> c)
-> ResolverStateT event m a
-> ResolverStateT event m b
-> ResolverStateT event m c)
-> (forall a b.
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m b)
-> (forall a b.
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m a)
-> Applicative (ResolverStateT event m)
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m b
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m a
ResolverStateT event m (a -> b)
-> ResolverStateT event m a -> ResolverStateT event m b
(a -> b -> c)
-> ResolverStateT event m a
-> ResolverStateT event m b
-> ResolverStateT event m c
forall a. a -> ResolverStateT event m a
forall a b.
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m a
forall a b.
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m b
forall a b.
ResolverStateT event m (a -> b)
-> ResolverStateT event m a -> ResolverStateT event m b
forall a b c.
(a -> b -> c)
-> ResolverStateT event m a
-> ResolverStateT event m b
-> ResolverStateT event m c
forall event (m :: * -> *).
Applicative m =>
Functor (ResolverStateT event m)
forall event (m :: * -> *) a.
Applicative m =>
a -> ResolverStateT event m a
forall event (m :: * -> *) a b.
Applicative m =>
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m a
forall event (m :: * -> *) a b.
Applicative m =>
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m b
forall event (m :: * -> *) a b.
Applicative m =>
ResolverStateT event m (a -> b)
-> ResolverStateT event m a -> ResolverStateT event m b
forall event (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ResolverStateT event m a
-> ResolverStateT event m b
-> ResolverStateT event m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m a
$c<* :: forall event (m :: * -> *) a b.
Applicative m =>
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m a
*> :: ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m b
$c*> :: forall event (m :: * -> *) a b.
Applicative m =>
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m b
liftA2 :: (a -> b -> c)
-> ResolverStateT event m a
-> ResolverStateT event m b
-> ResolverStateT event m c
$cliftA2 :: forall event (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ResolverStateT event m a
-> ResolverStateT event m b
-> ResolverStateT event m c
<*> :: ResolverStateT event m (a -> b)
-> ResolverStateT event m a -> ResolverStateT event m b
$c<*> :: forall event (m :: * -> *) a b.
Applicative m =>
ResolverStateT event m (a -> b)
-> ResolverStateT event m a -> ResolverStateT event m b
pure :: a -> ResolverStateT event m a
$cpure :: forall event (m :: * -> *) a.
Applicative m =>
a -> ResolverStateT event m a
$cp1Applicative :: forall event (m :: * -> *).
Applicative m =>
Functor (ResolverStateT event m)
Applicative,
Applicative (ResolverStateT event m)
a -> ResolverStateT event m a
Applicative (ResolverStateT event m)
-> (forall a b.
ResolverStateT event m a
-> (a -> ResolverStateT event m b) -> ResolverStateT event m b)
-> (forall a b.
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m b)
-> (forall a. a -> ResolverStateT event m a)
-> Monad (ResolverStateT event m)
ResolverStateT event m a
-> (a -> ResolverStateT event m b) -> ResolverStateT event m b
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m b
forall a. a -> ResolverStateT event m a
forall a b.
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m b
forall a b.
ResolverStateT event m a
-> (a -> ResolverStateT event m b) -> ResolverStateT event m b
forall event (m :: * -> *).
Monad m =>
Applicative (ResolverStateT event m)
forall event (m :: * -> *) a.
Monad m =>
a -> ResolverStateT event m a
forall event (m :: * -> *) a b.
Monad m =>
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m b
forall event (m :: * -> *) a b.
Monad m =>
ResolverStateT event m a
-> (a -> ResolverStateT event m b) -> ResolverStateT event m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ResolverStateT event m a
$creturn :: forall event (m :: * -> *) a.
Monad m =>
a -> ResolverStateT event m a
>> :: ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m b
$c>> :: forall event (m :: * -> *) a b.
Monad m =>
ResolverStateT event m a
-> ResolverStateT event m b -> ResolverStateT event m b
>>= :: ResolverStateT event m a
-> (a -> ResolverStateT event m b) -> ResolverStateT event m b
$c>>= :: forall event (m :: * -> *) a b.
Monad m =>
ResolverStateT event m a
-> (a -> ResolverStateT event m b) -> ResolverStateT event m b
$cp1Monad :: forall event (m :: * -> *).
Monad m =>
Applicative (ResolverStateT event m)
Monad,
MonadReader ResolverContext
)
instance MonadTrans (ResolverStateT e) where
lift :: m a -> ResolverStateT e m a
lift = ReaderT ResolverContext (ResultT e m) a -> ResolverStateT e m a
forall event (m :: * -> *) a.
ReaderT ResolverContext (ResultT event m) a
-> ResolverStateT event m a
ResolverStateT (ReaderT ResolverContext (ResultT e m) a -> ResolverStateT e m a)
-> (m a -> ReaderT ResolverContext (ResultT e m) a)
-> m a
-> ResolverStateT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultT e m a -> ReaderT ResolverContext (ResultT e m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResultT e m a -> ReaderT ResolverContext (ResultT e m) a)
-> (m a -> ResultT e m a)
-> m a
-> ReaderT ResolverContext (ResultT e m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ResultT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance (Monad m) => MonadError GQLError (ResolverStateT e m) where
throwError :: GQLError -> ResolverStateT e m a
throwError GQLError
err = do
ResolverContext
ctx <- (ResolverContext -> ResolverContext)
-> ResolverStateT e m ResolverContext
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ResolverContext -> ResolverContext
forall a. a -> a
id
let f :: GQLError -> GQLError
f = if GQLError -> Bool
isInternal GQLError
err then ResolverContext -> GQLError -> GQLError
renderInternalResolverError ResolverContext
ctx else ResolverContext -> GQLError -> GQLError
resolverFailureMessage ResolverContext
ctx
ReaderT ResolverContext (ResultT e m) a -> ResolverStateT e m a
forall event (m :: * -> *) a.
ReaderT ResolverContext (ResultT event m) a
-> ResolverStateT event m a
ResolverStateT
(ReaderT ResolverContext (ResultT e m) a -> ResolverStateT e m a)
-> ReaderT ResolverContext (ResultT e m) a -> ResolverStateT e m a
forall a b. (a -> b) -> a -> b
$ ResultT e m a -> ReaderT ResolverContext (ResultT e m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
(ResultT e m a -> ReaderT ResolverContext (ResultT e m) a)
-> ResultT e m a -> ReaderT ResolverContext (ResultT e m) a
forall a b. (a -> b) -> a -> b
$ GQLError -> ResultT e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(GQLError -> ResultT e m a) -> GQLError -> ResultT e m a
forall a b. (a -> b) -> a -> b
$ GQLError -> GQLError
f GQLError
err
catchError :: ResolverStateT e m a
-> (GQLError -> ResolverStateT e m a) -> ResolverStateT e m a
catchError (ResolverStateT ReaderT ResolverContext (ResultT e m) a
mx) GQLError -> ResolverStateT e m a
f = ReaderT ResolverContext (ResultT e m) a -> ResolverStateT e m a
forall event (m :: * -> *) a.
ReaderT ResolverContext (ResultT event m) a
-> ResolverStateT event m a
ResolverStateT (ReaderT ResolverContext (ResultT e m) a -> ResolverStateT e m a)
-> ReaderT ResolverContext (ResultT e m) a -> ResolverStateT e m a
forall a b. (a -> b) -> a -> b
$ ReaderT ResolverContext (ResultT e m) a
-> (GQLError -> ReaderT ResolverContext (ResultT e m) a)
-> ReaderT ResolverContext (ResultT e m) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ReaderT ResolverContext (ResultT e m) a
mx (ResolverStateT e m a -> ReaderT ResolverContext (ResultT e m) a
forall event (m :: * -> *) a.
ResolverStateT event m a
-> ReaderT ResolverContext (ResultT event m) a
_runResolverStateT (ResolverStateT e m a -> ReaderT ResolverContext (ResultT e m) a)
-> (GQLError -> ResolverStateT e m a)
-> GQLError
-> ReaderT ResolverContext (ResultT e m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLError -> ResolverStateT e m a
f)
instance (Monad m) => PushEvents e (ResolverStateT e m) where
pushEvents :: [e] -> ResolverStateT e m ()
pushEvents = ReaderT ResolverContext (ResultT e m) () -> ResolverStateT e m ()
forall event (m :: * -> *) a.
ReaderT ResolverContext (ResultT event m) a
-> ResolverStateT event m a
ResolverStateT (ReaderT ResolverContext (ResultT e m) () -> ResolverStateT e m ())
-> ([e] -> ReaderT ResolverContext (ResultT e m) ())
-> [e]
-> ResolverStateT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultT e m () -> ReaderT ResolverContext (ResultT e m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResultT e m () -> ReaderT ResolverContext (ResultT e m) ())
-> ([e] -> ResultT e m ())
-> [e]
-> ReaderT ResolverContext (ResultT e m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> ResultT e m ()
forall e (m :: * -> *). PushEvents e m => [e] -> m ()
pushEvents
mapResolverState ::
( ResultT e m a ->
ResultT e' m' a'
) ->
ResolverStateT e m a ->
ResolverStateT e' m' a'
mapResolverState :: (ResultT e m a -> ResultT e' m' a')
-> ResolverStateT e m a -> ResolverStateT e' m' a'
mapResolverState ResultT e m a -> ResultT e' m' a'
f (ResolverStateT ReaderT ResolverContext (ResultT e m) a
x) = ReaderT ResolverContext (ResultT e' m') a'
-> ResolverStateT e' m' a'
forall event (m :: * -> *) a.
ReaderT ResolverContext (ResultT event m) a
-> ResolverStateT event m a
ResolverStateT ((ResultT e m a -> ResultT e' m' a')
-> ReaderT ResolverContext (ResultT e m) a
-> ReaderT ResolverContext (ResultT e' m') a'
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ResultT e m a -> ResultT e' m' a'
f ReaderT ResolverContext (ResultT e m) a
x)
toResolverStateT ::
Applicative m =>
ResolverState a ->
ResolverStateT e m a
toResolverStateT :: ResolverState a -> ResolverStateT e m a
toResolverStateT = (ResultT () Identity a -> ResultT e m a)
-> ResolverState a -> ResolverStateT e m a
forall e (m :: * -> *) a e' (m' :: * -> *) a'.
(ResultT e m a -> ResultT e' m' a')
-> ResolverStateT e m a -> ResolverStateT e' m' a'
mapResolverState ResultT () Identity a -> ResultT e m a
forall (m :: * -> *) a e.
Applicative m =>
ResultT () Identity a -> ResultT e m a
injectResult
injectResult ::
(Applicative m) =>
ResultT () Identity a ->
ResultT e m a
injectResult :: ResultT () Identity a -> ResultT e m a
injectResult (ResultT (Identity Result GQLError ([()], a)
x)) =
ResultT () m a -> ResultT e m a
forall (m :: * -> *) e a e'.
Functor m =>
ResultT e m a -> ResultT e' m a
cleanEvents (ResultT () m a -> ResultT e m a)
-> ResultT () m a -> ResultT e m a
forall a b. (a -> b) -> a -> b
$ m (Result GQLError ([()], a)) -> ResultT () m a
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (Result GQLError ([()], a) -> m (Result GQLError ([()], a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result GQLError ([()], a)
x)
clearStateResolverEvents :: (Functor m) => ResolverStateT e m a -> ResolverStateT e' m a
clearStateResolverEvents :: ResolverStateT e m a -> ResolverStateT e' m a
clearStateResolverEvents = (ResultT e m a -> ResultT e' m a)
-> ResolverStateT e m a -> ResolverStateT e' m a
forall e (m :: * -> *) a e' (m' :: * -> *) a'.
(ResultT e m a -> ResultT e' m' a')
-> ResolverStateT e m a -> ResolverStateT e' m' a'
mapResolverState ResultT e m a -> ResultT e' m a
forall (m :: * -> *) e a e'.
Functor m =>
ResultT e m a -> ResultT e' m a
cleanEvents
resolverFailureMessage :: ResolverContext -> GQLError -> GQLError
resolverFailureMessage :: ResolverContext -> GQLError -> GQLError
resolverFailureMessage
ctx :: ResolverContext
ctx@ResolverContext
{ currentSelection :: ResolverContext -> Selection VALID
currentSelection =
Selection {FieldName
selectionName :: forall (s :: Stage). Selection s -> FieldName
selectionName :: FieldName
selectionName, Position
selectionPosition :: forall (s :: Stage). Selection s -> Position
selectionPosition :: Position
selectionPosition}
}
GQLError
err =
GQLError
"Failure on Resolving Field "
GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> FieldName -> GQLError
forall a. Msg a => a -> GQLError
msg FieldName
selectionName
GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
": "
GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
err
GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> ResolverContext -> GQLError
withInternalContext ResolverContext
ctx GQLError -> Position -> GQLError
`at` Position
selectionPosition
renderInternalResolverError :: ResolverContext -> GQLError -> GQLError
renderInternalResolverError :: ResolverContext -> GQLError -> GQLError
renderInternalResolverError ctx :: ResolverContext
ctx@ResolverContext {Selection VALID
currentSelection :: Selection VALID
currentSelection :: ResolverContext -> Selection VALID
currentSelection} GQLError
err =
GQLError -> GQLError
internal (GQLError -> GQLError) -> GQLError -> GQLError
forall a b. (a -> b) -> a -> b
$
(GQLError
err GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
". " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError -> GQLError
forall a. Msg a => a -> GQLError
msg (ResolverContext -> GQLError
renderContext ResolverContext
ctx))
GQLError -> Position -> GQLError
`at` Selection VALID -> Position
forall (s :: Stage). Selection s -> Position
selectionPosition Selection VALID
currentSelection
withInternalContext :: ResolverContext -> GQLError
withInternalContext :: ResolverContext -> GQLError
withInternalContext ResolverContext {config :: ResolverContext -> Config
config = Config {debug :: Config -> Bool
debug = Bool
False}} = GQLError
""
withInternalContext ResolverContext
resCTX = ResolverContext -> GQLError
renderContext ResolverContext
resCTX
renderContext :: ResolverContext -> GQLError
renderContext :: ResolverContext -> GQLError
renderContext
ResolverContext
{ Selection VALID
currentSelection :: Selection VALID
currentSelection :: ResolverContext -> Selection VALID
currentSelection,
Schema VALID
schema :: Schema VALID
schema :: ResolverContext -> Schema VALID
schema,
Operation VALID
operation :: Operation VALID
operation :: ResolverContext -> Operation VALID
operation,
TypeDefinition ANY VALID
currentType :: TypeDefinition ANY VALID
currentType :: ResolverContext -> TypeDefinition ANY VALID
currentType
} =
GQLError -> TypeName -> GQLError
forall a. RenderGQL a => GQLError -> a -> GQLError
renderSection GQLError
"Current Type" (TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition ANY VALID
currentType)
GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError -> Selection VALID -> GQLError
forall a. RenderGQL a => GQLError -> a -> GQLError
renderSection GQLError
"Current Selection" Selection VALID
currentSelection
GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError -> Operation VALID -> GQLError
forall a. RenderGQL a => GQLError -> a -> GQLError
renderSection GQLError
"OperationDefinition" Operation VALID
operation
GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError -> Schema VALID -> GQLError
forall a. RenderGQL a => GQLError -> a -> GQLError
renderSection GQLError
"SchemaDefinition" Schema VALID
schema
renderSection :: RenderGQL a => GQLError -> a -> GQLError
renderSection :: GQLError -> a -> GQLError
renderSection GQLError
label a
content =
GQLError
"\n\n" GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
label GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
":\n" GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
line
GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
"\n\n"
GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> ByteString -> GQLError
forall a. Msg a => a -> GQLError
msg (a -> ByteString
forall a. RenderGQL a => a -> ByteString
render a
content)
GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
"\n\n"
where
line :: GQLError
line = Int -> GQLError -> GQLError
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes (Int
50 :: Int) GQLError
"-"