diff options
Diffstat (limited to 'src/Language/GraphQL/Execute.hs')
| -rw-r--r-- | src/Language/GraphQL/Execute.hs | 50 |
1 files changed, 29 insertions, 21 deletions
diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs index 283e56c..62754a3 100644 --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ExplicitForAll #-} -- | This module provides functions to execute a @GraphQL@ request. module Language.GraphQL.Execute @@ -10,15 +10,22 @@ import Control.Monad.Catch (MonadCatch) import Data.HashMap.Strict (HashMap) import Data.Sequence (Seq(..)) import Data.Text (Text) -import Language.GraphQL.AST.Document (Document, Name) +import qualified Language.GraphQL.AST.Document as Full import Language.GraphQL.Execute.Coerce import Language.GraphQL.Execute.Execution +import Language.GraphQL.Execute.Internal import qualified Language.GraphQL.Execute.Transform as Transform import qualified Language.GraphQL.Execute.Subscribe as Subscribe import Language.GraphQL.Error + ( Error + , ResponseEventStream + , Response(..) + , runCollectErrs + ) import qualified Language.GraphQL.Type.Definition as Definition import qualified Language.GraphQL.Type.Out as Out import Language.GraphQL.Type.Schema +import Prelude hiding (null) -- | The substitution is applied to the document, and the resolvers are applied -- to the resulting fields. The operation name can be used if the document @@ -29,35 +36,36 @@ import Language.GraphQL.Type.Schema execute :: (MonadCatch m, VariableValue a, Serialize b) => Schema m -- ^ Resolvers. -> Maybe Text -- ^ Operation name. - -> HashMap Name a -- ^ Variable substitution function. - -> Document -- @GraphQL@ document. + -> HashMap Full.Name a -- ^ Variable substitution function. + -> Full.Document -- @GraphQL@ document. -> m (Either (ResponseEventStream m b) (Response b)) -execute schema' operationName subs document = - case Transform.document schema' operationName subs document of - Left queryError -> pure - $ Right - $ singleError - $ Transform.queryError queryError - Right transformed -> executeRequest transformed +execute schema' operationName subs document + = either (pure . rightErrorResponse . singleError [] . show) executeRequest + $ Transform.document schema' operationName subs document executeRequest :: (MonadCatch m, Serialize a) => Transform.Document m -> m (Either (ResponseEventStream m a) (Response a)) executeRequest (Transform.Document types' rootObjectType operation) - | (Transform.Query _ fields) <- operation = - Right <$> executeOperation types' rootObjectType fields - | (Transform.Mutation _ fields) <- operation = - Right <$> executeOperation types' rootObjectType fields - | (Transform.Subscription _ fields) <- operation - = either (Right . singleError) Left - <$> Subscribe.subscribe types' rootObjectType fields + | (Transform.Query _ fields objectLocation) <- operation = + Right <$> executeOperation types' rootObjectType objectLocation fields + | (Transform.Mutation _ fields objectLocation) <- operation = + Right <$> executeOperation types' rootObjectType objectLocation fields + | (Transform.Subscription _ fields objectLocation) <- operation + = either rightErrorResponse Left + <$> Subscribe.subscribe types' rootObjectType objectLocation fields -- This is actually executeMutation, but we don't distinguish between queries -- and mutations yet. executeOperation :: (MonadCatch m, Serialize a) - => HashMap Name (Type m) + => HashMap Full.Name (Type m) -> Out.ObjectType m + -> Full.Location -> Seq (Transform.Selection m) -> m (Response a) -executeOperation types' objectType fields = - runCollectErrs types' $ executeSelectionSet Definition.Null objectType fields +executeOperation types' objectType objectLocation fields + = runCollectErrs types' + $ executeSelectionSet Definition.Null objectType objectLocation fields + +rightErrorResponse :: Serialize b => forall a. Error -> Either a (Response b) +rightErrorResponse = Right . Response null . pure |