{-# 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,
  )
where

import Control.Monad.Trans.Reader (mapReaderT)
import Data.Morpheus.Core
  ( Config (..),
    RenderGQL,
    render,
  )
import Data.Morpheus.Internal.Ext
  ( Eventless,
    Failure (..),
    PushEvents (..),
    Result,
    ResultT (..),
    cleanEvents,
  )
import Data.Morpheus.Types.Internal.AST
  ( GQLError (..),
    GQLErrors,
    InternalError (..),
    Message,
    Operation,
    Schema,
    Selection (..),
    TypeName,
    VALID,
    ValidationError (..),
    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 -> TypeName
currentTypeName :: TypeName,
    ResolverContext -> Config
config :: Config
  }
  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)

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 e a)
runResolverStateM :: ResolverStateT e m a -> ResolverContext -> m (Result e a)
runResolverStateM ResolverStateT e m a
res = ResultT e m a -> m (Result e a)
forall event (m :: * -> *) a.
ResultT event m a -> m (Result event a)
runResultT (ResultT e m a -> m (Result e a))
-> (ResolverContext -> ResultT e m a)
-> ResolverContext
-> m (Result 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

runResolverState :: ResolverState a -> ResolverContext -> Eventless a
runResolverState :: ResolverState a -> ResolverContext -> Eventless a
runResolverState ResolverState a
res = Identity (Eventless a) -> Eventless a
forall a. Identity a -> a
runIdentity (Identity (Eventless a) -> Eventless a)
-> (ResolverContext -> Identity (Eventless a))
-> ResolverContext
-> Eventless a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverState a -> ResolverContext -> Identity (Eventless a)
forall e (m :: * -> *) a.
ResolverStateT e m a -> ResolverContext -> m (Result 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) => Failure Message (ResolverStateT e m) where
  failure :: Message -> ResolverStateT e m v
failure Message
message = do
    ResolverContext
cxt <- (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
    [GQLError] -> ResolverStateT e m v
forall error (f :: * -> *) v. Failure error f => error -> f v
failure [ResolverContext -> Message -> GQLError
resolverFailureMessage ResolverContext
cxt Message
message]

instance (Monad m) => Failure InternalError (ResolverStateT e m) where
  failure :: InternalError -> ResolverStateT e m v
failure InternalError
message = 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
    [GQLError] -> ResolverStateT e m v
forall error (f :: * -> *) v. Failure error f => error -> f v
failure [ResolverContext -> InternalError -> GQLError
renderInternalResolverError ResolverContext
ctx InternalError
message]

instance Monad m => Failure [ValidationError] (ResolverStateT e m) where
  failure :: [ValidationError] -> ResolverStateT e m v
failure [ValidationError]
messages = 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
    [GQLError] -> ResolverStateT e m v
forall error (f :: * -> *) v. Failure error f => error -> f v
failure ([GQLError] -> ResolverStateT e m v)
-> [GQLError] -> ResolverStateT e m v
forall a b. (a -> b) -> a -> b
$ (ValidationError -> GQLError) -> [ValidationError] -> [GQLError]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ResolverContext -> Message -> GQLError
resolverFailureMessage ResolverContext
ctx (Message -> GQLError)
-> (ValidationError -> Message) -> ValidationError -> GQLError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidationError -> Message
validationMessage) [ValidationError]
messages

instance (Monad m) => Failure GQLErrors (ResolverStateT e m) where
  failure :: [GQLError] -> ResolverStateT e m v
failure = ReaderT ResolverContext (ResultT e m) v -> ResolverStateT e m v
forall event (m :: * -> *) a.
ReaderT ResolverContext (ResultT event m) a
-> ResolverStateT event m a
ResolverStateT (ReaderT ResolverContext (ResultT e m) v -> ResolverStateT e m v)
-> ([GQLError] -> ReaderT ResolverContext (ResultT e m) v)
-> [GQLError]
-> ResolverStateT e m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultT e m v -> ReaderT ResolverContext (ResultT e m) v
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResultT e m v -> ReaderT ResolverContext (ResultT e m) v)
-> ([GQLError] -> ResultT e m v)
-> [GQLError]
-> ReaderT ResolverContext (ResultT e m) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GQLError] -> ResultT e m v
forall error (f :: * -> *) v. Failure error f => error -> f v
failure

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 () 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 () a) -> ResultT () m a
forall event (m :: * -> *) a.
m (Result event a) -> ResultT event m a
ResultT (Result () a -> m (Result () a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result () a
x)

-- clear evets and starts new resolver with diferenct 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 -> Message -> GQLError
resolverFailureMessage :: ResolverContext -> Message -> 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}
    }
  Message
message =
    GQLError :: Message -> [Position] -> GQLError
GQLError
      { message :: Message
message =
          Message
"Failure on Resolving Field "
            Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg FieldName
selectionName
            Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
": "
            Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
message
            Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> ResolverContext -> Message
withInternalContext ResolverContext
ctx,
        locations :: [Position]
locations = [Position
selectionPosition]
      }

renderInternalResolverError :: ResolverContext -> InternalError -> GQLError
renderInternalResolverError :: ResolverContext -> InternalError -> GQLError
renderInternalResolverError ctx :: ResolverContext
ctx@ResolverContext {Selection VALID
currentSelection :: Selection VALID
currentSelection :: ResolverContext -> Selection VALID
currentSelection} InternalError
message =
  GQLError :: Message -> [Position] -> GQLError
GQLError
    { message :: Message
message = InternalError -> Message
forall a. Msg a => a -> Message
msg InternalError
message Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
". " Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> ResolverContext -> Message
renderContext ResolverContext
ctx,
      locations :: [Position]
locations = [Selection VALID -> Position
forall (s :: Stage). Selection s -> Position
selectionPosition Selection VALID
currentSelection]
    }

withInternalContext :: ResolverContext -> Message
withInternalContext :: ResolverContext -> Message
withInternalContext ResolverContext {config :: ResolverContext -> Config
config = Config {debug :: Config -> Bool
debug = Bool
False}} = Message
""
withInternalContext ResolverContext
resCTX = ResolverContext -> Message
renderContext ResolverContext
resCTX

renderContext :: ResolverContext -> Message
renderContext :: ResolverContext -> Message
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,
      TypeName
currentTypeName :: TypeName
currentTypeName :: ResolverContext -> TypeName
currentTypeName
    } =
    Message -> TypeName -> Message
forall a. RenderGQL a => Message -> a -> Message
renderSection Message
"Current Type" TypeName
currentTypeName
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message -> Selection VALID -> Message
forall a. RenderGQL a => Message -> a -> Message
renderSection Message
"Current Selection" Selection VALID
currentSelection
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message -> Operation VALID -> Message
forall a. RenderGQL a => Message -> a -> Message
renderSection Message
"OperationDefinition" Operation VALID
operation
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message -> Schema VALID -> Message
forall a. RenderGQL a => Message -> a -> Message
renderSection Message
"SchemaDefinition" Schema VALID
schema

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