Fix resolvers returning a list in the reverse order

This commit is contained in:
Eugen Wissner 2023-02-24 17:14:43 +01:00
parent d83f75b341
commit 3b0da4f3d7
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
4 changed files with 31 additions and 13 deletions

View File

@ -11,6 +11,9 @@ and this project adheres to
- Partial schema printing: schema definition encoder. - Partial schema printing: schema definition encoder.
- `Semigroup` and `Monoid` instances for `AST.Document.Description`. - `Semigroup` and `Monoid` instances for `AST.Document.Description`.
### Fixed
- Fix resolvers returning a list in the reverse order.
## [1.1.0.0] - 2022-12-24 ## [1.1.0.0] - 2022-12-24
### Changed ### Changed
- Removed deprecated `Language.GraphQL.Error` functions: `addErr`, `addErrMsg`, - Removed deprecated `Language.GraphQL.Error` functions: `addErr`, `addErrMsg`,

View File

@ -110,7 +110,7 @@ test-suite graphql-test
conduit, conduit,
exceptions, exceptions,
graphql, graphql,
hspec ^>= 2.9.1, hspec ^>= 2.10.9,
hspec-expectations ^>= 0.8.2, hspec-expectations ^>= 0.8.2,
hspec-megaparsec ^>= 2.2.0, hspec-megaparsec ^>= 2.2.0,
megaparsec, megaparsec,

View File

@ -39,6 +39,7 @@ import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Sequence (Seq) import Data.Sequence (Seq)
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
import qualified Data.Vector as Vector
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import Data.Typeable (cast) import Data.Typeable (cast)
@ -466,12 +467,12 @@ completeValue :: (MonadCatch m, Serialize a)
completeValue (Out.isNonNullType -> False) _ _ Type.Null = completeValue (Out.isNonNullType -> False) _ _ Type.Null =
pure null pure null
completeValue outputType@(Out.ListBaseType listType) fields errorPath (Type.List list) completeValue outputType@(Out.ListBaseType listType) fields errorPath (Type.List list)
= foldM go (0, []) list >>= coerceResult outputType . List . snd = foldM go Vector.empty list >>= coerceResult outputType . List . Vector.toList
where where
go (index, accumulator) listItem = do go accumulator listItem =
let updatedPath = Index index : errorPath let updatedPath = Index (Vector.length accumulator) : errorPath
completedValue <- completeValue listType fields updatedPath listItem in Vector.snoc accumulator
pure (index + 1, completedValue : accumulator) <$> completeValue listType fields updatedPath listItem
completeValue outputType@(Out.ScalarBaseType _) _ _ (Type.Int int) = completeValue outputType@(Out.ScalarBaseType _) _ _ (Type.Int int) =
coerceResult outputType $ Int int coerceResult outputType $ Int int
completeValue outputType@(Out.ScalarBaseType _) _ _ (Type.Boolean boolean) = completeValue outputType@(Out.ScalarBaseType _) _ _ (Type.Boolean boolean) =

View File

@ -66,8 +66,9 @@ queryType :: Out.ObjectType IO
queryType = Out.ObjectType "Query" Nothing [] queryType = Out.ObjectType "Query" Nothing []
$ HashMap.fromList $ HashMap.fromList
[ ("philosopher", ValueResolver philosopherField philosopherResolver) [ ("philosopher", ValueResolver philosopherField philosopherResolver)
, ("genres", ValueResolver genresField genresResolver) , ("throwing", ValueResolver throwingField throwingResolver)
, ("count", ValueResolver countField countResolver) , ("count", ValueResolver countField countResolver)
, ("sequence", ValueResolver sequenceField sequenceResolver)
] ]
where where
philosopherField = philosopherField =
@ -75,15 +76,22 @@ queryType = Out.ObjectType "Query" Nothing []
$ HashMap.singleton "id" $ HashMap.singleton "id"
$ In.Argument Nothing (In.NamedScalarType id) Nothing $ In.Argument Nothing (In.NamedScalarType id) Nothing
philosopherResolver = pure $ Object mempty philosopherResolver = pure $ Object mempty
genresField = throwingField =
let fieldType = Out.ListType $ Out.NonNullScalarType string let fieldType = Out.ListType $ Out.NonNullScalarType string
in Out.Field Nothing fieldType HashMap.empty in Out.Field Nothing fieldType HashMap.empty
genresResolver :: Resolve IO throwingResolver :: Resolve IO
genresResolver = throwM PhilosopherException throwingResolver = throwM PhilosopherException
countField = countField =
let fieldType = Out.NonNullScalarType int let fieldType = Out.NonNullScalarType int
in Out.Field Nothing fieldType HashMap.empty in Out.Field Nothing fieldType HashMap.empty
countResolver = pure "" countResolver = pure ""
sequenceField =
let fieldType = Out.ListType $ Out.NonNullScalarType int
in Out.Field Nothing fieldType HashMap.empty
sequenceResolver = pure intSequence
intSequence :: Value
intSequence = Type.List [Type.Int 1, Type.Int 2, Type.Int 3]
musicType :: Out.ObjectType IO musicType :: Out.ObjectType IO
musicType = Out.ObjectType "Music" Nothing [] musicType = Out.ObjectType "Music" Nothing []
@ -344,14 +352,14 @@ spec =
in sourceQuery `shouldResolveTo` expected in sourceQuery `shouldResolveTo` expected
it "gives location information for failed result coercion" $ it "gives location information for failed result coercion" $
let data'' = Object $ HashMap.singleton "genres" Null let data'' = Object $ HashMap.singleton "throwing" Null
executionErrors = pure $ Error executionErrors = pure $ Error
{ message = "PhilosopherException" { message = "PhilosopherException"
, locations = [Location 1 3] , locations = [Location 1 3]
, path = [Segment "genres"] , path = [Segment "throwing"]
} }
expected = Response data'' executionErrors expected = Response data'' executionErrors
sourceQuery = "{ genres }" sourceQuery = "{ throwing }"
in sourceQuery `shouldResolveTo` expected in sourceQuery `shouldResolveTo` expected
it "sets data to null if a root field isn't nullable" $ it "sets data to null if a root field isn't nullable" $
@ -375,6 +383,12 @@ spec =
sourceQuery = "{ philosopher(id: \"1\") { firstLanguage } }" sourceQuery = "{ philosopher(id: \"1\") { firstLanguage } }"
in sourceQuery `shouldResolveTo` expected in sourceQuery `shouldResolveTo` expected
it "returns list elements in the original order" $
let data'' = Object $ HashMap.singleton "sequence" intSequence
expected = Response data'' mempty
sourceQuery = "{ sequence }"
in sourceQuery `shouldResolveTo` expected
context "queryError" $ do context "queryError" $ do
let namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }" let namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }"
twoQueries = namedQuery "A" <> " " <> namedQuery "B" twoQueries = namedQuery "A" <> " " <> namedQuery "B"