Fix list input coercion

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.
 

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:

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.

stack.yaml

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

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

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

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)
 

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

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

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)