Coerce result

Fixes #45.

tests/Language/GraphQL/Execute/CoerceSpec.hs

@@ -9,7 +9,7 @@ import qualified Data.Aeson.Types as Aeson
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (isNothing)
 import Data.Scientific (scientific)
-import Language.GraphQL.Execute.Coerce
+import qualified Language.GraphQL.Execute.Coerce as Coerce
 import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Type.In as In
 import Prelude hiding (id)
@@ -30,55 +30,58 @@ singletonInputObject = In.NamedInputObjectType type'
     inputFields = HashMap.singleton "field" field
     field = In.InputField Nothing (In.NamedScalarType string) Nothing
 
+namedIdType :: In.Type
+namedIdType = In.NamedScalarType id
+
 spec :: Spec
 spec = do
     describe "VariableValue Aeson" $ do
         it "coerces strings" $
             let expected = Just (String "asdf")
-                actual = coerceVariableValue
+                actual = Coerce.coerceVariableValue
                     (In.NamedScalarType string) (Aeson.String "asdf")
              in actual `shouldBe` expected
         it "coerces non-null strings" $
             let expected = Just (String "asdf")
-                actual = coerceVariableValue
+                actual = Coerce.coerceVariableValue
                     (In.NonNullScalarType string) (Aeson.String "asdf")
              in actual `shouldBe` expected
         it "coerces booleans" $
             let expected = Just (Boolean True)
-                actual = coerceVariableValue
+                actual = Coerce.coerceVariableValue
                     (In.NamedScalarType boolean) (Aeson.Bool True)
              in actual `shouldBe` expected
         it "coerces zero to an integer" $
             let expected = Just (Int 0)
-                actual = coerceVariableValue
+                actual = Coerce.coerceVariableValue
                     (In.NamedScalarType int) (Aeson.Number 0)
              in actual `shouldBe` expected
         it "rejects fractional if an integer is expected" $
-            let actual = coerceVariableValue
+            let actual = Coerce.coerceVariableValue
                     (In.NamedScalarType int) (Aeson.Number $ scientific 14 (-1))
              in actual `shouldSatisfy` isNothing
         it "coerces float numbers" $
             let expected = Just (Float 1.4)
-                actual = coerceVariableValue
+                actual = Coerce.coerceVariableValue
                     (In.NamedScalarType float) (Aeson.Number $ scientific 14 (-1))
              in actual `shouldBe` expected
         it "coerces IDs" $
             let expected = Just (String "1234")
-                actual = coerceVariableValue
-                    (In.NamedScalarType id) (Aeson.String "1234")
+                json = Aeson.String "1234"
+                actual = Coerce.coerceVariableValue namedIdType json
              in actual `shouldBe` expected
         it "coerces input objects" $
-            let actual = coerceVariableValue singletonInputObject
+            let actual = Coerce.coerceVariableValue singletonInputObject
                     $ Aeson.object ["field" .= ("asdf" :: Aeson.Value)]
                 expected = Just $ Object $ HashMap.singleton "field" "asdf"
              in actual `shouldBe` expected
         it "skips the field if it is missing in the variables" $
-            let actual = coerceVariableValue
+            let actual = Coerce.coerceVariableValue
                     singletonInputObject Aeson.emptyObject
                 expected = Just $ Object HashMap.empty
              in actual `shouldBe` expected
         it "fails if input object value contains extra fields" $
-            let actual = coerceVariableValue singletonInputObject
+            let actual = Coerce.coerceVariableValue singletonInputObject
                     $ Aeson.object variableFields
                 variableFields =
                     [ "field" .= ("asdf" :: Aeson.Value)
@@ -86,26 +89,26 @@ spec = do
                     ]
              in actual `shouldSatisfy` isNothing
         it "preserves null" $
-            let actual = coerceVariableValue (In.NamedScalarType id) Aeson.Null
+            let actual = Coerce.coerceVariableValue namedIdType Aeson.Null
              in actual `shouldBe` Just Null
         it "preserves list order" $
             let list = Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"]
                 listType = (In.ListType $ In.NamedScalarType string)
-                actual = coerceVariableValue listType list
+                actual = Coerce.coerceVariableValue listType list
                 expected = Just $ List [String "asdf", String "qwer"]
              in actual `shouldBe` expected
 
     describe "coerceInputLiterals" $ do
         it "coerces enums" $
             let expected = Just (Enum "NORTH")
-                actual = coerceInputLiteral
+                actual = Coerce.coerceInputLiteral
                     (In.NamedEnumType direction) (Enum "NORTH")
              in actual `shouldBe` expected
         it "fails with non-existing enum value" $
-            let actual = coerceInputLiteral
+            let actual = Coerce.coerceInputLiteral
                     (In.NamedEnumType direction) (Enum "NORTH_EAST")
              in actual `shouldSatisfy` isNothing
         it "coerces integers to IDs" $
             let expected = Just (String "1234")
-                actual = coerceInputLiteral (In.NamedScalarType id) (Int 1234)
+                actual = Coerce.coerceInputLiteral namedIdType (Int 1234)
              in actual `shouldBe` expected

tests/Language/GraphQL/ExecuteSpec.hs

@@ -12,7 +12,7 @@ import Language.GraphQL.AST (Name)
 import Language.GraphQL.AST.Parser (document)
 import Language.GraphQL.Error
 import Language.GraphQL.Execute
-import Language.GraphQL.Type
+import Language.GraphQL.Type as Type
 import Language.GraphQL.Type.Out as Out
 import Test.Hspec (Spec, describe, it, shouldBe)
 import Text.Megaparsec (parse)
@@ -25,7 +25,7 @@ queryType = Out.ObjectType "Query" Nothing []
     $ HashMap.singleton "philosopher"
     $ Out.Resolver philosopherField
     $ pure
-    $ Object mempty
+    $ Type.Object mempty
   where
     philosopherField =
         Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
@@ -38,8 +38,8 @@ philosopherType = Out.ObjectType "Philosopher" Nothing []
         [ ("firstName", firstNameResolver)
         , ("lastName", lastNameResolver)
         ]
-    firstNameResolver = Out.Resolver firstNameField $ pure $ String "Friedrich"
-    lastNameResolver = Out.Resolver lastNameField $ pure $ String "Nietzsche"
+    firstNameResolver = Out.Resolver firstNameField $ pure $ Type.String "Friedrich"
+    lastNameResolver = Out.Resolver lastNameField $ pure $ Type.String "Nietzsche"
     firstNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
     lastNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
 

tests/Test/StarWars/Data.hs

@@ -184,7 +184,7 @@ getFriends :: Character -> [Character]
 getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
 
 getEpisode :: Int -> Maybe Text
-getEpisode 4 = pure "NEWHOPE"
+getEpisode 4 = pure "NEW_HOPE"
 getEpisode 5 = pure "EMPIRE"
 getEpisode 6 = pure "JEDI"
 getEpisode _ = empty

tests/Test/StarWars/QuerySpec.hs

@@ -64,9 +64,9 @@ spec = describe "Star Wars Query Tests" $ do
                 friends {
                   name
                   appearsIn
-                    friends {
-                      name
-                    }
+                  friends {
+                    name
+                  }
                 }
               }
             }
@@ -77,7 +77,7 @@ spec = describe "Star Wars Query Tests" $ do
             , "friends" .= [
                   Aeson.object [
                       "name" .= ("Luke Skywalker" :: Text)
-                    , "appearsIn" .= ["NEWHOPE","EMPIRE","JEDI" :: Text]
+                    , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
                     , "friends" .= [
                           Aeson.object [hanName]
                         , Aeson.object [leiaName]
@@ -87,7 +87,7 @@ spec = describe "Star Wars Query Tests" $ do
                     ]
                 , Aeson.object [
                       hanName
-                    , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
+                    , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
                     , "friends" .=
                         [ Aeson.object [lukeName]
                         , Aeson.object [leiaName]
@@ -96,7 +96,7 @@ spec = describe "Star Wars Query Tests" $ do
                     ]
                 , Aeson.object [
                       leiaName
-                    , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
+                    , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
                     , "friends" .=
                         [ Aeson.object [lukeName]
                         , Aeson.object [hanName]

tests/Test/StarWars/Schema.hs

@@ -42,7 +42,7 @@ heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
     [ ("id", Out.Resolver idFieldType (idField "id"))
     , ("name", Out.Resolver nameFieldType (idField "name"))
     , ("friends", Out.Resolver friendsFieldType (idField "friends"))
-    , ("appearsIn", Out.Resolver appearsInFieldType (idField "appearsIn"))
+    , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
     , ("homePlanet", Out.Resolver homePlanetFieldType (idField "homePlanet"))
     , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
     , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
@@ -55,7 +55,7 @@ droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
     [ ("id", Out.Resolver idFieldType (idField "id"))
     , ("name", Out.Resolver nameFieldType (idField "name"))
     , ("friends", Out.Resolver friendsFieldType (idField "friends"))
-    , ("appearsIn", Out.Resolver appearsInFieldType (idField "appearsIn"))
+    , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
     , ("primaryFunction", Out.Resolver primaryFunctionFieldType (idField "primaryFunction"))
     , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
     , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
@@ -72,8 +72,11 @@ nameFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
 friendsFieldType :: Out.Field Identity
 friendsFieldType = Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty
 
-appearsInFieldType :: Out.Field Identity
-appearsInFieldType = Out.Field Nothing (Out.ListType $ Out.NamedScalarType int) mempty
+appearsInField :: Out.Field Identity
+appearsInField = Out.Field (Just description) fieldType mempty
+  where
+    fieldType = Out.ListType $ Out.NamedEnumType episodeEnum
+    description = "Which movies they appear in."
 
 secretBackstoryFieldType :: Out.Field Identity
 secretBackstoryFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
@@ -97,7 +100,7 @@ hero :: ActionT Identity Value
 hero = do
   episode <- argument "episode"
   pure $ character $ case episode of
-      Enum "NEWHOPE" -> getHero 4
+      Enum "NEW_HOPE" -> getHero 4
       Enum "EMPIRE" -> getHero 5
       Enum "JEDI" -> getHero 6
       _ -> artoo