{-# 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
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 :: forall (m :: * -> *) a.
(MonadReader ResolverContext m, MonadError GQLError m) =>
Maybe TypeName -> m a -> m a
updateCurrentType = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id 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 :: forall (m :: * -> *) a.
(MonadReader ResolverContext m, MonadError GQLError m) =>
TypeName -> m a -> m a
setCurrentType TypeName
name m a
ma = do
  Maybe (TypeDefinition ANY VALID)
t <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (s :: Stage).
TypeName -> Schema s -> Maybe (TypeDefinition ANY s)
lookupDataType TypeName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverContext -> Schema VALID
schema)
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ GQLError -> GQLError
internal GQLError
"Unknown type \"" forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeName
name forall a. Semigroup a => a -> a -> a
<> GQLError
"\".")
    (\TypeDefinition ANY VALID
currentType -> 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 forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent TypeDefinition ANY VALID
t of
  (DataObject [TypeName]
_ FieldsDefinition OUT VALID
fs) -> forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> TypeName
typeConName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType) FieldName
name FieldsDefinition OUT VALID
fs
  (DataInterface FieldsDefinition OUT VALID
fs) -> forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> TypeName
typeConName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType) FieldName
name FieldsDefinition OUT VALID
fs
  TypeContent TRUE ANY VALID
_ -> forall a. Maybe a
Nothing

askFieldTypeName :: MonadReader ResolverContext m => FieldName -> m (Maybe TypeName)
askFieldTypeName :: forall (m :: * -> *).
MonadReader ResolverContext m =>
FieldName -> m (Maybe TypeName)
askFieldTypeName FieldName
name = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (FieldName -> TypeDefinition ANY VALID -> Maybe TypeName
fieldTypeName FieldName
name 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 :: forall e (m :: * -> *) a.
ResolverStateT e m a -> ResolverContext -> ResultT e m a
runResolverStateT = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall e (m :: * -> *) a.
ResolverStateT e m a
-> ResolverContext -> m (Result GQLError ([e], a))
runResolverStateM ResolverStateT e m a
res = forall event (m :: * -> *) a.
ResultT event m a -> m (Result GQLError ([event], a))
runResultT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) e a.
Functor m =>
ResolverStateT e m a -> ResolverContext -> m (Result GQLError a)
runResolverStateValueM ResolverStateT e m a
res = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. ResolverState a -> ResolverContext -> GQLResult a
runResolverState ResolverState a
res = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
  { forall event (m :: * -> *) a.
ResolverStateT event m a
-> ReaderT ResolverContext (ResultT event m) a
_runResolverStateT :: ReaderT ResolverContext (ResultT event m) a
  }
  deriving
    ( 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
<$ :: forall a b.
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 :: forall a b.
(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,
      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
<* :: forall a b.
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
*> :: forall a b.
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 :: forall a b c.
(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
<*> :: forall a b.
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 :: forall a. a -> ResolverStateT event m a
$cpure :: forall event (m :: * -> *) a.
Applicative m =>
a -> ResolverStateT event m a
Applicative,
      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 :: forall a. a -> ResolverStateT event m a
$creturn :: forall event (m :: * -> *) a.
Monad m =>
a -> ResolverStateT event m a
>> :: forall a b.
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
>>= :: forall a 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
Monad,
      MonadReader ResolverContext
    )

instance MonadTrans (ResolverStateT e) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ResolverStateT e m a
lift = forall event (m :: * -> *) a.
ReaderT ResolverContext (ResultT event m) a
-> ResolverStateT event m a
ResolverStateT 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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (Monad m) => MonadError GQLError (ResolverStateT e m) where
  throwError :: forall a. GQLError -> ResolverStateT e m a
throwError GQLError
err = do
    ResolverContext
ctx <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks 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
    forall event (m :: * -> *) a.
ReaderT ResolverContext (ResultT event m) a
-> ResolverStateT event m a
ResolverStateT forall a b. (a -> b) -> a -> b
$
      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
          GQLError -> GQLError
f GQLError
err
  catchError :: forall a.
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 = forall event (m :: * -> *) a.
ReaderT ResolverContext (ResultT event m) a
-> ResolverStateT event m a
ResolverStateT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ReaderT ResolverContext (ResultT e m) a
mx (forall event (m :: * -> *) a.
ResolverStateT event m a
-> ReaderT ResolverContext (ResultT event m) a
_runResolverStateT 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 = forall event (m :: * -> *) a.
ReaderT ResolverContext (ResultT event m) a
-> ResolverStateT event m a
ResolverStateT 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 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 :: 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'
f (ResolverStateT ReaderT ResolverContext (ResultT e m) a
x) = forall event (m :: * -> *) a.
ReaderT ResolverContext (ResultT event m) a
-> ResolverStateT event m a
ResolverStateT (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 :: forall (m :: * -> *) a e.
Applicative m =>
ResolverState a -> ResolverStateT e m a
toResolverStateT = forall e (m :: * -> *) a e' (m' :: * -> *) a'.
(ResultT e m a -> ResultT e' m' a')
-> ResolverStateT e m a -> ResolverStateT e' m' a'
mapResolverState 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 :: forall (m :: * -> *) a e.
Applicative m =>
ResultT () Identity a -> ResultT e m a
injectResult (ResultT (Identity Result GQLError ([()], a)
x)) =
  forall (m :: * -> *) e a e'.
Functor m =>
ResultT e m a -> ResultT e' m a
cleanEvents forall a b. (a -> b) -> a -> b
$ forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (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 :: forall (m :: * -> *) e a e'.
Functor m =>
ResolverStateT e m a -> ResolverStateT e' m a
clearStateResolverEvents = forall e (m :: * -> *) a e' (m' :: * -> *) a'.
(ResultT e m a -> ResultT e' m' a')
-> ResolverStateT e m a -> ResolverStateT e' m' a'
mapResolverState 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 "
      forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
selectionName
      forall a. Semigroup a => a -> a -> a
<> GQLError
": "
      forall a. Semigroup a => a -> a -> a
<> GQLError
err
      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 forall a b. (a -> b) -> a -> b
$
    (GQLError
err forall a. Semigroup a => a -> a -> a
<> GQLError
". " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (ResolverContext -> GQLError
renderContext ResolverContext
ctx))
      GQLError -> Position -> GQLError
`at` 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
    } =
    forall a. RenderGQL a => GQLError -> a -> GQLError
renderSection GQLError
"Current Type" (forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition ANY VALID
currentType)
      forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => GQLError -> a -> GQLError
renderSection GQLError
"Current Selection" Selection VALID
currentSelection
      forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => GQLError -> a -> GQLError
renderSection GQLError
"OperationDefinition" Operation VALID
operation
      forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => GQLError -> a -> GQLError
renderSection GQLError
"SchemaDefinition" Schema VALID
schema

renderSection :: RenderGQL a => GQLError -> a -> GQLError
renderSection :: forall a. RenderGQL a => GQLError -> a -> GQLError
renderSection GQLError
label a
content =
  GQLError
"\n\n"
    forall a. Semigroup a => a -> a -> a
<> GQLError
label
    forall a. Semigroup a => a -> a -> a
<> GQLError
":\n"
    forall a. Semigroup a => a -> a -> a
<> GQLError
line
    forall a. Semigroup a => a -> a -> a
<> GQLError
"\n\n"
    forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (forall a. RenderGQL a => a -> ByteString
render a
content)
    forall a. Semigroup a => a -> a -> a
<> GQLError
"\n\n"
  where
    line :: GQLError
line = forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes (Int
50 :: Int) GQLError
"-"