Fix list input coercion

This commit is contained in:
Eugen Wissner 2020-06-19 10:53:41 +02:00
parent 882276a845
commit 91bd2d0d81
10 changed files with 31 additions and 13 deletions

View File

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

View File

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

View File

@ -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
@ -161,6 +163,15 @@ coerceInputLiteral (In.InputObjectBaseType type') (Type.Object values) =
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.

View File

@ -1,4 +1,4 @@
resolver: lts-16.0
resolver: lts-16.1
packages:
- .

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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