Add custom Eq instances to the types

6 files changed, 29 insertions, 11 deletions

diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs
index a46316f..79646c3 100644
--- a/src/Language/GraphQL/Execute/Execution.hs
+++ b/src/Language/GraphQL/Execute/Execution.hs
@@ -79,9 +79,7 @@ doesFragmentTypeApply :: forall m
     -> Out.ObjectType m
     -> Bool
 doesFragmentTypeApply (CompositeObjectType fragmentType) objectType =
-    let Out.ObjectType fragmentName _ _ _ = fragmentType
-        Out.ObjectType objectName _ _ _ = objectType
-     in fragmentName == objectName
+    fragmentType == objectType
 doesFragmentTypeApply (CompositeInterfaceType fragmentType) objectType =
     instanceOf objectType $ AbstractInterfaceType fragmentType
 doesFragmentTypeApply (CompositeUnionType fragmentType) objectType =
@@ -92,16 +90,13 @@ instanceOf objectType (AbstractInterfaceType interfaceType) =
     let Out.ObjectType _ _ interfaces _ = objectType
      in foldr go False interfaces
   where
-    go (Out.InterfaceType that _ interfaces _) acc =
-        let Out.InterfaceType this _ _ _ = interfaceType
-         in acc || foldr go (this == that) interfaces
+    go objectInterfaceType@(Out.InterfaceType _ _ interfaces _) acc =
+        acc || foldr go (interfaceType == objectInterfaceType) interfaces
 instanceOf objectType (AbstractUnionType unionType) =
     let Out.UnionType _ _ members = unionType
      in foldr go False members
   where
-    go (Out.ObjectType that _ _ _) acc =
-        let Out.ObjectType this _ _ _ = objectType
-         in acc || this == that
+    go unionMemberType acc = acc || objectType == unionMemberType
 
 executeField :: Monad m
     => Definition.Value
diff --git a/src/Language/GraphQL/Type/Definition.hs b/src/Language/GraphQL/Type/Definition.hs
index 411a7b3..1379018 100644
--- a/src/Language/GraphQL/Type/Definition.hs
+++ b/src/Language/GraphQL/Type/Definition.hs
@@ -37,7 +37,7 @@ instance IsString Value where
     fromString = String . fromString
 
 -- | Contains variables for the query. The key of the map is a variable name,
---   and the value is the variable value.
+-- and the value is the variable value.
 type Subs = HashMap Name Value
 
 -- | Scalar type definition.
@@ -46,6 +46,9 @@ type Subs = HashMap Name Value
 -- Enums) .
 data ScalarType = ScalarType Name (Maybe Text)
 
+instance Eq ScalarType where
+    (ScalarType this _) == (ScalarType that _) = this == that
+
 -- | Enum type definition.
 --
 -- Some leaf values of requests and input values are Enums. GraphQL serializes
@@ -53,6 +56,9 @@ data ScalarType = ScalarType Name (Maybe Text)
 -- kind of type, often integers.
 data EnumType = EnumType Name (Maybe Text) (HashMap Name EnumValue)
 
+instance Eq EnumType where
+    (EnumType this _ _) == (EnumType that _ _) = this == that
+
 -- | 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 c662797..36e0e2c 100644
--- a/src/Language/GraphQL/Type/In.hs
+++ b/src/Language/GraphQL/Type/In.hs
@@ -32,6 +32,9 @@ data InputField = InputField (Maybe Text) Type (Maybe Value)
 data InputObjectType = InputObjectType
     Name (Maybe Text) (HashMap Name InputField)
 
+instance Eq InputObjectType where
+    (InputObjectType this _ _) == (InputObjectType that _ _) = this == that
+
 -- | These types may be used as input types for arguments and directives.
 --
 -- GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
@@ -46,6 +49,7 @@ data Type
     | NonNullEnumType EnumType
     | NonNullInputObjectType InputObjectType
     | NonNullListType Type
+    deriving Eq
 
 -- | Field argument definition.
 data Argument = Argument (Maybe Text) Type (Maybe Value)
diff --git a/src/Language/GraphQL/Type/Out.hs b/src/Language/GraphQL/Type/Out.hs
index 9367d54..856c4f8 100644
--- a/src/Language/GraphQL/Type/Out.hs
+++ b/src/Language/GraphQL/Type/Out.hs
@@ -45,6 +45,9 @@ data Resolver m = Resolver (Field m) (ActionT m Value)
 data ObjectType m = ObjectType
     Name (Maybe Text) [InterfaceType m] (HashMap Name (Resolver m))
 
+instance forall a. Eq (ObjectType a) where
+    (ObjectType this _ _ _) == (ObjectType that _ _ _) = this == that
+
 -- | Interface Type Definition.
 --
 -- When a field can return one of a heterogeneous set of types, a Interface type
@@ -53,12 +56,18 @@ data ObjectType m = ObjectType
 data InterfaceType m = InterfaceType
     Name (Maybe Text) [InterfaceType m] (HashMap Name (Field m))
 
+instance forall a. Eq (InterfaceType a) where
+    (InterfaceType this _ _ _) == (InterfaceType that _ _ _) = this == that
+
 -- | Union Type Definition.
 --
 -- When a field can return one of a heterogeneous set of types, a Union type is
 -- used to describe what types are possible.
 data UnionType m = UnionType Name (Maybe Text) [ObjectType m]
 
+instance forall a. Eq (UnionType a) where
+    (UnionType this _ _) == (UnionType that _ _) = this == that
+
 -- | Output object field definition.
 data Field m = Field
     (Maybe Text) -- ^ Description.
@@ -83,6 +92,7 @@ data Type m
     | NonNullInterfaceType (InterfaceType m)
     | NonNullUnionType (UnionType m)
     | NonNullListType (Type m)
+    deriving Eq
 
 -- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
 pattern ScalarBaseType :: forall m. ScalarType -> Type m
diff --git a/src/Language/GraphQL/Type/Schema.hs b/src/Language/GraphQL/Type/Schema.hs
index ff7b5cc..4d7b9eb 100644
--- a/src/Language/GraphQL/Type/Schema.hs
+++ b/src/Language/GraphQL/Type/Schema.hs
@@ -25,17 +25,20 @@ data Type m
     | InputObjectType In.InputObjectType
     | InterfaceType (Out.InterfaceType m)
     | UnionType (Out.UnionType m)
+    deriving Eq
 
 -- | These types may describe the parent context of a selection set.
 data CompositeType m
     = CompositeUnionType (Out.UnionType m)
     | CompositeObjectType (Out.ObjectType m)
     | CompositeInterfaceType (Out.InterfaceType m)
+    deriving Eq
 
 -- | These types may describe the parent context of a selection set.
 data AbstractType m
     = AbstractUnionType (Out.UnionType m)
     | AbstractInterfaceType (Out.InterfaceType m)
+    deriving Eq
 
 -- | A Schema is created by supplying the root types of each type of operation,
 --   query and mutation (optional). A schema definition is then supplied to the
diff --git a/stack.yaml b/stack.yaml
index df90558..894eb1a 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-15.15
+resolver: lts-15.16
 
 packages:
 - .