summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Language/GraphQL/Error.hs6
-rw-r--r--src/Language/GraphQL/Execute.hs10
-rw-r--r--src/Language/GraphQL/Execute/Execution.hs16
-rw-r--r--src/Language/GraphQL/Execute/Internal.hs17
-rw-r--r--src/Language/GraphQL/Execute/Subscribe.hs2
5 files changed, 32 insertions, 19 deletions
diff --git a/src/Language/GraphQL/Error.hs b/src/Language/GraphQL/Error.hs
index d3625a7..2061c20 100644
--- a/src/Language/GraphQL/Error.hs
+++ b/src/Language/GraphQL/Error.hs
@@ -69,21 +69,25 @@ parseError ParseErrorBundle{..} =
type CollectErrsT m = StateT (Resolution m) m
-- | Adds an error to the list of errors.
+{-# DEPRECATED #-}
addErr :: Monad m => Error -> CollectErrsT m ()
addErr v = modify appender
where
appender :: Monad m => Resolution m -> Resolution m
appender resolution@Resolution{..} = resolution{ errors = errors |> v }
+{-# DEPRECATED #-}
makeErrorMessage :: Text -> Error
makeErrorMessage s = Error s [] []
-- | Constructs a response object containing only the error with the given
-- message.
+{-# DEPRECATED #-}
singleError :: Serialize a => Text -> Response a
-singleError message = Response null $ Seq.singleton $ makeErrorMessage message
+singleError message = Response null $ Seq.singleton $ Error message [] []
-- | Convenience function for just wrapping an error message.
+{-# DEPRECATED #-}
addErrMsg :: (Monad m, Serialize a) => Text -> CollectErrsT m a
addErrMsg errorMessage = (addErr . makeErrorMessage) errorMessage >> pure null
diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs
index 3b262d5..6e46d7c 100644
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@@ -11,9 +11,10 @@ import Data.Text (Text)
import Language.GraphQL.AST.Document (Document, Name)
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
+import Language.GraphQL.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
@@ -32,10 +33,7 @@ execute :: (MonadCatch m, VariableValue a, Serialize b)
-> 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
+ Left queryError -> pure $ singleError $ Transform.queryError queryError
Right transformed -> executeRequest transformed
executeRequest :: (MonadCatch m, Serialize a)
@@ -47,7 +45,7 @@ executeRequest (Transform.Document types' rootObjectType operation)
| (Transform.Mutation _ fields) <- operation =
Right <$> executeOperation types' rootObjectType fields
| (Transform.Subscription _ fields) <- operation
- = either (Right . singleError) Left
+ = either singleError Left
<$> Subscribe.subscribe types' rootObjectType fields
-- This is actually executeMutation, but we don't distinguish between queries
diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs
index 38355ce..529c3b1 100644
--- a/src/Language/GraphQL/Execute/Execution.hs
+++ b/src/Language/GraphQL/Execute/Execution.hs
@@ -43,7 +43,7 @@ resolveFieldValue result args resolver =
=> ResolverException
-> CollectErrsT m Type.Value
handleFieldError e =
- addErr (Error (Text.pack $ displayException e) [] []) >> pure Type.Null
+ addError Type.Null $ Error (Text.pack $ displayException e) [] []
context = Type.Context
{ Type.arguments = Type.Arguments args
, Type.values = result
@@ -98,7 +98,7 @@ executeField fieldResolver prev fields
let Out.Field _ fieldType argumentDefinitions = fieldDefinition
let (Transform.Field _ _ arguments' _ :| []) = fields
case coerceArgumentValues argumentDefinitions arguments' of
- Nothing -> addErrMsg "Argument coercing failed."
+ Nothing -> addError null $ Error "Argument coercing failed." [] []
Just argumentValues -> do
answer <- resolveFieldValue prev argumentValues resolver
completeValue fieldType fields answer
@@ -124,7 +124,7 @@ completeValue outputType@(Out.EnumBaseType enumType) _ (Type.Enum enum) =
let Type.EnumType _ _ enumMembers = enumType
in if HashMap.member enum enumMembers
then coerceResult outputType $ Enum enum
- else addError $ Error "Enum value completion failed." [] []
+ else addError null $ Error "Enum value completion failed." [] []
completeValue (Out.ObjectBaseType objectType) fields result =
executeSelectionSet result objectType $ mergeSelectionSets fields
completeValue (Out.InterfaceBaseType interfaceType) fields result
@@ -134,7 +134,8 @@ completeValue (Out.InterfaceBaseType interfaceType) fields result
case concreteType of
Just objectType -> executeSelectionSet result objectType
$ mergeSelectionSets fields
- Nothing -> addErrMsg "Interface value completion failed."
+ Nothing -> addError null
+ $ Error "Interface value completion failed." [] []
completeValue (Out.UnionBaseType unionType) fields result
| Type.Object objectMap <- result = do
let abstractType = Internal.AbstractUnionType unionType
@@ -142,8 +143,9 @@ completeValue (Out.UnionBaseType unionType) fields result
case concreteType of
Just objectType -> executeSelectionSet result objectType
$ mergeSelectionSets fields
- Nothing -> addErrMsg "Union value completion failed."
-completeValue _ _ _ = addErrMsg "Value completion failed."
+ Nothing -> addError null
+ $ Error "Union value completion failed." [] []
+completeValue _ _ _ = addError null $ Error "Value completion failed." [] []
mergeSelectionSets :: MonadCatch m
=> NonEmpty (Transform.Field m)
@@ -159,7 +161,7 @@ coerceResult :: (MonadCatch m, Serialize a)
-> CollectErrsT m a
coerceResult outputType result
| Just serialized <- serialize outputType result = pure serialized
- | otherwise = addErrMsg "Result coercion failed."
+ | otherwise = addError null $ Error "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
diff --git a/src/Language/GraphQL/Execute/Internal.hs b/src/Language/GraphQL/Execute/Internal.hs
index 3b75da1..792a758 100644
--- a/src/Language/GraphQL/Execute/Internal.hs
+++ b/src/Language/GraphQL/Execute/Internal.hs
@@ -3,23 +3,34 @@
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE NamedFieldPuns #-}
module Language.GraphQL.Execute.Internal
( addError
+ , singleError
) where
import Control.Monad.Trans.State (modify)
import Control.Monad.Catch (MonadCatch)
import Data.Sequence ((|>))
-import Language.GraphQL.Error
+import Data.Text (Text)
import Language.GraphQL.Execute.Coerce
+import Language.GraphQL.Error
+ ( CollectErrsT
+ , Error(..)
+ , Resolution(..)
+ , Response(..)
+ )
import Prelude hiding (null)
-addError :: (Serialize a, MonadCatch m) => Error -> CollectErrsT m a
-addError error' = modify appender >> pure null
+addError :: MonadCatch m => forall a. a -> Error -> CollectErrsT m a
+addError returnValue error' = modify appender >> pure returnValue
where
appender :: Resolution m -> Resolution m
appender resolution@Resolution{ errors } = resolution
{ errors = errors |> error'
}
+
+singleError :: Serialize b => forall a. Text -> Either a (Response b)
+singleError message = Right $ Response null $ pure $ Error message [] []
diff --git a/src/Language/GraphQL/Execute/Subscribe.hs b/src/Language/GraphQL/Execute/Subscribe.hs
index 4f2a6a6..44be965 100644
--- a/src/Language/GraphQL/Execute/Subscribe.hs
+++ b/src/Language/GraphQL/Execute/Subscribe.hs
@@ -28,8 +28,6 @@ import qualified Language.GraphQL.Type as Type
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema
--- This is actually executeMutation, but we don't distinguish between queries
--- and mutations yet.
subscribe :: (MonadCatch m, Serialize a)
=> HashMap Name (Type m)
-> Out.ObjectType m
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-26 23:49:53 +0000