diff options
| -rw-r--r-- | CHANGELOG.md | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL/Error.hs | 6 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute.hs | 10 | ||||
| -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 | ||||
| -rw-r--r-- | tests/Language/GraphQL/ErrorSpec.hs | 34 |
7 files changed, 57 insertions, 30 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md index ad90db9..b18668a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,6 +23,8 @@ and this project adheres to ### Changed - `AST.Document.Value.List` and `AST.Document.ConstValue.ConstList` contain location information for each list item. +- `Error`: `singleError`, `addErr` and `addErrMsg` are deprecated. They are + internal functions used by the executor for error handling. ## [0.11.1.0] - 2021-02-07 ### Added 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 diff --git a/tests/Language/GraphQL/ErrorSpec.hs b/tests/Language/GraphQL/ErrorSpec.hs index 38d7d3a..f64e70a 100644 --- a/tests/Language/GraphQL/ErrorSpec.hs +++ b/tests/Language/GraphQL/ErrorSpec.hs @@ -8,17 +8,29 @@ module Language.GraphQL.ErrorSpec ) where import qualified Data.Aeson as Aeson -import qualified Data.Sequence as Seq +import Data.List.NonEmpty (NonEmpty (..)) import Language.GraphQL.Error -import Test.Hspec ( Spec - , describe - , it - , shouldBe - ) +import Test.Hspec + ( Spec + , describe + , it + , shouldBe + ) +import Text.Megaparsec (PosState(..)) +import Text.Megaparsec.Error (ParseError(..), ParseErrorBundle(..)) +import Text.Megaparsec.Pos (SourcePos(..), mkPos) spec :: Spec -spec = describe "singleError" $ - it "constructs an error with the given message" $ - let errors'' = Seq.singleton $ Error "Message." [] [] - expected = Response Aeson.Null errors'' - in singleError "Message." `shouldBe` expected +spec = describe "parseError" $ + it "generates response with a single error" $ do + let parseErrors = TrivialError 0 Nothing mempty :| [] + posState = PosState + { pstateInput = "" + , pstateOffset = 0 + , pstateSourcePos = SourcePos "" (mkPos 1) (mkPos 1) + , pstateTabWidth = mkPos 1 + , pstateLinePrefix = "" + } + Response Aeson.Null actual <- + parseError (ParseErrorBundle parseErrors posState) + length actual `shouldBe` 1 |