{-# 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 result :: Value
result args :: Subs
args resolver :: 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 e :: 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 :: 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 groupedFields :: Map Text (NonEmpty (Field m))
groupedFields (Transform.SelectionField field :: 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 groupedFields :: Map Text (NonEmpty (Field m))
groupedFields (Transform.SelectionFragment selectionFragment :: Fragment m
selectionFragment)
        | Transform.Fragment fragmentType :: CompositeType m
fragmentType fragmentSelectionSet :: 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 alias :: Maybe Text
alias name :: Text
name _ _) = 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 :: AbstractType m
abstractType values' :: Subs
values'
    | Just (Type.String typeName :: Text
typeName) <- Text -> Subs -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup "__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 :: 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 (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 fieldResolver :: Resolver m
fieldResolver prev :: Value
prev fields :: NonEmpty (Field m)
fields
    | Out.ValueResolver fieldDefinition :: Field m
fieldDefinition resolver :: 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 fieldDefinition :: Field m
fieldDefinition resolver :: 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
  where
    executeField' :: Field m -> Resolve m -> CollectErrsT m a
executeField' fieldDefinition :: Field m
fieldDefinition resolver :: Resolve m
resolver = do
        let Out.Field _ fieldType :: Type m
fieldType argumentDefinitions :: Arguments
argumentDefinitions = Field m
fieldDefinition
        let (Transform.Field _ _ arguments' :: HashMap Text Input
arguments' _ :| []) = NonEmpty (Field m)
fields
        case Arguments -> HashMap Text Input -> Maybe Subs
coerceArgumentValues Arguments
argumentDefinitions HashMap Text Input
arguments' of
            Nothing -> Text -> CollectErrsT m a
forall (m :: * -> *) a.
(Monad m, Serialize a) =>
Text -> CollectErrsT m a
addErrMsg "Argument coercing failed."
            Just argumentValues :: 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) _ 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 listType :: Type m
listType) fields :: NonEmpty (Field m)
fields (Type.List 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 _) _ (Type.Int 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 _) _ (Type.Boolean 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 _) _ (Type.Float 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 _) _ (Type.String 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
enumType) _ (Type.Enum enum :: Text
enum) =
    let Type.EnumType _ _ enumMembers :: 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 "Enum value completion failed."
completeValue (Out.ObjectBaseType objectType :: ObjectType m
objectType) fields :: NonEmpty (Field m)
fields result :: 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 :: InterfaceType m
interfaceType) fields :: NonEmpty (Field m)
fields result :: Value
result
    | Type.Object objectMap :: 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 :: 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
            Nothing -> Text -> CollectErrsT m a
forall (m :: * -> *) a.
(Monad m, Serialize a) =>
Text -> CollectErrsT m a
addErrMsg "Interface value completion failed."
completeValue (Out.UnionBaseType unionType :: UnionType m
unionType) fields :: NonEmpty (Field m)
fields result :: Value
result
    | Type.Object objectMap :: 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 :: 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
            Nothing -> Text -> CollectErrsT m a
forall (m :: * -> *) a.
(Monad m, Serialize a) =>
Text -> CollectErrsT m a
addErrMsg "Union value completion failed."
completeValue _ _ _ = Text -> CollectErrsT m a
forall (m :: * -> *) a.
(Monad m, Serialize a) =>
Text -> CollectErrsT m a
addErrMsg "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 _ _ _ fieldSelectionSet :: Seq (Selection m)
fieldSelectionSet) selectionSet :: 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 outputType :: Type m
outputType result :: Output a
result
    | Just serialized :: 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 "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 result :: Value
result objectType :: ObjectType m
objectType@(Out.ObjectType _ _ _ resolvers :: HashMap Text (Resolver m)
resolvers) selectionSet :: 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 _ fields :: NonEmpty (Field m)
fields@(field :: Field m
field :| _) =
        let Transform.Field _ name :: Text
name _ _ = 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 fields :: NonEmpty (Field m)
fields resolver :: 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 argumentDefinitions :: Arguments
argumentDefinitions argumentValues :: 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 variableName :: Text
variableName (In.Argument _ variableType :: Type
variableType defaultValue :: 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 inputType :: Type
inputType (Transform.Int integer :: Int32
integer) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Int32 -> Value
Type.Int Int32
integer)
    coerceArgumentValue inputType :: Type
inputType (Transform.Boolean boolean :: Bool
boolean) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Bool -> Value
Type.Boolean Bool
boolean)
    coerceArgumentValue inputType :: Type
inputType (Transform.String string :: Text
string) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Text -> Value
Type.String Text
string)
    coerceArgumentValue inputType :: Type
inputType (Transform.Float float :: Double
float) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Double -> Value
Type.Float Double
float)
    coerceArgumentValue inputType :: Type
inputType (Transform.Enum enum :: Text
enum) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Text -> Value
Type.Enum Text
enum)
    coerceArgumentValue inputType :: Type
inputType 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 inputType :: Type
inputType) (Transform.List 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 inputType :: InputObjectType
inputType) (Transform.Object object :: HashMap Text Input
object)
        | In.InputObjectType _ _ inputFields :: 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 _ (Transform.Variable variable :: Value
variable) = Value -> Maybe Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
variable
    coerceArgumentValue _ _ = Maybe Value
forall a. Maybe a
Nothing
    forEachField :: HashMap Text Input
-> Text -> InputField -> Maybe Subs -> Maybe Subs
forEachField object :: HashMap Text Input
object variableName :: Text
variableName (In.InputField _ variableType :: Type
variableType defaultValue :: 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