From fdc43e4e257cbc1cb1a829b81a7278f6404be79c Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Fri, 13 Oct 2023 20:42:24 +0200
Subject: Fix non nullable type representation
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

…in executor error messages.
---
 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 ++++++------
 4 files changed, 23 insertions(+), 12 deletions(-)

(limited to 'src/Language')

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
-- 
cgit v1.2.3