From fdc43e4e257cbc1cb1a829b81a7278f6404be79c Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Fri, 13 Oct 2023 20:42:24 +0200 Subject: [PATCH] Fix non nullable type representation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit …in executor error messages. --- graphql.cabal | 2 +- src/Language/GraphQL/AST/Document.hs | 4 ++-- src/Language/GraphQL/Type/Definition.hs | 10 ++++++++++ src/Language/GraphQL/Type/In.hs | 9 +++++---- src/Language/GraphQL/Type/Out.hs | 12 ++++++------ tests/Language/GraphQL/ExecuteSpec.hs | 12 ++++++------ tests/Language/GraphQL/Validate/RulesSpec.hs | 6 +++--- 7 files changed, 33 insertions(+), 22 deletions(-) diff --git a/graphql.cabal b/graphql.cabal index bcf69af..0103d20 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -22,7 +22,7 @@ extra-source-files: README.md tested-with: GHC == 9.2.8, - GHC == 9.6.2 + GHC == 9.6.3 source-repository head type: git diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index 131285d..66fc246 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -371,8 +371,8 @@ data NonNullType deriving Eq instance Show NonNullType where - show (NonNullTypeNamed typeName) = '!' : Text.unpack typeName - show (NonNullTypeList listType) = concat ["![", show listType, "]"] + show (NonNullTypeNamed typeName) = Text.unpack $ typeName <> "!" + show (NonNullTypeList listType) = concat ["[", show listType, "]!"] -- ** Directives diff --git a/src/Language/GraphQL/Type/Definition.hs b/src/Language/GraphQL/Type/Definition.hs index 1c8876a..ad4b538 100644 --- a/src/Language/GraphQL/Type/Definition.hs +++ b/src/Language/GraphQL/Type/Definition.hs @@ -18,6 +18,8 @@ module Language.GraphQL.Type.Definition , float , id , int + , showNonNullType + , showNonNullListType , selection , string ) where @@ -207,3 +209,11 @@ include = handle include' (Just (Boolean True)) -> Include directive' _ -> Skip include' directive' = Continue directive' + +showNonNullType :: Show a => a -> String +showNonNullType = (++ "!") . show + +showNonNullListType :: Show a => a -> String +showNonNullListType listType = + let representation = show listType + in concat ["[", representation, "]!"] diff --git a/src/Language/GraphQL/Type/In.hs b/src/Language/GraphQL/Type/In.hs index 376ed6f..c777e69 100644 --- a/src/Language/GraphQL/Type/In.hs +++ b/src/Language/GraphQL/Type/In.hs @@ -66,10 +66,11 @@ instance Show Type where show (NamedEnumType enumType) = show enumType show (NamedInputObjectType inputObjectType) = show inputObjectType show (ListType baseType) = concat ["[", show baseType, "]"] - show (NonNullScalarType scalarType) = '!' : show scalarType - show (NonNullEnumType enumType) = '!' : show enumType - show (NonNullInputObjectType inputObjectType) = '!' : show inputObjectType - show (NonNullListType baseType) = concat ["![", show baseType, "]"] + show (NonNullScalarType scalarType) = Definition.showNonNullType scalarType + show (NonNullEnumType enumType) = Definition.showNonNullType enumType + show (NonNullInputObjectType inputObjectType) = + Definition.showNonNullType inputObjectType + show (NonNullListType baseType) = Definition.showNonNullListType baseType -- | Field argument definition. data Argument = Argument (Maybe Text) Type (Maybe Definition.Value) diff --git a/src/Language/GraphQL/Type/Out.hs b/src/Language/GraphQL/Type/Out.hs index 847a8a5..6854926 100644 --- a/src/Language/GraphQL/Type/Out.hs +++ b/src/Language/GraphQL/Type/Out.hs @@ -115,12 +115,12 @@ instance forall a. Show (Type a) where show (NamedInterfaceType interfaceType) = show interfaceType show (NamedUnionType unionType) = show unionType show (ListType baseType) = concat ["[", show baseType, "]"] - show (NonNullScalarType scalarType) = '!' : show scalarType - show (NonNullEnumType enumType) = '!' : show enumType - show (NonNullObjectType inputObjectType) = '!' : show inputObjectType - show (NonNullInterfaceType interfaceType) = '!' : show interfaceType - show (NonNullUnionType unionType) = '!' : show unionType - show (NonNullListType baseType) = concat ["![", show baseType, "]"] + show (NonNullScalarType scalarType) = showNonNullType scalarType + show (NonNullEnumType enumType) = showNonNullType enumType + show (NonNullObjectType inputObjectType) = showNonNullType inputObjectType + show (NonNullInterfaceType interfaceType) = showNonNullType interfaceType + show (NonNullUnionType unionType) = showNonNullType unionType + show (NonNullListType baseType) = showNonNullListType baseType -- | Matches either 'NamedScalarType' or 'NonNullScalarType'. pattern ScalarBaseType :: forall m. ScalarType -> Type m diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs index 65033ae..58e0187 100644 --- a/tests/Language/GraphQL/ExecuteSpec.hs +++ b/tests/Language/GraphQL/ExecuteSpec.hs @@ -295,7 +295,7 @@ spec = let data'' = Object $ HashMap.singleton "philosopher" Null executionErrors = pure $ Error { message = - "Value completion error. Expected type !School, found: EXISTENTIALISM." + "Value completion error. Expected type School!, found: EXISTENTIALISM." , locations = [Location 1 17] , path = [Segment "philosopher", Segment "school"] } @@ -307,7 +307,7 @@ spec = let data'' = Object $ HashMap.singleton "philosopher" Null executionErrors = pure $ Error { message = - "Value completion error. Expected type !Interest, found: { instrument: \"piano\" }." + "Value completion error. Expected type Interest!, found: { instrument: \"piano\" }." , locations = [Location 1 17] , path = [Segment "philosopher", Segment "interest"] } @@ -319,7 +319,7 @@ spec = let data'' = Object $ HashMap.singleton "philosopher" Null executionErrors = pure $ Error { message - = "Value completion error. Expected type !Work, found:\ + = "Value completion error. Expected type Work!, found:\ \ { title: \"Also sprach Zarathustra: Ein Buch f\252r Alle und Keinen\" }." , locations = [Location 1 17] , path = [Segment "philosopher", Segment "majorWork"] @@ -343,7 +343,7 @@ spec = it "gives location information for failed result coercion" $ let data'' = Object $ HashMap.singleton "philosopher" Null executionErrors = pure $ Error - { message = "Unable to coerce result to !Int." + { message = "Unable to coerce result to Int!." , locations = [Location 1 26] , path = [Segment "philosopher", Segment "century"] } @@ -364,7 +364,7 @@ spec = it "sets data to null if a root field isn't nullable" $ let executionErrors = pure $ Error - { message = "Unable to coerce result to !Int." + { message = "Unable to coerce result to Int!." , locations = [Location 1 3] , path = [Segment "count"] } @@ -375,7 +375,7 @@ spec = it "detects nullability errors" $ let data'' = Object $ HashMap.singleton "philosopher" Null executionErrors = pure $ Error - { message = "Value completion error. Expected type !String, found: null." + { message = "Value completion error. Expected type String!, found: null." , locations = [Location 1 26] , path = [Segment "philosopher", Segment "firstLanguage"] } diff --git a/tests/Language/GraphQL/Validate/RulesSpec.hs b/tests/Language/GraphQL/Validate/RulesSpec.hs index 7a5f4cc..2b77e44 100644 --- a/tests/Language/GraphQL/Validate/RulesSpec.hs +++ b/tests/Language/GraphQL/Validate/RulesSpec.hs @@ -878,7 +878,7 @@ spec = { message = "Variable \"$dogCommandArg\" of type \ \\"DogCommand\" used in position expecting type \ - \\"!DogCommand\"." + \\"DogCommand!\"." , locations = [AST.Location 1 26] } in validate queryString `shouldBe` [expected] @@ -925,7 +925,7 @@ spec = |] expected = Error { message = - "Value 3 cannot be coerced to type \"!CatCommand\"." + "Value 3 cannot be coerced to type \"CatCommand!\"." , locations = [AST.Location 3 36] } in validate queryString `shouldBe` [expected] @@ -940,7 +940,7 @@ spec = |] expected = Error { message = - "Value 3 cannot be coerced to type \"!String\"." + "Value 3 cannot be coerced to type \"String!\"." , locations = [AST.Location 2 28] } in validate queryString `shouldBe` [expected]