{-# 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

-- Resolver Internal State
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)

-- clear events and starts new resolver with different type of events but with same value
-- use properly. only if you know what you are doing
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
"-"