diff options
Diffstat (limited to 'src/Language/GraphQL/Execute')
| -rw-r--r-- | src/Language/GraphQL/Execute/Execution.hs | 16 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute/Internal.hs | 17 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute/Subscribe.hs | 2 |
3 files changed, 23 insertions, 12 deletions
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 |