Fix list input coercion

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)