summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/Language/GraphQL/ExecuteSpec.hs16
-rw-r--r--tests/Schemas/HeroSchema.hs70
2 files changed, 86 insertions, 0 deletions
diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs
index 5eafb2e..f4e599a 100644
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@@ -4,6 +4,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
+
module Language.GraphQL.ExecuteSpec
( spec
) where
@@ -26,6 +27,9 @@ import qualified Language.GraphQL.Type.Out as Out
import Prelude hiding (id)
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Text.Megaparsec (parse)
+import Schemas.HeroSchema (heroSchema)
+import Data.Maybe (fromJust)
+import qualified Data.Sequence as Seq
data PhilosopherException = PhilosopherException
deriving Show
@@ -335,6 +339,18 @@ spec =
$ parse document "" "{ philosopher(id: \"1\") { firstLanguage } }"
in actual `shouldBe` expected
+ context "Error path" $ do
+ let executeHero :: Document -> Either SomeException EitherStreamOrValue
+ executeHero = execute heroSchema Nothing (HashMap.empty :: HashMap Name Value)
+
+ it "at the beggining of the list" $
+ let Right (Right actual) = either (pure . parseError) executeHero
+ $ parse document "" "{ hero(id: \"1\") { friends { name } } }"
+ Response _ errors' = actual
+ Error _ _ path' = fromJust $ Seq.lookup 0 errors'
+ expected = [Segment "hero", Segment "friends", Index 0, Segment "name"]
+ in path' `shouldBe` expected
+
context "Subscription" $
it "subscribes" $
let data'' = Object
diff --git a/tests/Schemas/HeroSchema.hs b/tests/Schemas/HeroSchema.hs
new file mode 100644
index 0000000..71b7a10
--- /dev/null
+++ b/tests/Schemas/HeroSchema.hs
@@ -0,0 +1,70 @@
+{- 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 OverloadedStrings #-}
+
+module Schemas.HeroSchema (heroSchema) where
+
+import Control.Exception (Exception(..), SomeException)
+import Control.Monad.Catch (throwM)
+import Language.GraphQL.Error (ResolverException (..))
+import qualified Language.GraphQL.Type.In as In
+import qualified Language.GraphQL.Type as Type
+import Language.GraphQL.Type.Schema (schemaWithTypes)
+import qualified Data.HashMap.Strict as HashMap
+import Data.Typeable (cast)
+import qualified Language.GraphQL.Type.Out as Out
+
+data HeroException = HeroException
+ deriving Show
+
+instance Exception HeroException where
+ toException = toException. ResolverException
+ fromException e = do
+ ResolverException resolverException <- fromException e
+ cast resolverException
+
+heroSchema :: Type.Schema (Either SomeException)
+heroSchema =
+ schemaWithTypes Nothing queryType Nothing Nothing [] mempty
+
+type ObjectType = Out.ObjectType (Either SomeException)
+
+queryType :: ObjectType
+queryType = Out.ObjectType "Query" Nothing []
+ $ HashMap.fromList
+ [ ("hero", Out.ValueResolver heroField heroResolver)
+ ]
+ where
+ heroField = Out.Field Nothing (Out.NamedObjectType heroType)
+ $ HashMap.singleton "id"
+ $ In.Argument Nothing (In.NamedScalarType Type.id) Nothing
+ heroResolver = pure $ Type.Object mempty
+
+stringField :: Out.Field (Either SomeException)
+stringField = Out.Field Nothing (Out.NonNullScalarType Type.string) HashMap.empty
+
+heroType :: ObjectType
+heroType = Out.ObjectType "Hero" Nothing [] $ HashMap.fromList resolvers
+ where
+ resolvers =
+ [ ("id", Out.ValueResolver stringField (pure $ Type.String "4111"))
+ , ("name", Out.ValueResolver stringField (pure $ Type.String "R2D2"))
+ , ("friends", Out.ValueResolver friendsField (pure $ Type.List [luke]))
+ ]
+ friendsField = Out.Field Nothing (Out.ListType $ Out.NonNullObjectType lukeType) HashMap.empty
+ -- This list values are ignored because of current realisation (types and resolvers are the same entity)
+ -- The values from lukeType will be used
+ luke = Type.Object $ HashMap.fromList
+ [ ("id", "dfdfdf")
+ , ("name", "dfdfdff")
+ ]
+
+lukeType :: ObjectType
+lukeType = Out.ObjectType "Luke" Nothing [] $ HashMap.fromList resolvers
+ where
+ resolvers =
+ [ ("id", Out.ValueResolver stringField (pure $ Type.String "1000"))
+ , ("name", Out.ValueResolver stringField (throwM HeroException))
+ ]