From 91bd2d0d8155469b28749a6458e0f7a9279e3698 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Fri, 19 Jun 2020 10:53:41 +0200 Subject: [PATCH] Fix list input coercion --- CHANGELOG.md | 1 + package.yaml | 2 ++ src/Language/GraphQL/Execute/Coerce.hs | 13 ++++++++++++- stack.yaml | 2 +- tests/Language/GraphQL/Execute/CoerceSpec.hs | 12 ++++++++++-- tests/Language/GraphQL/Type/OutSpec.hs | 2 +- tests/Test/DirectiveSpec.hs | 3 +-- tests/Test/FragmentSpec.hs | 3 +-- tests/Test/RootOperationSpec.hs | 3 +-- tests/Test/StarWars/Schema.hs | 3 +-- 10 files changed, 31 insertions(+), 13 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a0268bd..1480af9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,7 @@ and this project adheres to * Invalid (recusrive or non-existing) fragments should be skipped. - Argument value coercion. - Variable value coercion. +- Result coercion. - The executor should skip the fields missing in the object type and not fail. - Merging subselections. diff --git a/package.yaml b/package.yaml index e53d23d..1186a24 100644 --- a/package.yaml +++ b/package.yaml @@ -42,7 +42,9 @@ library: other-modules: - Language.GraphQL.Execute.Execution - Language.GraphQL.Execute.Transform + - Language.GraphQL.Type.Definition - Language.GraphQL.Type.Directive + - Language.GraphQL.Type.Schema tests: tasty: diff --git a/src/Language/GraphQL/Execute/Coerce.hs b/src/Language/GraphQL/Execute/Coerce.hs index 88ab412..60fb71d 100644 --- a/src/Language/GraphQL/Execute/Coerce.hs +++ b/src/Language/GraphQL/Execute/Coerce.hs @@ -1,5 +1,6 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} -- | Types and functions used for input and result coercion. module Language.GraphQL.Execute.Coerce @@ -129,6 +130,7 @@ matchFieldValues coerce values' fieldName type' defaultValue resultMap = -- | Coerces operation arguments according to the input coercion rules for the -- corresponding types. coerceInputLiteral :: In.Type -> Type.Value -> Maybe Type.Value +coerceInputLiteral (In.isNonNullType -> False) Type.Null = Just Type.Null coerceInputLiteral (In.ScalarBaseType type') value | (Type.String stringValue) <- value , (Type.ScalarType "String" _) <- type' = Just $ Type.String stringValue @@ -156,11 +158,20 @@ coerceInputLiteral (In.EnumBaseType type') (Type.Enum enumValue) member value (Type.EnumType _ _ members) = HashMap.member value members coerceInputLiteral (In.InputObjectBaseType type') (Type.Object values) = let (In.InputObjectType _ _ inputFields) = type' - in Type.Object + in Type.Object <$> HashMap.foldrWithKey (matchFieldValues' values) (Just HashMap.empty) inputFields where matchFieldValues' values' fieldName (In.InputField _ inputFieldType defaultValue) = matchFieldValues coerceInputLiteral values' fieldName inputFieldType defaultValue +coerceInputLiteral (In.ListBaseType listType) (Type.List list) = + Type.List <$> traverse (coerceInputLiteral listType) list +coerceInputLiteral (In.ListBaseType listType) singleton = + wrapSingleton listType singleton + where + wrapSingleton (In.ListBaseType listType') singleton' = + Type.List <$> sequence [wrapSingleton listType' singleton'] + wrapSingleton listType' singleton' = + Type.List <$> sequence [coerceInputLiteral listType' singleton'] coerceInputLiteral _ _ = Nothing -- | 'Serialize' describes how a @GraphQL@ value should be serialized. diff --git a/stack.yaml b/stack.yaml index 4df91ed..a037a72 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-16.0 +resolver: lts-16.1 packages: - . diff --git a/tests/Language/GraphQL/Execute/CoerceSpec.hs b/tests/Language/GraphQL/Execute/CoerceSpec.hs index e39d550..339c2e3 100644 --- a/tests/Language/GraphQL/Execute/CoerceSpec.hs +++ b/tests/Language/GraphQL/Execute/CoerceSpec.hs @@ -10,7 +10,7 @@ import qualified Data.HashMap.Strict as HashMap import Data.Maybe (isNothing) import Data.Scientific (scientific) import qualified Language.GraphQL.Execute.Coerce as Coerce -import Language.GraphQL.Type.Definition +import Language.GraphQL.Type import qualified Language.GraphQL.Type.In as In import Prelude hiding (id) import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) @@ -98,7 +98,7 @@ spec = do expected = Just $ List [String "asdf", String "qwer"] in actual `shouldBe` expected - describe "coerceInputLiterals" $ do + describe "coerceInputLiteral" $ do it "coerces enums" $ let expected = Just (Enum "NORTH") actual = Coerce.coerceInputLiteral @@ -112,3 +112,11 @@ spec = do let expected = Just (String "1234") actual = Coerce.coerceInputLiteral namedIdType (Int 1234) in actual `shouldBe` expected + it "coerces nulls" $ do + let actual = Coerce.coerceInputLiteral namedIdType Null + in actual `shouldBe` Just Null + it "wraps singleton lists" $ do + let expected = Just $ List [List [String "1"]] + embeddedType = In.ListType $ In.ListType namedIdType + actual = Coerce.coerceInputLiteral embeddedType (String "1") + in actual `shouldBe` expected diff --git a/tests/Language/GraphQL/Type/OutSpec.hs b/tests/Language/GraphQL/Type/OutSpec.hs index bdc2094..eecc374 100644 --- a/tests/Language/GraphQL/Type/OutSpec.hs +++ b/tests/Language/GraphQL/Type/OutSpec.hs @@ -3,7 +3,7 @@ module Language.GraphQL.Type.OutSpec ( spec ) where -import Language.GraphQL.Type.Definition +import Language.GraphQL.Type import Test.Hspec (Spec, describe, it, shouldBe) spec :: Spec diff --git a/tests/Test/DirectiveSpec.hs b/tests/Test/DirectiveSpec.hs index ca1103b..b147d77 100644 --- a/tests/Test/DirectiveSpec.hs +++ b/tests/Test/DirectiveSpec.hs @@ -8,9 +8,8 @@ import Data.Aeson (object, (.=)) import qualified Data.Aeson as Aeson import qualified Data.HashMap.Strict as HashMap import Language.GraphQL -import Language.GraphQL.Type.Definition +import Language.GraphQL.Type import qualified Language.GraphQL.Type.Out as Out -import Language.GraphQL.Type.Schema (Schema(..)) import Test.Hspec (Spec, describe, it, shouldBe) import Text.RawString.QQ (r) diff --git a/tests/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs index 0737706..2924e63 100644 --- a/tests/Test/FragmentSpec.hs +++ b/tests/Test/FragmentSpec.hs @@ -9,9 +9,8 @@ import qualified Data.Aeson as Aeson import qualified Data.HashMap.Strict as HashMap import Data.Text (Text) import Language.GraphQL -import Language.GraphQL.Type.Definition +import Language.GraphQL.Type import qualified Language.GraphQL.Type.Out as Out -import Language.GraphQL.Type.Schema import Test.Hspec ( Spec , describe diff --git a/tests/Test/RootOperationSpec.hs b/tests/Test/RootOperationSpec.hs index 922e098..0e534fc 100644 --- a/tests/Test/RootOperationSpec.hs +++ b/tests/Test/RootOperationSpec.hs @@ -9,9 +9,8 @@ import qualified Data.HashMap.Strict as HashMap import Language.GraphQL import Test.Hspec (Spec, describe, it, shouldBe) import Text.RawString.QQ (r) -import Language.GraphQL.Type.Definition +import Language.GraphQL.Type import qualified Language.GraphQL.Type.Out as Out -import Language.GraphQL.Type.Schema hatType :: Out.ObjectType IO hatType = Out.ObjectType "Hat" Nothing [] diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs index c9f1bed..5fcdf3e 100644 --- a/tests/Test/StarWars/Schema.hs +++ b/tests/Test/StarWars/Schema.hs @@ -12,10 +12,9 @@ import qualified Data.HashMap.Strict as HashMap import Data.Maybe (catMaybes) import Data.Text (Text) import Language.GraphQL.Trans -import Language.GraphQL.Type.Definition +import Language.GraphQL.Type import qualified Language.GraphQL.Type.In as In import qualified Language.GraphQL.Type.Out as Out -import Language.GraphQL.Type.Schema (Schema(..)) import Test.StarWars.Data import Prelude hiding (id)