Provide an internal function to add errors

The old function, addErrMsg, takes only a string with an error
description, but more information is required for the execution errors:
locations and path. addErrMsg should be deprecated after the switching
to the new addError.

4 files changed, 57 insertions, 2 deletions

diff --git a/graphql.cabal b/graphql.cabal
index b2316de..0d9b231 100644
--- a/graphql.cabal
+++ b/graphql.cabal
@@ -47,6 +47,7 @@ library
       Test.Hspec.GraphQL
   other-modules:
       Language.GraphQL.Execute.Execution
+      Language.GraphQL.Execute.Internal
       Language.GraphQL.Execute.Subscribe
       Language.GraphQL.Execute.Transform
       Language.GraphQL.Type.Definition
diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs
index 0ea361d..38355ce 100644
--- a/src/Language/GraphQL/Execute/Execution.hs
+++ b/src/Language/GraphQL/Execute/Execution.hs
@@ -21,6 +21,7 @@ import qualified Data.Text as Text
 import Language.GraphQL.AST (Name)
 import Language.GraphQL.Error
 import Language.GraphQL.Execute.Coerce
+import Language.GraphQL.Execute.Internal
 import Language.GraphQL.Execute.OrderedMap (OrderedMap)
 import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
 import qualified Language.GraphQL.Execute.Transform as Transform
@@ -123,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 addErrMsg "Enum value completion failed."
+        else addError $ Error "Enum value completion failed." [] []
 completeValue (Out.ObjectBaseType objectType) fields result =
     executeSelectionSet result objectType $ mergeSelectionSets fields
 completeValue (Out.InterfaceBaseType interfaceType) fields result
diff --git a/src/Language/GraphQL/Execute/Internal.hs b/src/Language/GraphQL/Execute/Internal.hs
new file mode 100644
index 0000000..3b75da1
--- /dev/null
+++ b/src/Language/GraphQL/Execute/Internal.hs
@@ -0,0 +1,25 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Language.GraphQL.Execute.Internal
+    ( addError
+    ) where
+
+import Control.Monad.Trans.State (modify)
+import Control.Monad.Catch (MonadCatch)
+import Data.Sequence ((|>))
+import Language.GraphQL.Error
+import Language.GraphQL.Execute.Coerce
+import Prelude hiding (null)
+
+addError :: (Serialize a, MonadCatch m) => Error -> CollectErrsT m a
+addError error' = modify appender >> pure null
+  where
+   appender :: Resolution m -> Resolution m
+   appender resolution@Resolution{ errors } = resolution
+       { errors = errors |> error'
+       }
diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs
index f6e3e6f..3288371 100644
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@@ -30,7 +30,7 @@ philosopherSchema = schema queryType Nothing (Just subscriptionType) mempty
 
 queryType :: Out.ObjectType (Either SomeException)
 queryType = Out.ObjectType "Query" Nothing []
-    $ HashMap.singleton "philosopher" 
+    $ HashMap.singleton "philosopher"
     $ ValueResolver philosopherField
     $ pure $ Type.Object mempty
   where
@@ -44,6 +44,7 @@ philosopherType = Out.ObjectType "Philosopher" Nothing []
     resolvers =
         [ ("firstName", ValueResolver firstNameField firstNameResolver)
         , ("lastName", ValueResolver lastNameField lastNameResolver)
+        , ("school", ValueResolver schoolField schoolResolver)
         ]
     firstNameField =
         Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
@@ -51,6 +52,9 @@ philosopherType = Out.ObjectType "Philosopher" Nothing []
     lastNameField
         = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
     lastNameResolver = pure $ Type.String "Nietzsche"
+    schoolField
+       = Out.Field Nothing (Out.NonNullEnumType schoolType) HashMap.empty
+    schoolResolver = pure $ Type.Enum "EXISTENTIALISM"
 
 subscriptionType :: Out.ObjectType (Either SomeException)
 subscriptionType = Out.ObjectType "Subscription" Nothing []
@@ -70,6 +74,13 @@ quoteType = Out.ObjectType "Quote" Nothing []
     quoteField =
         Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
 
+schoolType :: EnumType
+schoolType = EnumType "School" Nothing $ HashMap.fromList
+    [ ("NOMINALISM", EnumValue Nothing)
+    , ("REALISM", EnumValue Nothing)
+    , ("IDEALISM", EnumValue Nothing)
+    ]
+
 type EitherStreamOrValue = Either
     (ResponseEventStream (Either SomeException) Aeson.Value)
     (Response Aeson.Value)
@@ -118,6 +129,23 @@ spec =
                     Right (Right actual) = either (pure . parseError) execute'
                         $ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
                 in actual `shouldBe` expected
+
+            it "errors on invalid output enum values" $
+                let data'' = Aeson.object
+                        [ "philosopher" .= Aeson.object
+                            [ "school" .= Aeson.Null
+                            ]
+                        ]
+                    executionErrors = pure $ Error
+                        { message = "Enum value completion failed."
+                        , locations = []
+                        , path = []
+                        }
+                    expected = Response data'' executionErrors
+                    Right (Right actual) = either (pure . parseError) execute'
+                        $ parse document "" "{ philosopher { school } }"
+                in actual `shouldBe` expected
+
         context "Subscription" $
             it "subscribes" $
                 let data'' = Aeson.object