fix index position in error path

This commit is contained in:
Dmitrii Skurikhin
2022-01-04 14:40:41 +03:00
committed by Eugen Wissner
parent 16cbe3fc28
commit 1f7bd92d11
5 changed files with 100 additions and 7 deletions

View File

@ -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

View File

@ -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))
]