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: - .