From 2bcae9e0a7657ddb261328caadc884c57992f304 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Mon, 14 Dec 2020 22:36:27 +0100
Subject: [PATCH] Implement Show class for GraphQL type definitions

.. in the `Type` modules.
---
 CHANGELOG.md                            |  1 +
 src/Language/GraphQL/Type/Definition.hs |  7 +++++++
 src/Language/GraphQL/Type/In.hs         | 14 ++++++++++++++
 src/Language/GraphQL/Type/Out.hs        | 24 ++++++++++++++++++++++++
 stack.yaml                              |  2 +-
 5 files changed, 47 insertions(+), 1 deletion(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 46c0b19..2ec77ec 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -13,6 +13,7 @@ and this project adheres to
   - `possibleFragmentSpreadsRule`
 - `Type.Schema.implementations` contains a map from interfaces and objects to
   interfaces they implement.
+- Show instances for GraphQL type definitions in the `Type` modules.
 
 ## [0.11.0.0] - 2020-11-07
 ### Changed
diff --git a/src/Language/GraphQL/Type/Definition.hs b/src/Language/GraphQL/Type/Definition.hs
index 476fb3a..6ca77aa 100644
--- a/src/Language/GraphQL/Type/Definition.hs
+++ b/src/Language/GraphQL/Type/Definition.hs
@@ -22,6 +22,7 @@ import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.String (IsString(..))
 import Data.Text (Text)
+import qualified Data.Text as Text
 import Language.GraphQL.AST (Name)
 import Prelude hiding (id)
 
@@ -63,6 +64,9 @@ data ScalarType = ScalarType Name (Maybe Text)
 instance Eq ScalarType where
     (ScalarType this _) == (ScalarType that _) = this == that
 
+instance Show ScalarType where
+    show (ScalarType typeName _) = Text.unpack typeName
+
 -- | Enum type definition.
 --
 -- Some leaf values of requests and input values are Enums. GraphQL serializes
@@ -73,6 +77,9 @@ data EnumType = EnumType Name (Maybe Text) (HashMap Name EnumValue)
 instance Eq EnumType where
     (EnumType this _ _) == (EnumType that _ _) = this == that
 
+instance Show EnumType where
+    show (EnumType typeName _ _) = Text.unpack typeName
+
 -- | Enum value is a single member of an 'EnumType'.
 newtype EnumValue = EnumValue (Maybe Text)
 
diff --git a/src/Language/GraphQL/Type/In.hs b/src/Language/GraphQL/Type/In.hs
index 59a6d59..d42599b 100644
--- a/src/Language/GraphQL/Type/In.hs
+++ b/src/Language/GraphQL/Type/In.hs
@@ -24,6 +24,7 @@ module Language.GraphQL.Type.In
 
 import Data.HashMap.Strict (HashMap)
 import Data.Text (Text)
+import qualified Data.Text as Text
 import Language.GraphQL.AST.Document (Name)
 import qualified Language.GraphQL.Type.Definition as Definition
 
@@ -40,6 +41,9 @@ data InputObjectType = InputObjectType
 instance Eq InputObjectType where
     (InputObjectType this _ _) == (InputObjectType that _ _) = this == that
 
+instance Show InputObjectType where
+    show (InputObjectType typeName _ _) = Text.unpack typeName
+
 -- | These types may be used as input types for arguments and directives.
 --
 -- GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
@@ -56,6 +60,16 @@ data Type
     | NonNullListType Type
     deriving Eq
 
+instance Show Type where
+    show (NamedScalarType scalarType) = show scalarType
+    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, "]"]
+
 -- | 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 b0668f5..847a8a5 100644
--- a/src/Language/GraphQL/Type/Out.hs
+++ b/src/Language/GraphQL/Type/Out.hs
@@ -38,6 +38,7 @@ import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
+import qualified Data.Text as Text
 import Language.GraphQL.AST (Name)
 import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Type.In as In
@@ -52,6 +53,9 @@ data ObjectType m = ObjectType
 instance forall a. Eq (ObjectType a) where
     (ObjectType this _ _ _) == (ObjectType that _ _ _) = this == that
 
+instance forall a. Show (ObjectType a) where
+    show (ObjectType typeName _ _ _) = Text.unpack typeName
+
 -- | Interface Type Definition.
 --
 -- When a field can return one of a heterogeneous set of types, a Interface type
@@ -63,6 +67,9 @@ data InterfaceType m = InterfaceType
 instance forall a. Eq (InterfaceType a) where
     (InterfaceType this _ _ _) == (InterfaceType that _ _ _) = this == that
 
+instance forall a. Show (InterfaceType a) where
+    show (InterfaceType typeName _ _ _) = Text.unpack typeName
+
 -- | Union Type Definition.
 --
 -- When a field can return one of a heterogeneous set of types, a Union type is
@@ -72,6 +79,9 @@ data UnionType m = UnionType Name (Maybe Text) [ObjectType m]
 instance forall a. Eq (UnionType a) where
     (UnionType this _ _) == (UnionType that _ _) = this == that
 
+instance forall a. Show (UnionType a) where
+    show (UnionType typeName _ _) = Text.unpack typeName
+
 -- | Output object field definition.
 data Field m = Field
     (Maybe Text) -- ^ Description.
@@ -98,6 +108,20 @@ data Type m
     | NonNullListType (Type m)
     deriving Eq
 
+instance forall a. Show (Type a) where
+    show (NamedScalarType scalarType) = show scalarType
+    show (NamedEnumType enumType) = show enumType
+    show (NamedObjectType inputObjectType) = show inputObjectType
+    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, "]"]
+
 -- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
 pattern ScalarBaseType :: forall m. ScalarType -> Type m
 pattern ScalarBaseType scalarType <- (isScalarType -> Just scalarType)
diff --git a/stack.yaml b/stack.yaml
index a4a98e4..9ee8fd3 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-16.22
+resolver: lts-16.26
 
 packages:
 - .