diff options
| -rw-r--r-- | CHANGELOG.md | 3 | ||||
| -rw-r--r-- | graphql.cabal | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute.hs | 11 | ||||
| -rw-r--r-- | tests/Language/GraphQL/ExecuteSpec.hs | 28 |
4 files changed, 31 insertions, 13 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md index 4f62859..d731913 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,9 @@ and this project adheres to - Partial schema printing: schema definition encoder. - `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 ### Changed - Removed deprecated `Language.GraphQL.Error` functions: `addErr`, `addErrMsg`, diff --git a/graphql.cabal b/graphql.cabal index ce00f3c..dde2128 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -110,7 +110,7 @@ test-suite graphql-test conduit, exceptions, graphql, - hspec ^>= 2.9.1, + hspec ^>= 2.10.9, hspec-expectations ^>= 0.8.2, hspec-megaparsec ^>= 2.2.0, megaparsec, diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs index 5ceb616..bbacdd2 100644 --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -39,6 +39,7 @@ import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (fromMaybe) import Data.Sequence (Seq) import qualified Data.Sequence as Seq +import qualified Data.Vector as Vector import Data.Text (Text) import qualified Data.Text as Text import Data.Typeable (cast) @@ -466,12 +467,12 @@ completeValue :: (MonadCatch m, Serialize a) completeValue (Out.isNonNullType -> False) _ _ Type.Null = pure null 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 - go (index, accumulator) listItem = do - let updatedPath = Index index : errorPath - completedValue <- completeValue listType fields updatedPath listItem - pure (index + 1, completedValue : accumulator) + go accumulator listItem = + let updatedPath = Index (Vector.length accumulator) : errorPath + in Vector.snoc accumulator + <$> completeValue listType fields updatedPath listItem completeValue outputType@(Out.ScalarBaseType _) _ _ (Type.Int int) = coerceResult outputType $ Int int completeValue outputType@(Out.ScalarBaseType _) _ _ (Type.Boolean boolean) = diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs index c313df0..65033ae 100644 --- a/tests/Language/GraphQL/ExecuteSpec.hs +++ b/tests/Language/GraphQL/ExecuteSpec.hs @@ -66,8 +66,9 @@ queryType :: Out.ObjectType IO queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList [ ("philosopher", ValueResolver philosopherField philosopherResolver) - , ("genres", ValueResolver genresField genresResolver) + , ("throwing", ValueResolver throwingField throwingResolver) , ("count", ValueResolver countField countResolver) + , ("sequence", ValueResolver sequenceField sequenceResolver) ] where philosopherField = @@ -75,15 +76,22 @@ queryType = Out.ObjectType "Query" Nothing [] $ HashMap.singleton "id" $ In.Argument Nothing (In.NamedScalarType id) Nothing philosopherResolver = pure $ Object mempty - genresField = + throwingField = let fieldType = Out.ListType $ Out.NonNullScalarType string in Out.Field Nothing fieldType HashMap.empty - genresResolver :: Resolve IO - genresResolver = throwM PhilosopherException + throwingResolver :: Resolve IO + throwingResolver = throwM PhilosopherException countField = let fieldType = Out.NonNullScalarType int in Out.Field Nothing fieldType HashMap.empty 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 "Music" Nothing [] @@ -344,14 +352,14 @@ spec = in sourceQuery `shouldResolveTo` expected 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 { message = "PhilosopherException" , locations = [Location 1 3] - , path = [Segment "genres"] + , path = [Segment "throwing"] } expected = Response data'' executionErrors - sourceQuery = "{ genres }" + sourceQuery = "{ throwing }" in sourceQuery `shouldResolveTo` expected it "sets data to null if a root field isn't nullable" $ @@ -375,6 +383,12 @@ spec = sourceQuery = "{ philosopher(id: \"1\") { firstLanguage } }" 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 let namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }" twoQueries = namedQuery "A" <> " " <> namedQuery "B" |