Add custom Eq instances to the types

This commit is contained in:
Eugen Wissner 2020-06-09 10:02:34 +02:00
parent 377c87045e
commit fdb1268213
6 changed files with 29 additions and 11 deletions

View File

@ -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

View File

@ -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)

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -1,4 +1,4 @@
resolver: lts-15.15
resolver: lts-15.16
packages:
- .