{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeApplications #-}
module Language.GraphQL.Execute
( execute
, module Language.GraphQL.Execute.Coerce
) where
import Conduit (mapMC, (.|))
import Control.Arrow (left)
import Control.Monad.Catch
( Exception(..)
, Handler(..)
, MonadCatch(..)
, MonadThrow(..)
, SomeException(..)
, catches
)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Reader (ReaderT(..), ask, runReaderT)
import Control.Monad.Trans.Writer (WriterT(..), runWriterT)
import qualified Control.Monad.Trans.Writer as Writer
import Control.Monad (foldM)
import qualified Language.GraphQL.AST.Document as Full
import Data.Foldable (find)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import qualified Data.Vector as Vector
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Typeable (cast)
import GHC.Records (HasField(..))
import Language.GraphQL.Execute.Coerce
import Language.GraphQL.Execute.OrderedMap (OrderedMap)
import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
import qualified Language.GraphQL.Execute.Transform as Transform
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
import qualified Language.GraphQL.Type as Type
import qualified Language.GraphQL.Type.Internal as Type.Internal
import Language.GraphQL.Type.Schema (Schema, Type)
import qualified Language.GraphQL.Type.Schema as Schema
import Language.GraphQL.Error
( Error(..)
, Response(..)
, Path(..)
, ResolverException(..)
, ResponseEventStream
)
import Prelude hiding (null)
import Language.GraphQL.AST.Document (showVariableName)
newtype ExecutorT m a = ExecutorT
{ forall (m :: * -> *) a.
ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT :: ReaderT (HashMap Full.Name (Type m)) (WriterT (Seq Error) m) a
}
instance Functor m => Functor (ExecutorT m) where
fmap :: forall a b. (a -> b) -> ExecutorT m a -> ExecutorT m b
fmap a -> b
f = forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT
instance Applicative m => Applicative (ExecutorT m) where
pure :: forall a. a -> ExecutorT m a
pure = forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
ExecutorT ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) (a -> b)
f <*> :: forall a b. ExecutorT m (a -> b) -> ExecutorT m a -> ExecutorT m b
<*> ExecutorT ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
x = forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT forall a b. (a -> b) -> a -> b
$ ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
x
instance Monad m => Monad (ExecutorT m) where
ExecutorT ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
x >>= :: forall a b. ExecutorT m a -> (a -> ExecutorT m b) -> ExecutorT m b
>>= a -> ExecutorT m b
f = forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT forall a b. (a -> b) -> a -> b
$ ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExecutorT m b
f
instance MonadTrans ExecutorT where
lift :: forall (m :: * -> *) a. Monad m => m a -> ExecutorT m a
lift = forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MonadThrow m => MonadThrow (ExecutorT m) where
throwM :: forall e a. Exception e => e -> ExecutorT m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
instance MonadCatch m => MonadCatch (ExecutorT m) where
catch :: forall e a.
Exception e =>
ExecutorT m a -> (e -> ExecutorT m a) -> ExecutorT m a
catch (ExecutorT ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
stack) e -> ExecutorT m a
handler =
forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
stack forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ExecutorT m a
handler
data GraphQLException = forall e. Exception e => GraphQLException e
instance Show GraphQLException where
show :: GraphQLException -> String
show (GraphQLException e
e) = forall a. Show a => a -> String
show e
e
instance Exception GraphQLException
graphQLExceptionToException :: Exception e => e -> SomeException
graphQLExceptionToException :: forall e. Exception e => e -> SomeException
graphQLExceptionToException = forall e. Exception e => e -> SomeException
toException forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> GraphQLException
GraphQLException
graphQLExceptionFromException :: Exception e => SomeException -> Maybe e
graphQLExceptionFromException :: forall e. Exception e => SomeException -> Maybe e
graphQLExceptionFromException SomeException
e = do
GraphQLException e
graphqlException <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
graphqlException
data ResultException = forall e. Exception e => ResultException e
instance Show ResultException where
show :: ResultException -> String
show (ResultException e
e) = forall a. Show a => a -> String
show e
e
instance Exception ResultException where
toException :: ResultException -> SomeException
toException = forall e. Exception e => e -> SomeException
graphQLExceptionToException
fromException :: SomeException -> Maybe ResultException
fromException = forall e. Exception e => SomeException -> Maybe e
graphQLExceptionFromException
resultExceptionToException :: Exception e => e -> SomeException
resultExceptionToException :: forall e. Exception e => e -> SomeException
resultExceptionToException = forall e. Exception e => e -> SomeException
toException forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> ResultException
ResultException
resultExceptionFromException :: Exception e => SomeException -> Maybe e
resultExceptionFromException :: forall e. Exception e => SomeException -> Maybe e
resultExceptionFromException SomeException
e = do
ResultException e
resultException <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
resultException
data FieldException = forall e. Exception e => FieldException Full.Location [Path] e
instance Show FieldException where
show :: FieldException -> String
show (FieldException Location
_ [Path]
_ e
e) = forall e. Exception e => e -> String
displayException e
e
instance Exception FieldException where
toException :: FieldException -> SomeException
toException = forall e. Exception e => e -> SomeException
graphQLExceptionToException
fromException :: SomeException -> Maybe FieldException
fromException = forall e. Exception e => SomeException -> Maybe e
graphQLExceptionFromException
data ValueCompletionException = ValueCompletionException String Type.Value
instance Show ValueCompletionException where
show :: ValueCompletionException -> String
show (ValueCompletionException String
typeRepresentation Value
found) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Value completion error. Expected type "
, String
typeRepresentation
, String
", found: "
, forall a. Show a => a -> String
show Value
found
, String
"."
]
instance Exception ValueCompletionException where
toException :: ValueCompletionException -> SomeException
toException = forall e. Exception e => e -> SomeException
resultExceptionToException
fromException :: SomeException -> Maybe ValueCompletionException
fromException = forall e. Exception e => SomeException -> Maybe e
resultExceptionFromException
data InputCoercionException =
InputCoercionException String In.Type (Maybe (Full.Node Transform.Input))
instance Show InputCoercionException where
show :: InputCoercionException -> String
show (InputCoercionException String
argumentName Type
argumentType Maybe (Node Input)
Nothing) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Required argument \""
, String
argumentName
, String
"\" of type "
, forall a. Show a => a -> String
show Type
argumentType
, String
" not specified."
]
show (InputCoercionException String
argumentName Type
argumentType (Just Node Input
givenValue)) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Argument \""
, String
argumentName
, String
"\" has invalid type. Expected type "
, forall a. Show a => a -> String
show Type
argumentType
, String
", found: "
, forall a. Show a => a -> String
show Node Input
givenValue
, String
"."
]
instance Exception InputCoercionException where
toException :: InputCoercionException -> SomeException
toException = forall e. Exception e => e -> SomeException
graphQLExceptionToException
fromException :: SomeException -> Maybe InputCoercionException
fromException = forall e. Exception e => SomeException -> Maybe e
graphQLExceptionFromException
newtype ResultCoercionException = ResultCoercionException String
instance Show ResultCoercionException where
show :: ResultCoercionException -> String
show (ResultCoercionException String
typeRepresentation) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Unable to coerce result to "
, String
typeRepresentation
, String
"."
]
instance Exception ResultCoercionException where
toException :: ResultCoercionException -> SomeException
toException = forall e. Exception e => e -> SomeException
resultExceptionToException
fromException :: SomeException -> Maybe ResultCoercionException
fromException = forall e. Exception e => SomeException -> Maybe e
resultExceptionFromException
data QueryError
= OperationNameRequired
| OperationNotFound String
| CoercionError Full.VariableDefinition
| UnknownInputType Full.VariableDefinition
tell :: Monad m => Seq Error -> ExecutorT m ()
tell :: forall (m :: * -> *). Monad m => Seq Error -> ExecutorT m ()
tell = forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell
operationNameErrorText :: Text
operationNameErrorText :: Name
operationNameErrorText = [Name] -> Name
Text.unlines
[ Name
"Named operations must be provided with the name of the desired operation."
, Name
"See https://spec.graphql.org/June2018/#sec-Language.Document description."
]
queryError :: QueryError -> Error
queryError :: QueryError -> Error
queryError QueryError
OperationNameRequired =
let queryErrorMessage :: Name
queryErrorMessage = Name
"Operation name is required. " forall a. Semigroup a => a -> a -> a
<> Name
operationNameErrorText
in Error{ $sel:message:Error :: Name
message = Name
queryErrorMessage, $sel:locations:Error :: [Location]
locations = [], $sel:path:Error :: [Path]
path = [] }
queryError (OperationNotFound String
operationName) =
let queryErrorMessage :: Name
queryErrorMessage = [Name] -> Name
Text.unlines
[ [Name] -> Name
Text.concat
[ Name
"Operation \""
, String -> Name
Text.pack String
operationName
, Name
"\" is not found in the named operations you've provided. "
]
, Name
operationNameErrorText
]
in Error{ $sel:message:Error :: Name
message = Name
queryErrorMessage, $sel:locations:Error :: [Location]
locations = [], $sel:path:Error :: [Path]
path = [] }
queryError (CoercionError VariableDefinition
variableDefinition) =
let (Full.VariableDefinition Name
_ Type
_ Maybe (Node ConstValue)
_ Location
location) = VariableDefinition
variableDefinition
queryErrorMessage :: Name
queryErrorMessage = [Name] -> Name
Text.concat
[ Name
"Failed to coerce the variable "
, String -> Name
Text.pack forall a b. (a -> b) -> a -> b
$ VariableDefinition -> String
Full.showVariable VariableDefinition
variableDefinition
, Name
"."
]
in Error{ $sel:message:Error :: Name
message = Name
queryErrorMessage, $sel:locations:Error :: [Location]
locations = [Location
location], $sel:path:Error :: [Path]
path = [] }
queryError (UnknownInputType VariableDefinition
variableDefinition) =
let Full.VariableDefinition Name
_ Type
variableTypeName Maybe (Node ConstValue)
_ Location
location = VariableDefinition
variableDefinition
queryErrorMessage :: Name
queryErrorMessage = [Name] -> Name
Text.concat
[ Name
"Variable "
, String -> Name
Text.pack forall a b. (a -> b) -> a -> b
$ VariableDefinition -> String
showVariableName VariableDefinition
variableDefinition
, Name
" has unknown type "
, String -> Name
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Type
variableTypeName
, Name
"."
]
in Error{ $sel:message:Error :: Name
message = Name
queryErrorMessage, $sel:locations:Error :: [Location]
locations = [Location
location], $sel:path:Error :: [Path]
path = [] }
execute :: (MonadCatch m, VariableValue a, Serialize b)
=> Schema m
-> Maybe Text
-> HashMap Full.Name a
-> Full.Document
-> m (Either (ResponseEventStream m b) (Response b))
execute :: forall (m :: * -> *) a b.
(MonadCatch m, VariableValue a, Serialize b) =>
Schema m
-> Maybe Name
-> HashMap Name a
-> Document
-> m (Either (ResponseEventStream m b) (Response b))
execute Schema m
schema' Maybe Name
operationName HashMap Name a
subs Document
document' =
forall (m :: * -> *) a b.
(MonadCatch m, Serialize a, VariableValue b) =>
Schema m
-> Document
-> Maybe String
-> HashMap Name b
-> m (Either (ResponseEventStream m a) (Response a))
executeRequest Schema m
schema' Document
document' (Name -> String
Text.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
operationName) HashMap Name a
subs
executeRequest :: (MonadCatch m, Serialize a, VariableValue b)
=> Schema m
-> Full.Document
-> Maybe String
-> HashMap Full.Name b
-> m (Either (ResponseEventStream m a) (Response a))
executeRequest :: forall (m :: * -> *) a b.
(MonadCatch m, Serialize a, VariableValue b) =>
Schema m
-> Document
-> Maybe String
-> HashMap Name b
-> m (Either (ResponseEventStream m a) (Response a))
executeRequest Schema m
schema Document
sourceDocument Maybe String
operationName HashMap Name b
variableValues = do
Either QueryError (Operation m)
operationAndVariables <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Either QueryError (m (Operation m))
buildOperation
case Either QueryError (Operation m)
operationAndVariables of
Left QueryError
queryError' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right
forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq Error -> Response a
Response forall a. Serialize a => a
null forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ QueryError -> Error
queryError QueryError
queryError'
Right Operation m
operation
| Transform.Operation OperationType
Full.Query Seq (Selection m)
topSelections Location
_operationLocation <- Operation m
operation ->
forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m) -> Schema m -> m (Response a)
executeQuery Seq (Selection m)
topSelections Schema m
schema
| Transform.Operation OperationType
Full.Mutation Seq (Selection m)
topSelections Location
operationLocation <- Operation m
operation ->
forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m) -> Schema m -> Location -> m (Response a)
executeMutation Seq (Selection m)
topSelections Schema m
schema Location
operationLocation
| Transform.Operation OperationType
Full.Subscription Seq (Selection m)
topSelections Location
operationLocation <- Operation m
operation ->
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall b a. Serialize b => Error -> Either a (Response b)
rightErrorResponse forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> Schema m
-> Location
-> m (Either Error (ResponseEventStream m a))
subscribe Seq (Selection m)
topSelections Schema m
schema Location
operationLocation
where
schemaTypes :: HashMap Name (Type m)
schemaTypes = forall (m :: * -> *). Schema m -> HashMap Name (Type m)
Schema.types Schema m
schema
([OperationDefinition]
operationDefinitions, HashMap Name FragmentDefinition
fragmentDefinitions') =
Document
-> ([OperationDefinition], HashMap Name FragmentDefinition)
Transform.document Document
sourceDocument
buildOperation :: Either QueryError (m (Operation m))
buildOperation = do
OperationDefinition
operationDefinition <- [OperationDefinition]
-> Maybe String -> Either QueryError OperationDefinition
getOperation [OperationDefinition]
operationDefinitions Maybe String
operationName
Subs
coercedVariableValues <- forall (m :: * -> *) b.
(Monad m, VariableValue b) =>
HashMap Name (Type m)
-> OperationDefinition -> HashMap Name b -> Either QueryError Subs
coerceVariableValues
HashMap Name (Type m)
schemaTypes
OperationDefinition
operationDefinition
HashMap Name b
variableValues
let replacement :: Replacement m
replacement = Transform.Replacement
{ variableValues :: Subs
variableValues = Subs
coercedVariableValues
, fragmentDefinitions :: HashMap Name FragmentDefinition
fragmentDefinitions = HashMap Name FragmentDefinition
fragmentDefinitions'
, visitedFragments :: HashSet Name
visitedFragments = forall a. Monoid a => a
mempty
, types :: HashMap Name (Type m)
types = HashMap Name (Type m)
schemaTypes
}
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Replacement m
replacement
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
TransformT m a -> ReaderT (Replacement m) m a
Transform.runTransformT
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
OperationDefinition -> TransformT m (Operation m)
Transform.transform OperationDefinition
operationDefinition
rightErrorResponse :: Serialize b => forall a. Error -> Either a (Response b)
rightErrorResponse :: forall b a. Serialize b => Error -> Either a (Response b)
rightErrorResponse = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Seq Error -> Response a
Response forall a. Serialize a => a
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
getOperation :: [Full.OperationDefinition] -> Maybe String -> Either QueryError Full.OperationDefinition
getOperation :: [OperationDefinition]
-> Maybe String -> Either QueryError OperationDefinition
getOperation [OperationDefinition
operation] Maybe String
Nothing = forall a b. b -> Either a b
Right OperationDefinition
operation
getOperation [OperationDefinition]
operations (Just String
givenOperationName)
= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> QueryError
OperationNotFound String
givenOperationName) forall a b. b -> Either a b
Right
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find OperationDefinition -> Bool
findOperationByName [OperationDefinition]
operations
where
findOperationByName :: OperationDefinition -> Bool
findOperationByName (Full.OperationDefinition OperationType
_ (Just Name
operationName) [VariableDefinition]
_ [Directive]
_ SelectionSet
_ Location
_) =
String
givenOperationName forall a. Eq a => a -> a -> Bool
== Name -> String
Text.unpack Name
operationName
findOperationByName OperationDefinition
_ = Bool
False
getOperation [OperationDefinition]
_ Maybe String
_ = forall a b. a -> Either a b
Left QueryError
OperationNameRequired
executeQuery :: (MonadCatch m, Serialize a)
=> Seq (Transform.Selection m)
-> Schema m
-> m (Response a)
executeQuery :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m) -> Schema m -> m (Response a)
executeQuery Seq (Selection m)
topSelections Schema m
schema = do
let queryType :: ObjectType m
queryType = forall (m :: * -> *). Schema m -> ObjectType m
Schema.query Schema m
schema
(a
data', Seq Error
errors) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *). Schema m -> HashMap Name (Type m)
Schema.types Schema m
schema)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet Seq (Selection m)
topSelections ObjectType m
queryType Value
Type.Null [])
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
FieldException -> ExecutorT m a
handleException
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq Error -> Response a
Response a
data' Seq Error
errors
handleException :: (MonadCatch m, Serialize a)
=> FieldException
-> ExecutorT m a
handleException :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
FieldException -> ExecutorT m a
handleException (FieldException Location
fieldLocation [Path]
errorPath e
next) =
let newError :: Error
newError = forall e. Exception e => e -> Location -> [Path] -> Error
constructError e
next Location
fieldLocation [Path]
errorPath
in forall (m :: * -> *). Monad m => Seq Error -> ExecutorT m ()
tell (forall a. a -> Seq a
Seq.singleton Error
newError) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Serialize a => a
null
constructError :: Exception e => e -> Full.Location -> [Path] -> Error
constructError :: forall e. Exception e => e -> Location -> [Path] -> Error
constructError e
e Location
fieldLocation [Path]
errorPath = Error
{ $sel:message:Error :: Name
message = String -> Name
Text.pack (forall e. Exception e => e -> String
displayException e
e)
, $sel:path:Error :: [Path]
path = forall a. [a] -> [a]
reverse [Path]
errorPath
, $sel:locations:Error :: [Location]
locations = [Location
fieldLocation]
}
executeMutation :: (MonadCatch m, Serialize a)
=> Seq (Transform.Selection m)
-> Schema m
-> Full.Location
-> m (Response a)
executeMutation :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m) -> Schema m -> Location -> m (Response a)
executeMutation Seq (Selection m)
topSelections Schema m
schema Location
operationLocation
| Just ObjectType m
mutationType <- forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.mutation Schema m
schema = do
(a
data', Seq Error
errors) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *). Schema m -> HashMap Name (Type m)
Schema.types Schema m
schema)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet Seq (Selection m)
topSelections ObjectType m
mutationType Value
Type.Null [])
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
FieldException -> ExecutorT m a
handleException
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq Error -> Response a
Response a
data' Seq Error
errors
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq Error -> Response a
Response forall a. Serialize a => a
null
forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq a
Seq.singleton
forall a b. (a -> b) -> a -> b
$ Name -> [Location] -> [Path] -> Error
Error Name
"Schema doesn't support mutations." [Location
operationLocation] []
executeSelectionSet :: (MonadCatch m, Serialize a)
=> Seq (Transform.Selection m)
-> Out.ObjectType m
-> Type.Value
-> [Path]
-> ExecutorT m a
executeSelectionSet :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet Seq (Selection m)
selections ObjectType m
objectType Value
objectValue [Path]
errorPath = do
let groupedFieldSet :: OrderedMap (NonEmpty (Field m))
groupedFieldSet = forall (m :: * -> *).
Monad m =>
ObjectType m
-> Seq (Selection m) -> OrderedMap (NonEmpty (Field m))
collectFields ObjectType m
objectType Seq (Selection m)
selections
OrderedMap a
resolvedValues <- forall (f :: * -> *) b a.
Applicative f =>
(a -> f (Maybe b)) -> OrderedMap a -> f (OrderedMap b)
OrderedMap.traverseMaybe forall {b}.
Serialize b =>
NonEmpty (Field m) -> ExecutorT m (Maybe b)
go OrderedMap (NonEmpty (Field m))
groupedFieldSet
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult (forall (m :: * -> *). ObjectType m -> Type m
Out.NonNullObjectType ObjectType m
objectType) forall a b. (a -> b) -> a -> b
$ forall a. OrderedMap a -> Output a
Object OrderedMap a
resolvedValues
where
executeField' :: NonEmpty (Field m) -> Resolver m -> ExecutorT m a
executeField' NonEmpty (Field m)
fields Resolver m
resolver =
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Value
-> NonEmpty (Field m) -> Resolver m -> [Path] -> ExecutorT m a
executeField Value
objectValue NonEmpty (Field m)
fields Resolver m
resolver [Path]
errorPath
Out.ObjectType Name
_ Maybe Name
_ [InterfaceType m]
_ HashMap Name (Resolver m)
resolvers = ObjectType m
objectType
go :: NonEmpty (Field m) -> ExecutorT m (Maybe b)
go fields :: NonEmpty (Field m)
fields@(Transform.Field Maybe Name
_ Name
fieldName HashMap Name (Node Input)
_ Seq (Selection m)
_ Location
_ :| [Field m]
_) =
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {m :: * -> *} {a}.
(MonadCatch m, Serialize a) =>
NonEmpty (Field m) -> Resolver m -> ExecutorT m a
executeField' NonEmpty (Field m)
fields) forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
fieldName HashMap Name (Resolver m)
resolvers
fieldsSegment :: forall m. NonEmpty (Transform.Field m) -> Path
fieldsSegment :: forall (m :: * -> *). NonEmpty (Field m) -> Path
fieldsSegment (Transform.Field Maybe Name
alias Name
fieldName HashMap Name (Node Input)
_ Seq (Selection m)
_ Location
_ :| [Field m]
_) =
Name -> Path
Segment (forall a. a -> Maybe a -> a
fromMaybe Name
fieldName Maybe Name
alias)
viewResolver :: Out.Resolver m -> (Out.Field m, Out.Resolve m)
viewResolver :: forall (m :: * -> *). Resolver m -> (Field m, Resolve m)
viewResolver (Out.ValueResolver Field m
resolverField' Resolve m
resolveFunction) =
(Field m
resolverField', Resolve m
resolveFunction)
viewResolver (Out.EventStreamResolver Field m
resolverField' Resolve m
resolveFunction Subscribe m
_) =
(Field m
resolverField', Resolve m
resolveFunction)
executeField :: forall m a
. (MonadCatch m, Serialize a)
=> Type.Value
-> NonEmpty (Transform.Field m)
-> Out.Resolver m
-> [Path]
-> ExecutorT m a
executeField :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Value
-> NonEmpty (Field m) -> Resolver m -> [Path] -> ExecutorT m a
executeField Value
objectValue NonEmpty (Field m)
fields (forall (m :: * -> *). Resolver m -> (Field m, Resolve m)
viewResolver -> (Field m, Resolve m)
resolverPair) [Path]
errorPath =
let Transform.Field Maybe Name
_ Name
fieldName HashMap Name (Node Input)
inputArguments Seq (Selection m)
_ Location
fieldLocation :| [Field m]
_ = NonEmpty (Field m)
fields
in forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadCatch m) =>
m a -> f (Handler m a) -> m a
catches (forall {b}.
Serialize b =>
Name -> HashMap Name (Node Input) -> ExecutorT m b
go Name
fieldName HashMap Name (Node Input)
inputArguments)
[ forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
FieldException -> ExecutorT m a
nullResultHandler
, forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Location -> InputCoercionException -> ExecutorT m a
inputCoercionHandler Location
fieldLocation)
, forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Location -> ResultException -> ExecutorT m a
resultHandler Location
fieldLocation)
, forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Location -> ResolverException -> ExecutorT m a
resolverHandler Location
fieldLocation)
]
where
fieldErrorPath :: [Path]
fieldErrorPath = forall (m :: * -> *). NonEmpty (Field m) -> Path
fieldsSegment NonEmpty (Field m)
fields forall a. a -> [a] -> [a]
: [Path]
errorPath
inputCoercionHandler :: (MonadCatch m, Serialize a)
=> Full.Location
-> InputCoercionException
-> ExecutorT m a
inputCoercionHandler :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Location -> InputCoercionException -> ExecutorT m a
inputCoercionHandler Location
_ e :: InputCoercionException
e@(InputCoercionException String
_ Type
_ (Just Node Input
valueNode)) =
let argumentLocation :: Location
argumentLocation = forall {k} (x :: k) r a. HasField x r a => r -> a
getField @"location" Node Input
valueNode
in forall {m :: * -> *} {e} {a}.
(MonadThrow m, Serialize a, Exception e) =>
Location -> e -> ExecutorT m a
exceptionHandler Location
argumentLocation InputCoercionException
e
inputCoercionHandler Location
fieldLocation InputCoercionException
e = forall {m :: * -> *} {e} {a}.
(MonadThrow m, Serialize a, Exception e) =>
Location -> e -> ExecutorT m a
exceptionHandler Location
fieldLocation InputCoercionException
e
resultHandler :: (MonadCatch m, Serialize a)
=> Full.Location
-> ResultException
-> ExecutorT m a
resultHandler :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Location -> ResultException -> ExecutorT m a
resultHandler = forall {m :: * -> *} {e} {a}.
(MonadThrow m, Serialize a, Exception e) =>
Location -> e -> ExecutorT m a
exceptionHandler
resolverHandler :: (MonadCatch m, Serialize a)
=> Full.Location
-> ResolverException
-> ExecutorT m a
resolverHandler :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Location -> ResolverException -> ExecutorT m a
resolverHandler = forall {m :: * -> *} {e} {a}.
(MonadThrow m, Serialize a, Exception e) =>
Location -> e -> ExecutorT m a
exceptionHandler
nullResultHandler :: (MonadCatch m, Serialize a)
=> FieldException
-> ExecutorT m a
nullResultHandler :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
FieldException -> ExecutorT m a
nullResultHandler e :: FieldException
e@(FieldException Location
fieldLocation [Path]
errorPath' e
next) =
let newError :: Error
newError = forall e. Exception e => e -> Location -> [Path] -> Error
constructError e
next Location
fieldLocation [Path]
errorPath'
in if forall (m :: * -> *). Type m -> Bool
Out.isNonNullType Type m
fieldType
then forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM FieldException
e
else forall {m :: * -> *} {b}.
(Monad m, Serialize b) =>
Error -> ExecutorT m b
returnError Error
newError
exceptionHandler :: Location -> e -> ExecutorT m a
exceptionHandler Location
errorLocation e
e =
let newError :: Error
newError = forall e. Exception e => e -> Location -> [Path] -> Error
constructError e
e Location
errorLocation [Path]
fieldErrorPath
in if forall (m :: * -> *). Type m -> Bool
Out.isNonNullType Type m
fieldType
then forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ forall e. Exception e => Location -> [Path] -> e -> FieldException
FieldException Location
errorLocation [Path]
fieldErrorPath e
e
else forall {m :: * -> *} {b}.
(Monad m, Serialize b) =>
Error -> ExecutorT m b
returnError Error
newError
returnError :: Error -> ExecutorT m b
returnError Error
newError = forall (m :: * -> *). Monad m => Seq Error -> ExecutorT m ()
tell (forall a. a -> Seq a
Seq.singleton Error
newError) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Serialize a => a
null
go :: Name -> HashMap Name (Node Input) -> ExecutorT m b
go Name
fieldName HashMap Name (Node Input)
inputArguments = do
Subs
argumentValues <- forall (m :: * -> *).
MonadCatch m =>
HashMap Name Argument -> HashMap Name (Node Input) -> m Subs
coerceArgumentValues HashMap Name Argument
argumentTypes HashMap Name (Node Input)
inputArguments
Value
resolvedValue <-
forall (m :: * -> *).
MonadCatch m =>
Resolve m -> Value -> Name -> Subs -> ExecutorT m Value
resolveFieldValue Resolve m
resolveFunction Value
objectValue Name
fieldName Subs
argumentValues
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> NonEmpty (Field m) -> [Path] -> Value -> ExecutorT m a
completeValue Type m
fieldType NonEmpty (Field m)
fields [Path]
fieldErrorPath Value
resolvedValue
(Field m
resolverField, Resolve m
resolveFunction) = (Field m, Resolve m)
resolverPair
Out.Field Maybe Name
_ Type m
fieldType HashMap Name Argument
argumentTypes = Field m
resolverField
resolveFieldValue :: MonadCatch m
=> Out.Resolve m
-> Type.Value
-> Full.Name
-> Type.Subs
-> ExecutorT m Type.Value
resolveFieldValue :: forall (m :: * -> *).
MonadCatch m =>
Resolve m -> Value -> Name -> Subs -> ExecutorT m Value
resolveFieldValue Resolve m
resolver Value
objectValue Name
_fieldName Subs
argumentValues =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Resolve m
resolver Context
context
where
context :: Context
context = Type.Context
{ arguments :: Arguments
Type.arguments = Subs -> Arguments
Type.Arguments Subs
argumentValues
, values :: Value
Type.values = Value
objectValue
}
resolveAbstractType :: Monad m
=> Type.Internal.AbstractType m
-> Type.Subs
-> ExecutorT m (Maybe (Out.ObjectType m))
resolveAbstractType :: forall (m :: * -> *).
Monad m =>
AbstractType m -> Subs -> ExecutorT m (Maybe (ObjectType m))
resolveAbstractType AbstractType m
abstractType Subs
values'
| Just (Type.String Name
typeName) <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"__typename" Subs
values' = do
HashMap Name (Type m)
types' <- forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
typeName HashMap Name (Type m)
types' of
Just (Type.Internal.ObjectType ObjectType m
objectType) ->
if forall (m :: * -> *). ObjectType m -> AbstractType m -> Bool
Type.Internal.instanceOf ObjectType m
objectType AbstractType m
abstractType
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ObjectType m
objectType
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Maybe (Type m)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
completeValue :: (MonadCatch m, Serialize a)
=> Out.Type m
-> NonEmpty (Transform.Field m)
-> [Path]
-> Type.Value
-> ExecutorT m a
completeValue :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> NonEmpty (Field m) -> [Path] -> Value -> ExecutorT m a
completeValue (forall (m :: * -> *). Type m -> Bool
Out.isNonNullType -> Bool
False) NonEmpty (Field m)
_ [Path]
_ Value
Type.Null =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Serialize a => a
null
completeValue outputType :: Type m
outputType@(Out.ListBaseType Type m
listType) NonEmpty (Field m)
fields [Path]
errorPath (Type.List [Value]
list)
= forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {a}.
Serialize a =>
Vector a -> Value -> ExecutorT m (Vector a)
go forall a. Vector a
Vector.empty [Value]
list forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Output a
List forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
Vector.toList
where
go :: Vector a -> Value -> ExecutorT m (Vector a)
go Vector a
accumulator Value
listItem =
let updatedPath :: [Path]
updatedPath = Int -> Path
Index (forall a. Vector a -> Int
Vector.length Vector a
accumulator) forall a. a -> [a] -> [a]
: [Path]
errorPath
in forall a. Vector a -> a -> Vector a
Vector.snoc Vector a
accumulator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> NonEmpty (Field m) -> [Path] -> Value -> ExecutorT m a
completeValue Type m
listType NonEmpty (Field m)
fields [Path]
updatedPath Value
listItem
completeValue outputType :: Type m
outputType@(Out.ScalarBaseType ScalarType
_) NonEmpty (Field m)
_ [Path]
_ (Type.Int Int32
int) =
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType forall a b. (a -> b) -> a -> b
$ forall a. Int32 -> Output a
Int Int32
int
completeValue outputType :: Type m
outputType@(Out.ScalarBaseType ScalarType
_) NonEmpty (Field m)
_ [Path]
_ (Type.Boolean Bool
boolean) =
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType forall a b. (a -> b) -> a -> b
$ forall a. Bool -> Output a
Boolean Bool
boolean
completeValue outputType :: Type m
outputType@(Out.ScalarBaseType ScalarType
_) NonEmpty (Field m)
_ [Path]
_ (Type.Float Double
float) =
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType forall a b. (a -> b) -> a -> b
$ forall a. Double -> Output a
Float Double
float
completeValue outputType :: Type m
outputType@(Out.ScalarBaseType ScalarType
_) NonEmpty (Field m)
_ [Path]
_ (Type.String Name
string) =
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType forall a b. (a -> b) -> a -> b
$ forall a. Name -> Output a
String Name
string
completeValue outputType :: Type m
outputType@(Out.EnumBaseType EnumType
enumType) NonEmpty (Field m)
_ [Path]
_ (Type.Enum Name
enum) =
let Type.EnumType Name
_ Maybe Name
_ HashMap Name EnumValue
enumMembers = EnumType
enumType
in if forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Name
enum HashMap Name EnumValue
enumMembers
then forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType forall a b. (a -> b) -> a -> b
$ forall a. Name -> Output a
Enum Name
enum
else forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
forall a b. (a -> b) -> a -> b
$ String -> Value -> ValueCompletionException
ValueCompletionException (forall a. Show a => a -> String
show Type m
outputType)
forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.Enum Name
enum
completeValue (Out.ObjectBaseType ObjectType m
objectType) NonEmpty (Field m)
fields [Path]
errorPath Value
result
= forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet (forall (m :: * -> *).
MonadCatch m =>
NonEmpty (Field m) -> Seq (Selection m)
mergeSelectionSets NonEmpty (Field m)
fields) ObjectType m
objectType Value
result [Path]
errorPath
completeValue outputType :: Type m
outputType@(Out.InterfaceBaseType InterfaceType m
interfaceType) NonEmpty (Field m)
fields [Path]
errorPath Value
result
| Type.Object Subs
objectMap <- Value
result = do
let abstractType :: AbstractType m
abstractType = forall (m :: * -> *). InterfaceType m -> AbstractType m
Type.Internal.AbstractInterfaceType InterfaceType m
interfaceType
Maybe (ObjectType m)
concreteType <- forall (m :: * -> *).
Monad m =>
AbstractType m -> Subs -> ExecutorT m (Maybe (ObjectType m))
resolveAbstractType AbstractType m
abstractType Subs
objectMap
case Maybe (ObjectType m)
concreteType of
Just ObjectType m
objectType
-> forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet (forall (m :: * -> *).
MonadCatch m =>
NonEmpty (Field m) -> Seq (Selection m)
mergeSelectionSets NonEmpty (Field m)
fields) ObjectType m
objectType Value
result
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). NonEmpty (Field m) -> Path
fieldsSegment NonEmpty (Field m)
fields forall a. a -> [a] -> [a]
: [Path]
errorPath
Maybe (ObjectType m)
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
forall a b. (a -> b) -> a -> b
$ String -> Value -> ValueCompletionException
ValueCompletionException (forall a. Show a => a -> String
show Type m
outputType) Value
result
completeValue outputType :: Type m
outputType@(Out.UnionBaseType UnionType m
unionType) NonEmpty (Field m)
fields [Path]
errorPath Value
result
| Type.Object Subs
objectMap <- Value
result = do
let abstractType :: AbstractType m
abstractType = forall (m :: * -> *). UnionType m -> AbstractType m
Type.Internal.AbstractUnionType UnionType m
unionType
Maybe (ObjectType m)
concreteType <- forall (m :: * -> *).
Monad m =>
AbstractType m -> Subs -> ExecutorT m (Maybe (ObjectType m))
resolveAbstractType AbstractType m
abstractType Subs
objectMap
case Maybe (ObjectType m)
concreteType of
Just ObjectType m
objectType
-> forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet (forall (m :: * -> *).
MonadCatch m =>
NonEmpty (Field m) -> Seq (Selection m)
mergeSelectionSets NonEmpty (Field m)
fields) ObjectType m
objectType Value
result
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). NonEmpty (Field m) -> Path
fieldsSegment NonEmpty (Field m)
fields forall a. a -> [a] -> [a]
: [Path]
errorPath
Maybe (ObjectType m)
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
forall a b. (a -> b) -> a -> b
$ String -> Value -> ValueCompletionException
ValueCompletionException (forall a. Show a => a -> String
show Type m
outputType) Value
result
completeValue Type m
outputType NonEmpty (Field m)
_ [Path]
_ Value
result =
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> Value -> ValueCompletionException
ValueCompletionException (forall a. Show a => a -> String
show Type m
outputType) Value
result
coerceResult :: (MonadCatch m, Serialize a)
=> Out.Type m
-> Output a
-> ExecutorT m a
coerceResult :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType Output a
result
| Just a
serialized <- forall a (m :: * -> *).
Serialize a =>
Type m -> Output a -> Maybe a
serialize Type m
outputType Output a
result = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
serialized
| Bool
otherwise = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ResultCoercionException
ResultCoercionException forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Type m
outputType
mergeSelectionSets :: MonadCatch m
=> NonEmpty (Transform.Field m)
-> Seq (Transform.Selection m)
mergeSelectionSets :: forall (m :: * -> *).
MonadCatch m =>
NonEmpty (Field m) -> Seq (Selection m)
mergeSelectionSets = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {m :: * -> *}.
Field m -> Seq (Selection m) -> Seq (Selection m)
forEach forall a. Monoid a => a
mempty
where
forEach :: Field m -> Seq (Selection m) -> Seq (Selection m)
forEach (Transform.Field Maybe Name
_ Name
_ HashMap Name (Node Input)
_ Seq (Selection m)
fieldSelectionSet Location
_) Seq (Selection m)
selectionSet' =
Seq (Selection m)
selectionSet' forall a. Semigroup a => a -> a -> a
<> Seq (Selection m)
fieldSelectionSet
coerceArgumentValues :: MonadCatch m
=> HashMap Full.Name In.Argument
-> HashMap Full.Name (Full.Node Transform.Input)
-> m Type.Subs
coerceArgumentValues :: forall (m :: * -> *).
MonadCatch m =>
HashMap Name Argument -> HashMap Name (Node Input) -> m Subs
coerceArgumentValues HashMap Name Argument
argumentDefinitions HashMap Name (Node Input)
argumentValues =
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey forall {m :: * -> *} {b}.
MonadCatch m =>
Name -> Argument -> (Subs -> m b) -> Subs -> m b
c forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Name Argument
argumentDefinitions forall a. Monoid a => a
mempty
where
c :: Name -> Argument -> (Subs -> m b) -> Subs -> m b
c Name
argumentName Argument
argumentType Subs -> m b
pure' Subs
resultMap =
forall (m :: * -> *).
MonadCatch m =>
Name -> Argument -> Subs -> m Subs
forEach Name
argumentName Argument
argumentType Subs
resultMap forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Subs -> m b
pure'
forEach :: MonadCatch m
=> Full.Name
-> In.Argument
-> Type.Subs
-> m Type.Subs
forEach :: forall (m :: * -> *).
MonadCatch m =>
Name -> Argument -> Subs -> m Subs
forEach Name
argumentName (In.Argument Maybe Name
_ Type
variableType Maybe Value
defaultValue) Subs
resultMap = do
let matchedMap :: Maybe Subs
matchedMap
= Name -> Type -> Maybe Value -> Maybe Subs -> Maybe Subs
matchFieldValues' Name
argumentName Type
variableType Maybe Value
defaultValue
forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Subs
resultMap
in case Maybe Subs
matchedMap of
Just Subs
matchedValues -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Subs
matchedValues
Maybe Subs
Nothing
| Just Node Input
inputValue <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
argumentName HashMap Name (Node Input)
argumentValues
-> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
forall a b. (a -> b) -> a -> b
$ String -> Type -> Maybe (Node Input) -> InputCoercionException
InputCoercionException (Name -> String
Text.unpack Name
argumentName) Type
variableType
forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Node Input
inputValue
| Bool
otherwise -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
forall a b. (a -> b) -> a -> b
$ String -> Type -> Maybe (Node Input) -> InputCoercionException
InputCoercionException (Name -> String
Text.unpack Name
argumentName) Type
variableType forall a. Maybe a
Nothing
matchFieldValues' :: Name -> Type -> Maybe Value -> Maybe Subs -> Maybe Subs
matchFieldValues' = forall a.
(Type -> a -> Maybe Value)
-> HashMap Name a
-> Name
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
matchFieldValues Type -> Input -> Maybe Value
coerceArgumentValue
forall a b. (a -> b) -> a -> b
$ forall a. Node a -> a
Full.node forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Name (Node Input)
argumentValues
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 Name
string) =
Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Name -> Value
Type.String Name
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 Name
enum) =
Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Name -> Value
Type.Enum Name
enum)
coerceArgumentValue Type
inputType Input
Transform.Null
| Type -> Bool
In.isNonNullType Type
inputType = forall a. Maybe a
Nothing
| Bool
otherwise = Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType Value
Type.Null
coerceArgumentValue (In.ListBaseType Type
inputType) (Transform.List [Input]
list) =
let coerceItem :: Input -> Maybe Value
coerceItem = Type -> Input -> Maybe Value
coerceArgumentValue Type
inputType
in [Value] -> Value
Type.List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Input -> Maybe Value
coerceItem [Input]
list
coerceArgumentValue (In.InputObjectBaseType InputObjectType
inputType) (Transform.Object HashMap Name Input
object)
| In.InputObjectType Name
_ Maybe Name
_ HashMap Name InputField
inputFields <- InputObjectType
inputType =
let go :: Name -> InputField -> Maybe Subs -> Maybe Subs
go = HashMap Name Input
-> Name -> InputField -> Maybe Subs -> Maybe Subs
forEachField HashMap Name Input
object
resultMap :: Maybe Subs
resultMap = forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey Name -> InputField -> Maybe Subs -> Maybe Subs
go (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) HashMap Name InputField
inputFields
in Subs -> Value
Type.Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Subs
resultMap
coerceArgumentValue Type
_ (Transform.Variable Value
variable) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
variable
coerceArgumentValue Type
_ Input
_ = forall a. Maybe a
Nothing
forEachField :: HashMap Name Input
-> Name -> InputField -> Maybe Subs -> Maybe Subs
forEachField HashMap Name Input
object Name
variableName (In.InputField Maybe Name
_ Type
variableType Maybe Value
defaultValue) =
forall a.
(Type -> a -> Maybe Value)
-> HashMap Name a
-> Name
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
matchFieldValues Type -> Input -> Maybe Value
coerceArgumentValue HashMap Name Input
object Name
variableName Type
variableType Maybe Value
defaultValue
collectFields :: Monad m
=> Out.ObjectType m
-> Seq (Transform.Selection m)
-> OrderedMap (NonEmpty (Transform.Field m))
collectFields :: forall (m :: * -> *).
Monad m =>
ObjectType m
-> Seq (Selection m) -> OrderedMap (NonEmpty (Field m))
collectFields ObjectType m
objectType = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl OrderedMap (NonEmpty (Field m))
-> Selection m -> OrderedMap (NonEmpty (Field m))
forEach forall v. OrderedMap v
OrderedMap.empty
where
forEach :: OrderedMap (NonEmpty (Field m))
-> Selection m -> OrderedMap (NonEmpty (Field m))
forEach OrderedMap (NonEmpty (Field m))
groupedFields (Transform.FieldSelection Field m
fieldSelection) =
let Transform.Field Maybe Name
maybeAlias Name
fieldName HashMap Name (Node Input)
_ Seq (Selection m)
_ Location
_ = Field m
fieldSelection
responseKey :: Name
responseKey = forall a. a -> Maybe a -> a
fromMaybe Name
fieldName Maybe Name
maybeAlias
in forall v. Semigroup v => Name -> v -> OrderedMap v -> OrderedMap v
OrderedMap.insert Name
responseKey (Field m
fieldSelection forall a. a -> [a] -> NonEmpty a
:| []) OrderedMap (NonEmpty (Field m))
groupedFields
forEach OrderedMap (NonEmpty (Field m))
groupedFields (Transform.FragmentSelection Fragment m
selectionFragment)
| Transform.Fragment CompositeType m
fragmentType Seq (Selection m)
fragmentSelectionSet Location
_ <- Fragment m
selectionFragment
, forall (m :: * -> *). CompositeType m -> ObjectType m -> Bool
Type.Internal.doesFragmentTypeApply CompositeType m
fragmentType ObjectType m
objectType =
let fragmentGroupedFieldSet :: OrderedMap (NonEmpty (Field m))
fragmentGroupedFieldSet =
forall (m :: * -> *).
Monad m =>
ObjectType m
-> Seq (Selection m) -> OrderedMap (NonEmpty (Field m))
collectFields ObjectType m
objectType Seq (Selection m)
fragmentSelectionSet
in OrderedMap (NonEmpty (Field m))
groupedFields forall a. Semigroup a => a -> a -> a
<> OrderedMap (NonEmpty (Field m))
fragmentGroupedFieldSet
| Bool
otherwise = OrderedMap (NonEmpty (Field m))
groupedFields
coerceVariableValues :: (Monad m, VariableValue b)
=> HashMap Full.Name (Schema.Type m)
-> Full.OperationDefinition
-> HashMap Full.Name b
-> Either QueryError Type.Subs
coerceVariableValues :: forall (m :: * -> *) b.
(Monad m, VariableValue b) =>
HashMap Name (Type m)
-> OperationDefinition -> HashMap Name b -> Either QueryError Subs
coerceVariableValues HashMap Name (Type m)
types OperationDefinition
operationDefinition' HashMap Name b
variableValues
| Full.OperationDefinition OperationType
_ Maybe Name
_ [VariableDefinition]
variableDefinitions [Directive]
_ SelectionSet
_ Location
_ <-
OperationDefinition
operationDefinition'
= forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr VariableDefinition
-> Either QueryError Subs -> Either QueryError Subs
forEach (forall a b. b -> Either a b
Right forall k v. HashMap k v
HashMap.empty) [VariableDefinition]
variableDefinitions
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
where
forEach :: VariableDefinition
-> Either QueryError Subs -> Either QueryError Subs
forEach VariableDefinition
variableDefinition (Right Subs
coercedValues) =
let Full.VariableDefinition Name
variableName Type
variableTypeName Maybe (Node ConstValue)
defaultValue Location
_ =
VariableDefinition
variableDefinition
defaultValue' :: Maybe Value
defaultValue' = ConstValue -> Value
constValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Node a -> a
Full.node forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Node ConstValue)
defaultValue
in case forall (m :: * -> *). Type -> HashMap Name (Type m) -> Maybe Type
Type.Internal.lookupInputType Type
variableTypeName HashMap Name (Type m)
types of
Just Type
variableType ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ VariableDefinition -> QueryError
CoercionError VariableDefinition
variableDefinition) forall a b. b -> Either a b
Right
forall a b. (a -> b) -> a -> b
$ forall a.
(Type -> a -> Maybe Value)
-> HashMap Name a
-> Name
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
matchFieldValues
forall {a}. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue'
HashMap Name b
variableValues
Name
variableName
Type
variableType
Maybe Value
defaultValue'
forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Subs
coercedValues
Maybe Type
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ VariableDefinition -> QueryError
UnknownInputType VariableDefinition
variableDefinition
forEach VariableDefinition
_ Either QueryError Subs
coercedValuesOrError = Either QueryError Subs
coercedValuesOrError
coerceVariableValue' :: Type -> a -> Maybe Value
coerceVariableValue' Type
variableType a
value'
= forall {a}. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue Type
variableType a
value'
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Value -> Maybe Value
coerceInputLiteral Type
variableType
constValue :: Full.ConstValue -> Type.Value
constValue :: ConstValue -> Value
constValue (Full.ConstInt Int32
i) = Int32 -> Value
Type.Int Int32
i
constValue (Full.ConstFloat Double
f) = Double -> Value
Type.Float Double
f
constValue (Full.ConstString Name
x) = Name -> Value
Type.String Name
x
constValue (Full.ConstBoolean Bool
b) = Bool -> Value
Type.Boolean Bool
b
constValue ConstValue
Full.ConstNull = Value
Type.Null
constValue (Full.ConstEnum Name
e) = Name -> Value
Type.Enum Name
e
constValue (Full.ConstList [Node ConstValue]
list) = [Value] -> Value
Type.List forall a b. (a -> b) -> a -> b
$ ConstValue -> Value
constValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Node a -> a
Full.node forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node ConstValue]
list
constValue (Full.ConstObject [ObjectField ConstValue]
o) =
Subs -> Value
Type.Object forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall a b. (a -> b) -> a -> b
$ ObjectField ConstValue -> (Name, Value)
constObjectField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ObjectField ConstValue]
o
where
constObjectField :: ObjectField ConstValue -> (Name, Value)
constObjectField Full.ObjectField{$sel:value:ObjectField :: forall a. ObjectField a -> Node a
value = Node ConstValue
value', Name
Location
$sel:location:ObjectField :: forall a. ObjectField a -> Location
$sel:name:ObjectField :: forall a. ObjectField a -> Name
location :: Location
name :: Name
..} =
(Name
name, ConstValue -> Value
constValue forall a b. (a -> b) -> a -> b
$ forall a. Node a -> a
Full.node Node ConstValue
value')
subscribe :: (MonadCatch m, Serialize a)
=> Seq (Transform.Selection m)
-> Schema m
-> Full.Location
-> m (Either Error (ResponseEventStream m a))
subscribe :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> Schema m
-> Location
-> m (Either Error (ResponseEventStream m a))
subscribe Seq (Selection m)
fields Schema m
schema Location
objectLocation
| Just ObjectType m
objectType <- forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.subscription Schema m
schema = do
let types' :: HashMap Name (Type m)
types' = forall (m :: * -> *). Schema m -> HashMap Name (Type m)
Schema.types Schema m
schema
Either Error (SourceEventStream m)
sourceStream <-
forall (m :: * -> *).
MonadCatch m =>
HashMap Name (Type m)
-> ObjectType m
-> Location
-> Seq (Selection m)
-> m (Either Error (SourceEventStream m))
createSourceEventStream HashMap Name (Type m)
types' ObjectType m
objectType Location
objectLocation Seq (Selection m)
fields
let traverser :: SourceEventStream m -> m (ResponseEventStream m a)
traverser =
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
HashMap Name (Type m)
-> ObjectType m
-> Seq (Selection m)
-> SourceEventStream m
-> m (ResponseEventStream m a)
mapSourceToResponseEvent HashMap Name (Type m)
types' ObjectType m
objectType Seq (Selection m)
fields
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SourceEventStream m -> m (ResponseEventStream m a)
traverser Either Error (SourceEventStream m)
sourceStream
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left
forall a b. (a -> b) -> a -> b
$ Name -> [Location] -> [Path] -> Error
Error Name
"Schema doesn't support subscriptions." [] []
mapSourceToResponseEvent :: (MonadCatch m, Serialize a)
=> HashMap Full.Name (Type m)
-> Out.ObjectType m
-> Seq (Transform.Selection m)
-> Out.SourceEventStream m
-> m (ResponseEventStream m a)
mapSourceToResponseEvent :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
HashMap Name (Type m)
-> ObjectType m
-> Seq (Selection m)
-> SourceEventStream m
-> m (ResponseEventStream m a)
mapSourceToResponseEvent HashMap Name (Type m)
types' ObjectType m
subscriptionType Seq (Selection m)
fields SourceEventStream m
sourceStream
= forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ SourceEventStream m
sourceStream
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
mapMC (forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
HashMap Name (Type m)
-> ObjectType m -> Seq (Selection m) -> Value -> m (Response a)
executeSubscriptionEvent HashMap Name (Type m)
types' ObjectType m
subscriptionType Seq (Selection m)
fields)
createSourceEventStream :: MonadCatch m
=> HashMap Full.Name (Type m)
-> Out.ObjectType m
-> Full.Location
-> Seq (Transform.Selection m)
-> m (Either Error (Out.SourceEventStream m))
createSourceEventStream :: forall (m :: * -> *).
MonadCatch m =>
HashMap Name (Type m)
-> ObjectType m
-> Location
-> Seq (Selection m)
-> m (Either Error (SourceEventStream m))
createSourceEventStream HashMap Name (Type m)
_types ObjectType m
subscriptionType Location
objectLocation Seq (Selection m)
fields
| [NonEmpty (Field m)
fieldGroup] <- forall v. OrderedMap v -> [v]
OrderedMap.elems OrderedMap (NonEmpty (Field m))
groupedFieldSet
, Transform.Field Maybe Name
_ Name
fieldName HashMap Name (Node Input)
arguments' Seq (Selection m)
_ Location
errorLocation <-
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty (Field m)
fieldGroup
, Out.ObjectType Name
_ Maybe Name
_ [InterfaceType m]
_ HashMap Name (Resolver m)
fieldTypes <- ObjectType m
subscriptionType
, Resolver m
resolverT <- HashMap Name (Resolver m)
fieldTypes forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! Name
fieldName
, Out.EventStreamResolver Field m
fieldDefinition Resolve m
_ Subscribe m
resolver <- Resolver m
resolverT
, Out.Field Maybe Name
_ Type m
_fieldType HashMap Name Argument
argumentDefinitions <- Field m
fieldDefinition =
case forall (m :: * -> *).
MonadCatch m =>
HashMap Name Argument -> HashMap Name (Node Input) -> m Subs
coerceArgumentValues HashMap Name Argument
argumentDefinitions HashMap Name (Node Input)
arguments' of
Left SomeException
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left
forall a b. (a -> b) -> a -> b
$ Name -> [Location] -> [Path] -> Error
Error Name
"Argument coercion failed." [Location
errorLocation] []
Right Subs
argumentValues -> forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ([Location] -> String -> Error
singleError [Location
errorLocation])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadCatch m =>
Value
-> Subs -> Subscribe m -> m (Either String (SourceEventStream m))
resolveFieldEventStream Value
Type.Null Subs
argumentValues Subscribe m
resolver
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left
forall a b. (a -> b) -> a -> b
$ Name -> [Location] -> [Path] -> Error
Error Name
"Subscription contains more than one field." [Location
objectLocation] []
where
groupedFieldSet :: OrderedMap (NonEmpty (Field m))
groupedFieldSet = forall (m :: * -> *).
Monad m =>
ObjectType m
-> Seq (Selection m) -> OrderedMap (NonEmpty (Field m))
collectFields ObjectType m
subscriptionType Seq (Selection m)
fields
singleError :: [Full.Location] -> String -> Error
singleError :: [Location] -> String -> Error
singleError [Location]
errorLocations String
message = Name -> [Location] -> [Path] -> Error
Error (String -> Name
Text.pack String
message) [Location]
errorLocations []
resolveFieldEventStream :: MonadCatch m
=> Type.Value
-> Type.Subs
-> Out.Subscribe m
-> m (Either String (Out.SourceEventStream m))
resolveFieldEventStream :: forall (m :: * -> *).
MonadCatch m =>
Value
-> Subs -> Subscribe m -> m (Either String (SourceEventStream m))
resolveFieldEventStream Value
result Subs
args Subscribe m
resolver =
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Subscribe m
resolver Context
context) forall (m :: * -> *).
MonadCatch m =>
ResolverException -> m (Either String (SourceEventStream m))
handleEventStreamError
where
handleEventStreamError :: MonadCatch m
=> ResolverException
-> m (Either String (Out.SourceEventStream m))
handleEventStreamError :: forall (m :: * -> *).
MonadCatch m =>
ResolverException -> m (Either String (SourceEventStream m))
handleEventStreamError = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> String
displayException
context :: Context
context = Type.Context
{ arguments :: Arguments
Type.arguments = Subs -> Arguments
Type.Arguments Subs
args
, values :: Value
Type.values = Value
result
}
executeSubscriptionEvent :: (MonadCatch m, Serialize a)
=> HashMap Full.Name (Type m)
-> Out.ObjectType m
-> Seq (Transform.Selection m)
-> Type.Value
-> m (Response a)
executeSubscriptionEvent :: forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
HashMap Name (Type m)
-> ObjectType m -> Seq (Selection m) -> Value -> m (Response a)
executeSubscriptionEvent HashMap Name (Type m)
types' ObjectType m
objectType Seq (Selection m)
fields Value
initialValue = do
(a
data', Seq Error
errors) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HashMap Name (Type m)
types'
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet Seq (Selection m)
fields ObjectType m
objectType Value
initialValue [])
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
FieldException -> ExecutorT m a
handleException
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq Error -> Response a
Response a
data' Seq Error
errors