{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

module Language.GraphQL.Execute.Execution
    ( coerceArgumentValues
    , collectFields
    , executeSelectionSet
    ) where

import Control.Monad.Catch (Exception(..), MonadCatch(..))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (runReaderT)
import Control.Monad.Trans.State (gets)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Map.Strict (Map)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq(..))
import qualified Data.Text as Text
import Language.GraphQL.AST (Name)
import Language.GraphQL.Error
import Language.GraphQL.Execute.Coerce
import qualified Language.GraphQL.Execute.Transform as Transform
import qualified Language.GraphQL.Type as Type
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
import qualified Language.GraphQL.Type.Internal as Internal
import Prelude hiding (null)

resolveFieldValue :: MonadCatch m
    => Type.Value
    -> Type.Subs
    -> Type.Resolve m
    -> CollectErrsT m Type.Value
resolveFieldValue :: Value -> Subs -> Resolve m -> CollectErrsT m Value
resolveFieldValue Value
result Subs
args Resolve m
resolver =
    CollectErrsT m Value
-> (ResolverException -> CollectErrsT m Value)
-> CollectErrsT m Value
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (m Value -> CollectErrsT m Value
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Value -> CollectErrsT m Value)
-> m Value -> CollectErrsT m Value
forall a b. (a -> b) -> a -> b
$ Resolve m -> Context -> m Value
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Resolve m
resolver Context
context) ResolverException -> CollectErrsT m Value
forall (m :: * -> *).
MonadCatch m =>
ResolverException -> CollectErrsT m Value
handleFieldError
  where
    handleFieldError :: MonadCatch m
        => ResolverException
        -> CollectErrsT m Type.Value
    handleFieldError :: ResolverException -> CollectErrsT m Value
handleFieldError ResolverException
e =
        Error -> CollectErrsT m ()
forall (m :: * -> *). Monad m => Error -> CollectErrsT m ()
addErr (Text -> [Location] -> [Path] -> Error
Error (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ResolverException -> String
forall e. Exception e => e -> String
displayException ResolverException
e) [] []) CollectErrsT m () -> CollectErrsT m Value -> CollectErrsT m Value
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Value -> CollectErrsT m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Type.Null
    context :: Context
context = Context :: Arguments -> Value -> Context
Type.Context
        { arguments :: Arguments
Type.arguments = Subs -> Arguments
Type.Arguments Subs
args
        , values :: Value
Type.values = Value
result
        }

collectFields :: Monad m
    => Out.ObjectType m
    -> Seq (Transform.Selection m)
    -> Map Name (NonEmpty (Transform.Field m))
collectFields :: ObjectType m -> Seq (Selection m) -> Map Text (NonEmpty (Field m))
collectFields ObjectType m
objectType = (Map Text (NonEmpty (Field m))
 -> Selection m -> Map Text (NonEmpty (Field m)))
-> Map Text (NonEmpty (Field m))
-> Seq (Selection m)
-> Map Text (NonEmpty (Field m))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map Text (NonEmpty (Field m))
-> Selection m -> Map Text (NonEmpty (Field m))
forEach Map Text (NonEmpty (Field m))
forall k a. Map k a
Map.empty
  where
    forEach :: Map Text (NonEmpty (Field m))
-> Selection m -> Map Text (NonEmpty (Field m))
forEach Map Text (NonEmpty (Field m))
groupedFields (Transform.SelectionField Field m
field) =
        let responseKey :: Text
responseKey = Field m -> Text
forall (m :: * -> *). Field m -> Text
aliasOrName Field m
field
         in (NonEmpty (Field m) -> NonEmpty (Field m) -> NonEmpty (Field m))
-> Text
-> NonEmpty (Field m)
-> Map Text (NonEmpty (Field m))
-> Map Text (NonEmpty (Field m))
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith NonEmpty (Field m) -> NonEmpty (Field m) -> NonEmpty (Field m)
forall a. Semigroup a => a -> a -> a
(<>) Text
responseKey (Field m
field Field m -> [Field m] -> NonEmpty (Field m)
forall a. a -> [a] -> NonEmpty a
:| []) Map Text (NonEmpty (Field m))
groupedFields
    forEach Map Text (NonEmpty (Field m))
groupedFields (Transform.SelectionFragment Fragment m
selectionFragment)
        | Transform.Fragment CompositeType m
fragmentType Seq (Selection m)
fragmentSelectionSet <- Fragment m
selectionFragment
        , CompositeType m -> ObjectType m -> Bool
forall (m :: * -> *). CompositeType m -> ObjectType m -> Bool
Internal.doesFragmentTypeApply CompositeType m
fragmentType ObjectType m
objectType =
            let fragmentGroupedFieldSet :: Map Text (NonEmpty (Field m))
fragmentGroupedFieldSet = ObjectType m -> Seq (Selection m) -> Map Text (NonEmpty (Field m))
forall (m :: * -> *).
Monad m =>
ObjectType m -> Seq (Selection m) -> Map Text (NonEmpty (Field m))
collectFields ObjectType m
objectType Seq (Selection m)
fragmentSelectionSet
             in (NonEmpty (Field m) -> NonEmpty (Field m) -> NonEmpty (Field m))
-> Map Text (NonEmpty (Field m))
-> Map Text (NonEmpty (Field m))
-> Map Text (NonEmpty (Field m))
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith NonEmpty (Field m) -> NonEmpty (Field m) -> NonEmpty (Field m)
forall a. Semigroup a => a -> a -> a
(<>) Map Text (NonEmpty (Field m))
groupedFields Map Text (NonEmpty (Field m))
fragmentGroupedFieldSet
        | Bool
otherwise = Map Text (NonEmpty (Field m))
groupedFields

aliasOrName :: forall m. Transform.Field m -> Name
aliasOrName :: Field m -> Text
aliasOrName (Transform.Field Maybe Text
alias Text
name HashMap Text Input
_ Seq (Selection m)
_) = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
name Maybe Text
alias

resolveAbstractType :: Monad m
    => Internal.AbstractType m
    -> Type.Subs
    -> CollectErrsT m (Maybe (Out.ObjectType m))
resolveAbstractType :: AbstractType m -> Subs -> CollectErrsT m (Maybe (ObjectType m))
resolveAbstractType AbstractType m
abstractType Subs
values'
    | Just (Type.String Text
typeName) <- Text -> Subs -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"__typename" Subs
values' = do
        HashMap Text (Type m)
types' <- (Resolution m -> HashMap Text (Type m))
-> StateT (Resolution m) m (HashMap Text (Type m))
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Resolution m -> HashMap Text (Type m)
forall (m :: * -> *). Resolution m -> HashMap Text (Type m)
types
        case Text -> HashMap Text (Type m) -> Maybe (Type m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
typeName HashMap Text (Type m)
types' of
            Just (Internal.ObjectType ObjectType m
objectType) ->
                if ObjectType m -> AbstractType m -> Bool
forall (m :: * -> *). ObjectType m -> AbstractType m -> Bool
Internal.instanceOf ObjectType m
objectType AbstractType m
abstractType
                    then Maybe (ObjectType m) -> CollectErrsT m (Maybe (ObjectType m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ObjectType m) -> CollectErrsT m (Maybe (ObjectType m)))
-> Maybe (ObjectType m) -> CollectErrsT m (Maybe (ObjectType m))
forall a b. (a -> b) -> a -> b
$ ObjectType m -> Maybe (ObjectType m)
forall a. a -> Maybe a
Just ObjectType m
objectType
                    else Maybe (ObjectType m) -> CollectErrsT m (Maybe (ObjectType m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ObjectType m)
forall a. Maybe a
Nothing
            Maybe (Type m)
_ -> Maybe (ObjectType m) -> CollectErrsT m (Maybe (ObjectType m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ObjectType m)
forall a. Maybe a
Nothing
    | Bool
otherwise = Maybe (ObjectType m) -> CollectErrsT m (Maybe (ObjectType m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ObjectType m)
forall a. Maybe a
Nothing

executeField :: (MonadCatch m, Serialize a)
    => Out.Resolver m
    -> Type.Value
    -> NonEmpty (Transform.Field m)
    -> CollectErrsT m a
executeField :: Resolver m -> Value -> NonEmpty (Field m) -> CollectErrsT m a
executeField Resolver m
fieldResolver Value
prev NonEmpty (Field m)
fields
    | Out.ValueResolver Field m
fieldDefinition Resolve m
resolver <- Resolver m
fieldResolver =
        Field m -> Resolve m -> CollectErrsT m a
forall a. Serialize a => Field m -> Resolve m -> CollectErrsT m a
executeField' Field m
fieldDefinition Resolve m
resolver
    | Out.EventStreamResolver Field m
fieldDefinition Resolve m
resolver Subscribe m
_ <- Resolver m
fieldResolver =
        Field m -> Resolve m -> CollectErrsT m a
forall a. Serialize a => Field m -> Resolve m -> CollectErrsT m a
executeField' Field m
fieldDefinition Resolve m
resolver
  where
    executeField' :: Field m -> Resolve m -> CollectErrsT m a
executeField' Field m
fieldDefinition Resolve m
resolver = do
        let Out.Field Maybe Text
_ Type m
fieldType Arguments
argumentDefinitions = Field m
fieldDefinition
        let (Transform.Field Maybe Text
_ Text
_ HashMap Text Input
arguments' Seq (Selection m)
_ :| []) = NonEmpty (Field m)
fields
        case Arguments -> HashMap Text Input -> Maybe Subs
coerceArgumentValues Arguments
argumentDefinitions HashMap Text Input
arguments' of
            Maybe Subs
Nothing -> Text -> CollectErrsT m a
forall (m :: * -> *) a.
(Monad m, Serialize a) =>
Text -> CollectErrsT m a
addErrMsg Text
"Argument coercing failed."
            Just Subs
argumentValues -> do
                Value
answer <- Value -> Subs -> Resolve m -> CollectErrsT m Value
forall (m :: * -> *).
MonadCatch m =>
Value -> Subs -> Resolve m -> CollectErrsT m Value
resolveFieldValue Value
prev Subs
argumentValues Resolve m
resolver
                Type m -> NonEmpty (Field m) -> Value -> CollectErrsT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> NonEmpty (Field m) -> Value -> CollectErrsT m a
completeValue Type m
fieldType NonEmpty (Field m)
fields Value
answer

completeValue :: (MonadCatch m, Serialize a)
    => Out.Type m
    -> NonEmpty (Transform.Field m)
    -> Type.Value
    -> CollectErrsT m a
completeValue :: Type m -> NonEmpty (Field m) -> Value -> CollectErrsT m a
completeValue (Type m -> Bool
forall (m :: * -> *). Type m -> Bool
Out.isNonNullType -> Bool
False) NonEmpty (Field m)
_ Value
Type.Null = a -> CollectErrsT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Serialize a => a
null
completeValue outputType :: Type m
outputType@(Out.ListBaseType Type m
listType) NonEmpty (Field m)
fields (Type.List [Value]
list)
    = (Value -> CollectErrsT m a)
-> [Value] -> StateT (Resolution m) m [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Type m -> NonEmpty (Field m) -> Value -> CollectErrsT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> NonEmpty (Field m) -> Value -> CollectErrsT m a
completeValue Type m
listType NonEmpty (Field m)
fields) [Value]
list
    StateT (Resolution m) m [a]
-> ([a] -> CollectErrsT m a) -> CollectErrsT m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type m -> Output a -> CollectErrsT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> CollectErrsT m a
coerceResult Type m
outputType (Output a -> CollectErrsT m a)
-> ([a] -> Output a) -> [a] -> CollectErrsT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Output a
forall a. [a] -> Output a
List
completeValue outputType :: Type m
outputType@(Out.ScalarBaseType ScalarType
_) NonEmpty (Field m)
_ (Type.Int Int32
int) =
    Type m -> Output a -> CollectErrsT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> CollectErrsT m a
coerceResult Type m
outputType (Output a -> CollectErrsT m a) -> Output a -> CollectErrsT m a
forall a b. (a -> b) -> a -> b
$ Int32 -> Output a
forall a. Int32 -> Output a
Int Int32
int
completeValue outputType :: Type m
outputType@(Out.ScalarBaseType ScalarType
_) NonEmpty (Field m)
_ (Type.Boolean Bool
boolean) =
    Type m -> Output a -> CollectErrsT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> CollectErrsT m a
coerceResult Type m
outputType (Output a -> CollectErrsT m a) -> Output a -> CollectErrsT m a
forall a b. (a -> b) -> a -> b
$ Bool -> Output a
forall a. Bool -> Output a
Boolean Bool
boolean
completeValue outputType :: Type m
outputType@(Out.ScalarBaseType ScalarType
_) NonEmpty (Field m)
_ (Type.Float Double
float) =
    Type m -> Output a -> CollectErrsT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> CollectErrsT m a
coerceResult Type m
outputType (Output a -> CollectErrsT m a) -> Output a -> CollectErrsT m a
forall a b. (a -> b) -> a -> b
$ Double -> Output a
forall a. Double -> Output a
Float Double
float
completeValue outputType :: Type m
outputType@(Out.ScalarBaseType ScalarType
_) NonEmpty (Field m)
_ (Type.String Text
string) =
    Type m -> Output a -> CollectErrsT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> CollectErrsT m a
coerceResult Type m
outputType (Output a -> CollectErrsT m a) -> Output a -> CollectErrsT m a
forall a b. (a -> b) -> a -> b
$ Text -> Output a
forall a. Text -> Output a
String Text
string
completeValue outputType :: Type m
outputType@(Out.EnumBaseType EnumType
enumType) NonEmpty (Field m)
_ (Type.Enum Text
enum) =
    let Type.EnumType Text
_ Maybe Text
_ HashMap Text EnumValue
enumMembers = EnumType
enumType
     in if Text -> HashMap Text EnumValue -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
enum HashMap Text EnumValue
enumMembers
        then Type m -> Output a -> CollectErrsT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> CollectErrsT m a
coerceResult Type m
outputType (Output a -> CollectErrsT m a) -> Output a -> CollectErrsT m a
forall a b. (a -> b) -> a -> b
$ Text -> Output a
forall a. Text -> Output a
Enum Text
enum
        else Text -> CollectErrsT m a
forall (m :: * -> *) a.
(Monad m, Serialize a) =>
Text -> CollectErrsT m a
addErrMsg Text
"Enum value completion failed."
completeValue (Out.ObjectBaseType ObjectType m
objectType) NonEmpty (Field m)
fields Value
result =
    Value -> ObjectType m -> Seq (Selection m) -> CollectErrsT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Value -> ObjectType m -> Seq (Selection m) -> CollectErrsT m a
executeSelectionSet Value
result ObjectType m
objectType (Seq (Selection m) -> CollectErrsT m a)
-> Seq (Selection m) -> CollectErrsT m a
forall a b. (a -> b) -> a -> b
$ NonEmpty (Field m) -> Seq (Selection m)
forall (m :: * -> *).
MonadCatch m =>
NonEmpty (Field m) -> Seq (Selection m)
mergeSelectionSets NonEmpty (Field m)
fields
completeValue (Out.InterfaceBaseType InterfaceType m
interfaceType) NonEmpty (Field m)
fields Value
result
    | Type.Object Subs
objectMap <- Value
result = do
        let abstractType :: AbstractType m
abstractType = InterfaceType m -> AbstractType m
forall (m :: * -> *). InterfaceType m -> AbstractType m
Internal.AbstractInterfaceType InterfaceType m
interfaceType
        Maybe (ObjectType m)
concreteType <- AbstractType m -> Subs -> CollectErrsT m (Maybe (ObjectType m))
forall (m :: * -> *).
Monad m =>
AbstractType m -> Subs -> CollectErrsT m (Maybe (ObjectType m))
resolveAbstractType AbstractType m
abstractType Subs
objectMap
        case Maybe (ObjectType m)
concreteType of
            Just ObjectType m
objectType -> Value -> ObjectType m -> Seq (Selection m) -> CollectErrsT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Value -> ObjectType m -> Seq (Selection m) -> CollectErrsT m a
executeSelectionSet Value
result ObjectType m
objectType
                (Seq (Selection m) -> CollectErrsT m a)
-> Seq (Selection m) -> CollectErrsT m a
forall a b. (a -> b) -> a -> b
$ NonEmpty (Field m) -> Seq (Selection m)
forall (m :: * -> *).
MonadCatch m =>
NonEmpty (Field m) -> Seq (Selection m)
mergeSelectionSets NonEmpty (Field m)
fields
            Maybe (ObjectType m)
Nothing -> Text -> CollectErrsT m a
forall (m :: * -> *) a.
(Monad m, Serialize a) =>
Text -> CollectErrsT m a
addErrMsg Text
"Interface value completion failed."
completeValue (Out.UnionBaseType UnionType m
unionType) NonEmpty (Field m)
fields Value
result
    | Type.Object Subs
objectMap <- Value
result = do
        let abstractType :: AbstractType m
abstractType = UnionType m -> AbstractType m
forall (m :: * -> *). UnionType m -> AbstractType m
Internal.AbstractUnionType UnionType m
unionType
        Maybe (ObjectType m)
concreteType <- AbstractType m -> Subs -> CollectErrsT m (Maybe (ObjectType m))
forall (m :: * -> *).
Monad m =>
AbstractType m -> Subs -> CollectErrsT m (Maybe (ObjectType m))
resolveAbstractType AbstractType m
abstractType Subs
objectMap
        case Maybe (ObjectType m)
concreteType of
            Just ObjectType m
objectType -> Value -> ObjectType m -> Seq (Selection m) -> CollectErrsT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Value -> ObjectType m -> Seq (Selection m) -> CollectErrsT m a
executeSelectionSet Value
result ObjectType m
objectType
                (Seq (Selection m) -> CollectErrsT m a)
-> Seq (Selection m) -> CollectErrsT m a
forall a b. (a -> b) -> a -> b
$ NonEmpty (Field m) -> Seq (Selection m)
forall (m :: * -> *).
MonadCatch m =>
NonEmpty (Field m) -> Seq (Selection m)
mergeSelectionSets NonEmpty (Field m)
fields
            Maybe (ObjectType m)
Nothing -> Text -> CollectErrsT m a
forall (m :: * -> *) a.
(Monad m, Serialize a) =>
Text -> CollectErrsT m a
addErrMsg Text
"Union value completion failed."
completeValue Type m
_ NonEmpty (Field m)
_ Value
_ = Text -> CollectErrsT m a
forall (m :: * -> *) a.
(Monad m, Serialize a) =>
Text -> CollectErrsT m a
addErrMsg Text
"Value completion failed."

mergeSelectionSets :: MonadCatch m
    => NonEmpty (Transform.Field m)
    -> Seq (Transform.Selection m)
mergeSelectionSets :: NonEmpty (Field m) -> Seq (Selection m)
mergeSelectionSets = (Field m -> Seq (Selection m) -> Seq (Selection m))
-> Seq (Selection m) -> NonEmpty (Field m) -> Seq (Selection m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Field m -> Seq (Selection m) -> Seq (Selection m)
forall (m :: * -> *).
Field m -> Seq (Selection m) -> Seq (Selection m)
forEach Seq (Selection m)
forall a. Monoid a => a
mempty
  where
    forEach :: Field m -> Seq (Selection m) -> Seq (Selection m)
forEach (Transform.Field Maybe Text
_ Text
_ HashMap Text Input
_ Seq (Selection m)
fieldSelectionSet) Seq (Selection m)
selectionSet =
        Seq (Selection m)
selectionSet Seq (Selection m) -> Seq (Selection m) -> Seq (Selection m)
forall a. Semigroup a => a -> a -> a
<> Seq (Selection m)
fieldSelectionSet

coerceResult :: (MonadCatch m, Serialize a)
    => Out.Type m
    -> Output a
    -> CollectErrsT m a
coerceResult :: Type m -> Output a -> CollectErrsT m a
coerceResult Type m
outputType Output a
result
    | Just a
serialized <- Type m -> Output a -> Maybe a
forall a (m :: * -> *).
Serialize a =>
Type m -> Output a -> Maybe a
serialize Type m
outputType Output a
result = a -> CollectErrsT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
serialized
    | Bool
otherwise = Text -> CollectErrsT m a
forall (m :: * -> *) a.
(Monad m, Serialize a) =>
Text -> CollectErrsT m a
addErrMsg Text
"Result coercion failed."

-- | Takes an 'Out.ObjectType' and a list of 'Transform.Selection's and applies
-- each field to each 'Transform.Selection'. Resolves into a value containing
-- the resolved 'Transform.Selection', or a null value and error information.
executeSelectionSet :: (MonadCatch m, Serialize a)
    => Type.Value
    -> Out.ObjectType m
    -> Seq (Transform.Selection m)
    -> CollectErrsT m a
executeSelectionSet :: Value -> ObjectType m -> Seq (Selection m) -> CollectErrsT m a
executeSelectionSet Value
result objectType :: ObjectType m
objectType@(Out.ObjectType Text
_ Maybe Text
_ [InterfaceType m]
_ HashMap Text (Resolver m)
resolvers) Seq (Selection m)
selectionSet = do
    let fields :: Map Text (NonEmpty (Field m))
fields = ObjectType m -> Seq (Selection m) -> Map Text (NonEmpty (Field m))
forall (m :: * -> *).
Monad m =>
ObjectType m -> Seq (Selection m) -> Map Text (NonEmpty (Field m))
collectFields ObjectType m
objectType Seq (Selection m)
selectionSet
    Map Text a
resolvedValues <- (Text -> NonEmpty (Field m) -> StateT (Resolution m) m (Maybe a))
-> Map Text (NonEmpty (Field m))
-> StateT (Resolution m) m (Map Text a)
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
Map.traverseMaybeWithKey Text -> NonEmpty (Field m) -> StateT (Resolution m) m (Maybe a)
forall b p.
Serialize b =>
p -> NonEmpty (Field m) -> StateT (Resolution m) m (Maybe b)
forEach Map Text (NonEmpty (Field m))
fields
    Type m -> Output a -> CollectErrsT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> CollectErrsT m a
coerceResult (ObjectType m -> Type m
forall (m :: * -> *). ObjectType m -> Type m
Out.NonNullObjectType ObjectType m
objectType) (Output a -> CollectErrsT m a) -> Output a -> CollectErrsT m a
forall a b. (a -> b) -> a -> b
$ Map Text a -> Output a
forall a. Map Text a -> Output a
Object Map Text a
resolvedValues
  where
    forEach :: p -> NonEmpty (Field m) -> StateT (Resolution m) m (Maybe b)
forEach p
_ fields :: NonEmpty (Field m)
fields@(Field m
field :| [Field m]
_) =
        let Transform.Field Maybe Text
_ Text
name HashMap Text Input
_ Seq (Selection m)
_ = Field m
field
         in (Resolver m -> StateT (Resolution m) m b)
-> Maybe (Resolver m) -> StateT (Resolution m) m (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (NonEmpty (Field m) -> Resolver m -> StateT (Resolution m) m b
forall (m :: * -> *) b.
(MonadCatch m, Serialize b) =>
NonEmpty (Field m) -> Resolver m -> StateT (Resolution m) m b
tryResolver NonEmpty (Field m)
fields) (Maybe (Resolver m) -> StateT (Resolution m) m (Maybe b))
-> Maybe (Resolver m) -> StateT (Resolution m) m (Maybe b)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Resolver m)
lookupResolver Text
name
    lookupResolver :: Text -> Maybe (Resolver m)
lookupResolver = (Text -> HashMap Text (Resolver m) -> Maybe (Resolver m))
-> HashMap Text (Resolver m) -> Text -> Maybe (Resolver m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashMap Text (Resolver m) -> Maybe (Resolver m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HashMap Text (Resolver m)
resolvers
    tryResolver :: NonEmpty (Field m) -> Resolver m -> StateT (Resolution m) m b
tryResolver NonEmpty (Field m)
fields Resolver m
resolver =
        Resolver m
-> Value -> NonEmpty (Field m) -> StateT (Resolution m) m b
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Resolver m -> Value -> NonEmpty (Field m) -> CollectErrsT m a
executeField Resolver m
resolver Value
result NonEmpty (Field m)
fields StateT (Resolution m) m b
-> (b -> StateT (Resolution m) m b) -> StateT (Resolution m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m b -> StateT (Resolution m) m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> StateT (Resolution m) m b)
-> (b -> m b) -> b -> StateT (Resolution m) m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure

coerceArgumentValues
    :: HashMap Name In.Argument
    -> HashMap Name Transform.Input
    -> Maybe Type.Subs
coerceArgumentValues :: Arguments -> HashMap Text Input -> Maybe Subs
coerceArgumentValues Arguments
argumentDefinitions HashMap Text Input
argumentValues =
    (Text -> Argument -> Maybe Subs -> Maybe Subs)
-> Maybe Subs -> Arguments -> Maybe Subs
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey Text -> Argument -> Maybe Subs -> Maybe Subs
forEach (Subs -> Maybe Subs
forall (f :: * -> *) a. Applicative f => a -> f a
pure Subs
forall a. Monoid a => a
mempty) Arguments
argumentDefinitions
  where
    forEach :: Text -> Argument -> Maybe Subs -> Maybe Subs
forEach Text
variableName (In.Argument Maybe Text
_ Type
variableType Maybe Value
defaultValue) =
        (Type -> Input -> Maybe Value)
-> HashMap Text Input
-> Text
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
forall a.
(Type -> a -> Maybe Value)
-> HashMap Text a
-> Text
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
matchFieldValues Type -> Input -> Maybe Value
coerceArgumentValue HashMap Text Input
argumentValues Text
variableName Type
variableType Maybe Value
defaultValue
    coerceArgumentValue :: Type -> Input -> Maybe Value
coerceArgumentValue Type
inputType (Transform.Int Int32
integer) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Int32 -> Value
Type.Int Int32
integer)
    coerceArgumentValue Type
inputType (Transform.Boolean Bool
boolean) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Bool -> Value
Type.Boolean Bool
boolean)
    coerceArgumentValue Type
inputType (Transform.String Text
string) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Text -> Value
Type.String Text
string)
    coerceArgumentValue Type
inputType (Transform.Float Double
float) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Double -> Value
Type.Float Double
float)
    coerceArgumentValue Type
inputType (Transform.Enum Text
enum) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Text -> Value
Type.Enum Text
enum)
    coerceArgumentValue Type
inputType Input
Transform.Null
        | Type -> Bool
In.isNonNullType Type
inputType = Maybe Value
forall a. Maybe a
Nothing
        | Bool
otherwise = Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType Value
Type.Null
    coerceArgumentValue (In.ListBaseType Type
inputType) (Transform.List [Value]
list) =
        let coerceItem :: Value -> Maybe Value
coerceItem = Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType
         in [Value] -> Value
Type.List ([Value] -> Value) -> Maybe [Value] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Maybe Value) -> [Value] -> Maybe [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Maybe Value
coerceItem [Value]
list
    coerceArgumentValue (In.InputObjectBaseType InputObjectType
inputType) (Transform.Object HashMap Text Input
object)
        | In.InputObjectType Text
_ Maybe Text
_ HashMap Text InputField
inputFields <- InputObjectType
inputType = 
            let go :: Text -> InputField -> Maybe Subs -> Maybe Subs
go = HashMap Text Input
-> Text -> InputField -> Maybe Subs -> Maybe Subs
forEachField HashMap Text Input
object
                resultMap :: Maybe Subs
resultMap = (Text -> InputField -> Maybe Subs -> Maybe Subs)
-> Maybe Subs -> HashMap Text InputField -> Maybe Subs
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey Text -> InputField -> Maybe Subs -> Maybe Subs
go (Subs -> Maybe Subs
forall (f :: * -> *) a. Applicative f => a -> f a
pure Subs
forall a. Monoid a => a
mempty) HashMap Text InputField
inputFields
             in Subs -> Value
Type.Object (Subs -> Value) -> Maybe Subs -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Subs
resultMap
    coerceArgumentValue Type
_ (Transform.Variable Value
variable) = Value -> Maybe Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
variable
    coerceArgumentValue Type
_ Input
_ = Maybe Value
forall a. Maybe a
Nothing
    forEachField :: HashMap Text Input
-> Text -> InputField -> Maybe Subs -> Maybe Subs
forEachField HashMap Text Input
object Text
variableName (In.InputField Maybe Text
_ Type
variableType Maybe Value
defaultValue) =
        (Type -> Input -> Maybe Value)
-> HashMap Text Input
-> Text
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
forall a.
(Type -> a -> Maybe Value)
-> HashMap Text a
-> Text
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
matchFieldValues Type -> Input -> Maybe Value
coerceArgumentValue HashMap Text Input
object Text
variableName Type
variableType Maybe Value
defaultValue