From 882276a845c33c06b235d9604cbfd5b55d784c7d Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sat, 13 Jun 2020 07:20:19 +0200 Subject: Coerce result Fixes #45. --- tests/Language/GraphQL/Execute/CoerceSpec.hs | 37 +++++++++++++++------------- tests/Language/GraphQL/ExecuteSpec.hs | 8 +++--- tests/Test/StarWars/Data.hs | 2 +- tests/Test/StarWars/QuerySpec.hs | 12 ++++----- tests/Test/StarWars/Schema.hs | 13 ++++++---- 5 files changed, 39 insertions(+), 33 deletions(-) (limited to 'tests') diff --git a/tests/Language/GraphQL/Execute/CoerceSpec.hs b/tests/Language/GraphQL/Execute/CoerceSpec.hs index d800230..e39d550 100644 --- a/tests/Language/GraphQL/Execute/CoerceSpec.hs +++ b/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 diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs index 62c6f25..30568be 100644 --- a/tests/Language/GraphQL/ExecuteSpec.hs +++ b/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 diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs index bfbe836..427371b 100644 --- a/tests/Test/StarWars/Data.hs +++ b/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 diff --git a/tests/Test/StarWars/QuerySpec.hs b/tests/Test/StarWars/QuerySpec.hs index 39d6a27..cf451f8 100644 --- a/tests/Test/StarWars/QuerySpec.hs +++ b/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] diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs index 6296461..c9f1bed 100644 --- a/tests/Test/StarWars/Schema.hs +++ b/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 -- cgit v1.2.3