{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.App.Internal.Resolving.ResolverValue
  ( ResolverValue (..),
    ResolverObject (..),
    ResolverEntry,
    resolveObject,
    mkUnion,
    mkEnum,
    mkEnumNull,
    mkObject,
  )
where

import qualified Data.HashMap.Lazy as HM
import Data.Morpheus.App.Internal.Resolving.ResolverState
  ( ResolverContext (..),
  )
import Data.Morpheus.Error (subfieldsNotSelected)
import Data.Morpheus.Internal.Ext
  ( SemigroupM (..),
  )
import Data.Morpheus.Internal.Utils
  ( Failure (..),
    empty,
    keyOf,
    selectOr,
    traverseCollection,
  )
import Data.Morpheus.Types.Internal.AST
  ( FieldName,
    GQLErrors,
    InternalError,
    Message,
    ObjectEntry (..),
    Ref,
    ScalarValue (..),
    Selection (..),
    SelectionContent (..),
    SelectionSet,
    TypeName (..),
    UnionSelection,
    UnionTag (..),
    VALID,
    ValidValue,
    ValidationErrors,
    Value (..),
    Value (..),
    msg,
    toGQLError,
    unitFieldName,
    unitTypeName,
  )
import Relude hiding (Show, empty)
import Prelude (Show (..))

data ResolverValue (m :: * -> *)
  = ResNull
  | ResScalar ScalarValue
  | ResEnum TypeName
  | ResObject (ResolverObject m)
  | ResList [ResolverValue m]
  | ResUnion TypeName (m (ResolverValue m))

instance Show (ResolverValue m) where
  show :: ResolverValue m -> String
show ResolverValue m
_ = String
"TODO:"

instance
  ( Monad f,
    Monad m,
    Failure InternalError f,
    Failure InternalError m
  ) =>
  SemigroupM f (ResolverValue m)
  where
  mergeM :: [Ref FieldName]
-> ResolverValue m -> ResolverValue m -> f (ResolverValue m)
mergeM [Ref FieldName]
_ ResolverValue m
ResNull ResolverValue m
ResNull = ResolverValue m -> f (ResolverValue m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResolverValue m
forall (m :: * -> *). ResolverValue m
ResNull
  mergeM [Ref FieldName]
_ ResScalar {} x :: ResolverValue m
x@ResScalar {} = ResolverValue m -> f (ResolverValue m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResolverValue m
x
  mergeM [Ref FieldName]
_ ResEnum {} x :: ResolverValue m
x@ResEnum {} = ResolverValue m -> f (ResolverValue m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResolverValue m
x
  mergeM [Ref FieldName]
p (ResObject ResolverObject m
x) (ResObject ResolverObject m
y) = ResolverObject m -> ResolverValue m
forall (m :: * -> *). ResolverObject m -> ResolverValue m
ResObject (ResolverObject m -> ResolverValue m)
-> f (ResolverObject m) -> f (ResolverValue m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ref FieldName]
-> ResolverObject m -> ResolverObject m -> f (ResolverObject m)
forall (m :: * -> *) a.
SemigroupM m a =>
[Ref FieldName] -> a -> a -> m a
mergeM [Ref FieldName]
p ResolverObject m
x ResolverObject m
y
  mergeM [Ref FieldName]
_ ResolverValue m
_ ResolverValue m
_ = InternalError -> f (ResolverValue m)
forall error (f :: * -> *) v. Failure error f => error -> f v
failure (InternalError
"can't merge: incompatible resolvers" :: InternalError)

type ResolverEntry m = (FieldName, m (ResolverValue m))

data ResolverObject m = ResolverObject
  { ResolverObject m -> TypeName
__typename :: TypeName,
    ResolverObject m -> HashMap FieldName (m (ResolverValue m))
objectFields :: HashMap FieldName (m (ResolverValue m))
  }

instance Show (ResolverObject m) where
  show :: ResolverObject m -> String
show ResolverObject m
_ = String
"TODO:"

instance
  ( Monad m,
    Applicative f,
    Failure InternalError m
  ) =>
  SemigroupM f (ResolverObject m)
  where
  mergeM :: [Ref FieldName]
-> ResolverObject m -> ResolverObject m -> f (ResolverObject m)
mergeM [Ref FieldName]
path (ResolverObject TypeName
tyname HashMap FieldName (m (ResolverValue m))
x) (ResolverObject TypeName
_ HashMap FieldName (m (ResolverValue m))
y) =
    ResolverObject m -> f (ResolverObject m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResolverObject m -> f (ResolverObject m))
-> ResolverObject m -> f (ResolverObject m)
forall a b. (a -> b) -> a -> b
$ TypeName
-> HashMap FieldName (m (ResolverValue m)) -> ResolverObject m
forall (m :: * -> *).
TypeName
-> HashMap FieldName (m (ResolverValue m)) -> ResolverObject m
ResolverObject TypeName
tyname ((m (ResolverValue m) -> m (ResolverValue m) -> m (ResolverValue m))
-> HashMap FieldName (m (ResolverValue m))
-> HashMap FieldName (m (ResolverValue m))
-> HashMap FieldName (m (ResolverValue m))
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HM.unionWith ([Ref FieldName]
-> m (ResolverValue m)
-> m (ResolverValue m)
-> m (ResolverValue m)
forall (m :: * -> *) a.
(Monad m, SemigroupM m a) =>
[Ref FieldName] -> m a -> m a -> m a
mergeResolver [Ref FieldName]
path) HashMap FieldName (m (ResolverValue m))
x HashMap FieldName (m (ResolverValue m))
y)

mergeResolver ::
  (Monad m, SemigroupM m a) =>
  [Ref FieldName] ->
  m a ->
  m a ->
  m a
mergeResolver :: [Ref FieldName] -> m a -> m a -> m a
mergeResolver [Ref FieldName]
path m a
a m a
b = do
  a
a' <- m a
a
  m a
b m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Ref FieldName] -> a -> a -> m a
forall (m :: * -> *) a.
SemigroupM m a =>
[Ref FieldName] -> a -> a -> m a
mergeM [Ref FieldName]
path a
a'

lookupRes ::
  ( Monad m,
    MonadReader ResolverContext m,
    Failure GQLErrors m,
    Failure ValidationErrors m,
    Failure Message m,
    Failure InternalError m
  ) =>
  Selection VALID ->
  ResolverObject m ->
  m ValidValue
lookupRes :: Selection VALID -> ResolverObject m -> m ValidValue
lookupRes Selection {FieldName
selectionName :: forall (s :: Stage). Selection s -> FieldName
selectionName :: FieldName
selectionName}
  | FieldName
selectionName FieldName -> FieldName -> Bool
forall a. Eq a => a -> a -> Bool
== FieldName
"__typename" =
    ValidValue -> m ValidValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValidValue -> m ValidValue)
-> (ResolverObject m -> ValidValue)
-> ResolverObject m
-> m ValidValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarValue -> ValidValue
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> ValidValue)
-> (ResolverObject m -> ScalarValue)
-> ResolverObject m
-> ValidValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ScalarValue
String (Text -> ScalarValue)
-> (ResolverObject m -> Text) -> ResolverObject m -> ScalarValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Text
readTypeName (TypeName -> Text)
-> (ResolverObject m -> TypeName) -> ResolverObject m -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverObject m -> TypeName
forall (m :: * -> *). ResolverObject m -> TypeName
__typename
  | Bool
otherwise =
    m ValidValue
-> (m (ResolverValue m) -> m ValidValue)
-> Maybe (m (ResolverValue m))
-> m ValidValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (ValidValue -> m ValidValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValidValue
forall (stage :: Stage). Value stage
Null)
      (m (ResolverValue m)
-> (ResolverValue m -> m ValidValue) -> m ValidValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ResolverValue m -> m ValidValue
forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, Failure Message m,
 Failure GQLErrors m, Failure ValidationErrors m,
 Failure InternalError m) =>
ResolverValue m -> m ValidValue
runDataResolver)
      (Maybe (m (ResolverValue m)) -> m ValidValue)
-> (ResolverObject m -> Maybe (m (ResolverValue m)))
-> ResolverObject m
-> m ValidValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName
-> HashMap FieldName (m (ResolverValue m))
-> Maybe (m (ResolverValue m))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup FieldName
selectionName
      (HashMap FieldName (m (ResolverValue m))
 -> Maybe (m (ResolverValue m)))
-> (ResolverObject m -> HashMap FieldName (m (ResolverValue m)))
-> ResolverObject m
-> Maybe (m (ResolverValue m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverObject m -> HashMap FieldName (m (ResolverValue m))
forall (m :: * -> *).
ResolverObject m -> HashMap FieldName (m (ResolverValue m))
objectFields

mkUnion ::
  (Monad m) =>
  TypeName ->
  [ResolverEntry m] ->
  ResolverValue m
mkUnion :: TypeName -> [ResolverEntry m] -> ResolverValue m
mkUnion TypeName
name =
  TypeName -> m (ResolverValue m) -> ResolverValue m
forall (m :: * -> *).
TypeName -> m (ResolverValue m) -> ResolverValue m
ResUnion
    TypeName
name
    (m (ResolverValue m) -> ResolverValue m)
-> ([ResolverEntry m] -> m (ResolverValue m))
-> [ResolverEntry m]
-> ResolverValue m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverValue m -> m (ResolverValue m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ResolverValue m -> m (ResolverValue m))
-> ([ResolverEntry m] -> ResolverValue m)
-> [ResolverEntry m]
-> m (ResolverValue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> [ResolverEntry m] -> ResolverValue m
forall (m :: * -> *).
TypeName -> [ResolverEntry m] -> ResolverValue m
mkObject
      TypeName
name

mkEnum :: TypeName -> ResolverValue m
mkEnum :: TypeName -> ResolverValue m
mkEnum = TypeName -> ResolverValue m
forall (m :: * -> *). TypeName -> ResolverValue m
ResEnum

mkEnumNull :: (Monad m) => [ResolverEntry m]
mkEnumNull :: [ResolverEntry m]
mkEnumNull = [(FieldName
unitFieldName, ResolverValue m -> m (ResolverValue m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResolverValue m -> m (ResolverValue m))
-> ResolverValue m -> m (ResolverValue m)
forall a b. (a -> b) -> a -> b
$ TypeName -> ResolverValue m
forall (m :: * -> *). TypeName -> ResolverValue m
mkEnum TypeName
unitTypeName)]

mkObject ::
  TypeName ->
  [ResolverEntry m] ->
  ResolverValue m
mkObject :: TypeName -> [ResolverEntry m] -> ResolverValue m
mkObject TypeName
__typename [ResolverEntry m]
fields =
  ResolverObject m -> ResolverValue m
forall (m :: * -> *). ResolverObject m -> ResolverValue m
ResObject
    ( ResolverObject :: forall (m :: * -> *).
TypeName
-> HashMap FieldName (m (ResolverValue m)) -> ResolverObject m
ResolverObject
        { TypeName
__typename :: TypeName
__typename :: TypeName
__typename,
          objectFields :: HashMap FieldName (m (ResolverValue m))
objectFields = [ResolverEntry m] -> HashMap FieldName (m (ResolverValue m))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [ResolverEntry m]
fields
        }
    )

__encode ::
  forall m.
  ( Monad m,
    MonadReader ResolverContext m,
    Failure Message m,
    Failure GQLErrors m,
    Failure ValidationErrors m,
    Failure InternalError m
  ) =>
  ResolverValue m ->
  Selection VALID ->
  m (Value VALID)
__encode :: ResolverValue m -> Selection VALID -> m ValidValue
__encode ResolverValue m
obj sel :: Selection VALID
sel@Selection {SelectionContent VALID
selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionContent :: SelectionContent VALID
selectionContent} = ResolverValue m -> SelectionContent VALID -> m ValidValue
encodeNode ResolverValue m
obj SelectionContent VALID
selectionContent
  where
    -- LIST
    encodeNode ::
      ResolverValue m ->
      SelectionContent VALID ->
      m (Value VALID)
    encodeNode :: ResolverValue m -> SelectionContent VALID -> m ValidValue
encodeNode (ResList [ResolverValue m]
x) SelectionContent VALID
_ = [ValidValue] -> ValidValue
forall (stage :: Stage). [Value stage] -> Value stage
List ([ValidValue] -> ValidValue) -> m [ValidValue] -> m ValidValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ResolverValue m -> m ValidValue)
-> [ResolverValue m] -> m [ValidValue]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ResolverValue m -> m ValidValue
forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, Failure Message m,
 Failure GQLErrors m, Failure ValidationErrors m,
 Failure InternalError m) =>
ResolverValue m -> m ValidValue
runDataResolver [ResolverValue m]
x
    -- Object -----------------
    encodeNode objDrv :: ResolverValue m
objDrv@(ResObject ResolverObject {TypeName
__typename :: TypeName
__typename :: forall (m :: * -> *). ResolverObject m -> TypeName
__typename}) SelectionContent VALID
_ = TypeName
-> (SelectionSet VALID -> m ValidValue)
-> Selection VALID
-> m ValidValue
forall (m :: * -> *) value.
(Monad m, Failure GQLErrors m) =>
TypeName
-> (SelectionSet VALID -> m value) -> Selection VALID -> m value
withObject TypeName
__typename (SelectionSet VALID -> ResolverValue m -> m ValidValue
forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m,
 Failure ValidationErrors m, Failure InternalError m,
 Failure GQLErrors m, Failure Message m) =>
SelectionSet VALID -> ResolverValue m -> m ValidValue
`resolveObject` ResolverValue m
objDrv) Selection VALID
sel
    -- ENUM
    encodeNode (ResEnum TypeName
enum) SelectionContent VALID
SelectionField = ValidValue -> m ValidValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValidValue -> m ValidValue) -> ValidValue -> m ValidValue
forall a b. (a -> b) -> a -> b
$ ScalarValue -> ValidValue
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> ValidValue) -> ScalarValue -> ValidValue
forall a b. (a -> b) -> a -> b
$ Text -> ScalarValue
String (Text -> ScalarValue) -> Text -> ScalarValue
forall a b. (a -> b) -> a -> b
$ TypeName -> Text
readTypeName TypeName
enum
    encodeNode (ResEnum TypeName
name) unionSel :: SelectionContent VALID
unionSel@UnionSelection {} =
      ResolverValue m -> SelectionContent VALID -> m ValidValue
encodeNode (TypeName -> [ResolverEntry m] -> ResolverValue m
forall (m :: * -> *).
Monad m =>
TypeName -> [ResolverEntry m] -> ResolverValue m
mkUnion TypeName
name [ResolverEntry m]
forall (m :: * -> *). Monad m => [ResolverEntry m]
mkEnumNull) SelectionContent VALID
unionSel
    encodeNode ResEnum {} SelectionContent VALID
_ = Message -> m ValidValue
forall error (f :: * -> *) v. Failure error f => error -> f v
failure (Message
"wrong selection on enum value" :: Message)
    -- UNION
    encodeNode (ResUnion TypeName
typename m (ResolverValue m)
unionRef) (UnionSelection UnionSelection VALID
selections) =
      m (ResolverValue m)
unionRef m (ResolverValue m)
-> (ResolverValue m -> m ValidValue) -> m ValidValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SelectionSet VALID -> ResolverValue m -> m ValidValue
forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m,
 Failure ValidationErrors m, Failure InternalError m,
 Failure GQLErrors m, Failure Message m) =>
SelectionSet VALID -> ResolverValue m -> m ValidValue
resolveObject SelectionSet VALID
currentSelection
      where
        currentSelection :: SelectionSet VALID
currentSelection = TypeName -> UnionSelection VALID -> SelectionSet VALID
pickSelection TypeName
typename UnionSelection VALID
selections
    encodeNode (ResUnion TypeName
name m (ResolverValue m)
_) SelectionContent VALID
_ =
      Message -> m ValidValue
forall error (f :: * -> *) v. Failure error f => error -> f v
failure (Message
"union Resolver " Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> TypeName -> Message
forall a. Msg a => a -> Message
msg TypeName
name Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" should only recieve UnionSelection")
    -- SCALARS
    encodeNode ResolverValue m
ResNull SelectionContent VALID
_ = ValidValue -> m ValidValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValidValue
forall (stage :: Stage). Value stage
Null
    encodeNode (ResScalar ScalarValue
x) SelectionContent VALID
SelectionField = ValidValue -> m ValidValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValidValue -> m ValidValue) -> ValidValue -> m ValidValue
forall a b. (a -> b) -> a -> b
$ ScalarValue -> ValidValue
forall (stage :: Stage). ScalarValue -> Value stage
Scalar ScalarValue
x
    encodeNode ResScalar {} SelectionContent VALID
_ =
      Message -> m ValidValue
forall error (f :: * -> *) v. Failure error f => error -> f v
failure (Message
"scalar Resolver should only recieve SelectionField" :: Message)

runDataResolver ::
  ( Monad m,
    MonadReader ResolverContext m,
    Failure Message m,
    Failure GQLErrors m,
    Failure ValidationErrors m,
    Failure InternalError m
  ) =>
  ResolverValue m ->
  m ValidValue
runDataResolver :: ResolverValue m -> m ValidValue
runDataResolver ResolverValue m
res = (ResolverContext -> Selection VALID) -> m (Selection VALID)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ResolverContext -> Selection VALID
currentSelection m (Selection VALID)
-> (Selection VALID -> m ValidValue) -> m ValidValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ResolverValue m -> Selection VALID -> m ValidValue
forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, Failure Message m,
 Failure GQLErrors m, Failure ValidationErrors m,
 Failure InternalError m) =>
ResolverValue m -> Selection VALID -> m ValidValue
__encode ResolverValue m
res

pickSelection :: TypeName -> UnionSelection VALID -> SelectionSet VALID
pickSelection :: TypeName -> UnionSelection VALID -> SelectionSet VALID
pickSelection = SelectionSet VALID
-> (UnionTag -> SelectionSet VALID)
-> TypeName
-> UnionSelection VALID
-> SelectionSet VALID
forall k a c d. Selectable k a c => d -> (a -> d) -> k -> c -> d
selectOr SelectionSet VALID
forall coll. Empty coll => coll
empty UnionTag -> SelectionSet VALID
unionTagSelection

withObject ::
  ( Monad m,
    Failure GQLErrors m
  ) =>
  TypeName ->
  (SelectionSet VALID -> m value) ->
  Selection VALID ->
  m value
withObject :: TypeName
-> (SelectionSet VALID -> m value) -> Selection VALID -> m value
withObject TypeName
__typename SelectionSet VALID -> m value
f Selection {FieldName
selectionName :: FieldName
selectionName :: forall (s :: Stage). Selection s -> FieldName
selectionName, SelectionContent VALID
selectionContent :: SelectionContent VALID
selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionContent, Position
selectionPosition :: forall (s :: Stage). Selection s -> Position
selectionPosition :: Position
selectionPosition} = SelectionContent VALID -> m value
checkContent SelectionContent VALID
selectionContent
  where
    checkContent :: SelectionContent VALID -> m value
checkContent (SelectionSet SelectionSet VALID
selection) = SelectionSet VALID -> m value
f SelectionSet VALID
selection
    checkContent (UnionSelection UnionSelection VALID
unionSel) =
      SelectionSet VALID -> m value
f (SelectionSet VALID
-> (UnionTag -> SelectionSet VALID)
-> TypeName
-> UnionSelection VALID
-> SelectionSet VALID
forall k a c d. Selectable k a c => d -> (a -> d) -> k -> c -> d
selectOr SelectionSet VALID
forall coll. Empty coll => coll
empty UnionTag -> SelectionSet VALID
unionTagSelection TypeName
__typename UnionSelection VALID
unionSel)
    checkContent SelectionContent VALID
_ = GQLErrors -> m value
forall error (f :: * -> *) v. Failure error f => error -> f v
failure [ValidationError -> GQLError
toGQLError (ValidationError -> GQLError) -> ValidationError -> GQLError
forall a b. (a -> b) -> a -> b
$ FieldName -> TypeName -> Position -> ValidationError
subfieldsNotSelected FieldName
selectionName TypeName
"" Position
selectionPosition]

resolveObject ::
  forall m.
  ( Monad m,
    MonadReader ResolverContext m,
    Failure ValidationErrors m,
    Failure InternalError m,
    Failure GQLErrors m,
    Failure Message m
  ) =>
  SelectionSet VALID ->
  ResolverValue m ->
  m ValidValue
resolveObject :: SelectionSet VALID -> ResolverValue m -> m ValidValue
resolveObject SelectionSet VALID
selectionSet (ResObject drv :: ResolverObject m
drv@ResolverObject {TypeName
__typename :: TypeName
__typename :: forall (m :: * -> *). ResolverObject m -> TypeName
__typename}) =
  Object VALID -> ValidValue
forall (stage :: Stage). Object stage -> Value stage
Object (Object VALID -> ValidValue) -> m (Object VALID) -> m ValidValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Selection VALID -> m (ObjectEntry VALID))
-> SelectionSet VALID -> m (Object VALID)
forall (f :: * -> *) k b a (t :: * -> *) (t' :: * -> *).
(Monad f, KeyOf k b, Elems a (t a), FromElems f b (t' b),
 Failure ValidationErrors f) =>
(a -> f b) -> t a -> f (t' b)
traverseCollection Selection VALID -> m (ObjectEntry VALID)
resolver SelectionSet VALID
selectionSet
  where
    resolver :: Selection VALID -> m (ObjectEntry VALID)
    resolver :: Selection VALID -> m (ObjectEntry VALID)
resolver Selection VALID
currentSelection =
      (ResolverContext -> ResolverContext)
-> m (ObjectEntry VALID) -> m (ObjectEntry VALID)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ResolverContext
ctx -> ResolverContext
ctx {Selection VALID
currentSelection :: Selection VALID
currentSelection :: Selection VALID
currentSelection, currentTypeName :: TypeName
currentTypeName = TypeName
__typename}) (m (ObjectEntry VALID) -> m (ObjectEntry VALID))
-> m (ObjectEntry VALID) -> m (ObjectEntry VALID)
forall a b. (a -> b) -> a -> b
$
        FieldName -> ValidValue -> ObjectEntry VALID
forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry (Selection VALID -> FieldName
forall k a. KeyOf k a => a -> k
keyOf Selection VALID
currentSelection) (ValidValue -> ObjectEntry VALID)
-> m ValidValue -> m (ObjectEntry VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selection VALID -> ResolverObject m -> m ValidValue
forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, Failure GQLErrors m,
 Failure ValidationErrors m, Failure Message m,
 Failure InternalError m) =>
Selection VALID -> ResolverObject m -> m ValidValue
lookupRes Selection VALID
currentSelection ResolverObject m
drv
resolveObject SelectionSet VALID
_ ResolverValue m
_ = InternalError -> m ValidValue
forall error (f :: * -> *) v. Failure error f => error -> f v
failure (InternalError
"expected object as resolver" :: InternalError)