Add custom Eq instances to the types
This commit is contained in:
parent
377c87045e
commit
fdb1268213
@ -79,9 +79,7 @@ doesFragmentTypeApply :: forall m
|
|||||||
-> Out.ObjectType m
|
-> Out.ObjectType m
|
||||||
-> Bool
|
-> Bool
|
||||||
doesFragmentTypeApply (CompositeObjectType fragmentType) objectType =
|
doesFragmentTypeApply (CompositeObjectType fragmentType) objectType =
|
||||||
let Out.ObjectType fragmentName _ _ _ = fragmentType
|
fragmentType == objectType
|
||||||
Out.ObjectType objectName _ _ _ = objectType
|
|
||||||
in fragmentName == objectName
|
|
||||||
doesFragmentTypeApply (CompositeInterfaceType fragmentType) objectType =
|
doesFragmentTypeApply (CompositeInterfaceType fragmentType) objectType =
|
||||||
instanceOf objectType $ AbstractInterfaceType fragmentType
|
instanceOf objectType $ AbstractInterfaceType fragmentType
|
||||||
doesFragmentTypeApply (CompositeUnionType fragmentType) objectType =
|
doesFragmentTypeApply (CompositeUnionType fragmentType) objectType =
|
||||||
@ -92,16 +90,13 @@ instanceOf objectType (AbstractInterfaceType interfaceType) =
|
|||||||
let Out.ObjectType _ _ interfaces _ = objectType
|
let Out.ObjectType _ _ interfaces _ = objectType
|
||||||
in foldr go False interfaces
|
in foldr go False interfaces
|
||||||
where
|
where
|
||||||
go (Out.InterfaceType that _ interfaces _) acc =
|
go objectInterfaceType@(Out.InterfaceType _ _ interfaces _) acc =
|
||||||
let Out.InterfaceType this _ _ _ = interfaceType
|
acc || foldr go (interfaceType == objectInterfaceType) interfaces
|
||||||
in acc || foldr go (this == that) interfaces
|
|
||||||
instanceOf objectType (AbstractUnionType unionType) =
|
instanceOf objectType (AbstractUnionType unionType) =
|
||||||
let Out.UnionType _ _ members = unionType
|
let Out.UnionType _ _ members = unionType
|
||||||
in foldr go False members
|
in foldr go False members
|
||||||
where
|
where
|
||||||
go (Out.ObjectType that _ _ _) acc =
|
go unionMemberType acc = acc || objectType == unionMemberType
|
||||||
let Out.ObjectType this _ _ _ = objectType
|
|
||||||
in acc || this == that
|
|
||||||
|
|
||||||
executeField :: Monad m
|
executeField :: Monad m
|
||||||
=> Definition.Value
|
=> Definition.Value
|
||||||
|
@ -46,6 +46,9 @@ type Subs = HashMap Name Value
|
|||||||
-- Enums) .
|
-- Enums) .
|
||||||
data ScalarType = ScalarType Name (Maybe Text)
|
data ScalarType = ScalarType Name (Maybe Text)
|
||||||
|
|
||||||
|
instance Eq ScalarType where
|
||||||
|
(ScalarType this _) == (ScalarType that _) = this == that
|
||||||
|
|
||||||
-- | Enum type definition.
|
-- | Enum type definition.
|
||||||
--
|
--
|
||||||
-- Some leaf values of requests and input values are Enums. GraphQL serializes
|
-- 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.
|
-- kind of type, often integers.
|
||||||
data EnumType = EnumType Name (Maybe Text) (HashMap Name EnumValue)
|
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'.
|
-- | Enum value is a single member of an 'EnumType'.
|
||||||
newtype EnumValue = EnumValue (Maybe Text)
|
newtype EnumValue = EnumValue (Maybe Text)
|
||||||
|
|
||||||
|
@ -32,6 +32,9 @@ data InputField = InputField (Maybe Text) Type (Maybe Value)
|
|||||||
data InputObjectType = InputObjectType
|
data InputObjectType = InputObjectType
|
||||||
Name (Maybe Text) (HashMap Name InputField)
|
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.
|
-- | These types may be used as input types for arguments and directives.
|
||||||
--
|
--
|
||||||
-- GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
|
-- GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
|
||||||
@ -46,6 +49,7 @@ data Type
|
|||||||
| NonNullEnumType EnumType
|
| NonNullEnumType EnumType
|
||||||
| NonNullInputObjectType InputObjectType
|
| NonNullInputObjectType InputObjectType
|
||||||
| NonNullListType Type
|
| NonNullListType Type
|
||||||
|
deriving Eq
|
||||||
|
|
||||||
-- | Field argument definition.
|
-- | Field argument definition.
|
||||||
data Argument = Argument (Maybe Text) Type (Maybe Value)
|
data Argument = Argument (Maybe Text) Type (Maybe Value)
|
||||||
|
@ -45,6 +45,9 @@ data Resolver m = Resolver (Field m) (ActionT m Value)
|
|||||||
data ObjectType m = ObjectType
|
data ObjectType m = ObjectType
|
||||||
Name (Maybe Text) [InterfaceType m] (HashMap Name (Resolver m))
|
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.
|
-- | Interface Type Definition.
|
||||||
--
|
--
|
||||||
-- When a field can return one of a heterogeneous set of types, a Interface type
|
-- 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
|
data InterfaceType m = InterfaceType
|
||||||
Name (Maybe Text) [InterfaceType m] (HashMap Name (Field m))
|
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.
|
-- | Union Type Definition.
|
||||||
--
|
--
|
||||||
-- When a field can return one of a heterogeneous set of types, a Union type is
|
-- When a field can return one of a heterogeneous set of types, a Union type is
|
||||||
-- used to describe what types are possible.
|
-- used to describe what types are possible.
|
||||||
data UnionType m = UnionType Name (Maybe Text) [ObjectType m]
|
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.
|
-- | Output object field definition.
|
||||||
data Field m = Field
|
data Field m = Field
|
||||||
(Maybe Text) -- ^ Description.
|
(Maybe Text) -- ^ Description.
|
||||||
@ -83,6 +92,7 @@ data Type m
|
|||||||
| NonNullInterfaceType (InterfaceType m)
|
| NonNullInterfaceType (InterfaceType m)
|
||||||
| NonNullUnionType (UnionType m)
|
| NonNullUnionType (UnionType m)
|
||||||
| NonNullListType (Type m)
|
| NonNullListType (Type m)
|
||||||
|
deriving Eq
|
||||||
|
|
||||||
-- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
|
-- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
|
||||||
pattern ScalarBaseType :: forall m. ScalarType -> Type m
|
pattern ScalarBaseType :: forall m. ScalarType -> Type m
|
||||||
|
@ -25,17 +25,20 @@ data Type m
|
|||||||
| InputObjectType In.InputObjectType
|
| InputObjectType In.InputObjectType
|
||||||
| InterfaceType (Out.InterfaceType m)
|
| InterfaceType (Out.InterfaceType m)
|
||||||
| UnionType (Out.UnionType m)
|
| UnionType (Out.UnionType m)
|
||||||
|
deriving Eq
|
||||||
|
|
||||||
-- | These types may describe the parent context of a selection set.
|
-- | These types may describe the parent context of a selection set.
|
||||||
data CompositeType m
|
data CompositeType m
|
||||||
= CompositeUnionType (Out.UnionType m)
|
= CompositeUnionType (Out.UnionType m)
|
||||||
| CompositeObjectType (Out.ObjectType m)
|
| CompositeObjectType (Out.ObjectType m)
|
||||||
| CompositeInterfaceType (Out.InterfaceType m)
|
| CompositeInterfaceType (Out.InterfaceType m)
|
||||||
|
deriving Eq
|
||||||
|
|
||||||
-- | These types may describe the parent context of a selection set.
|
-- | These types may describe the parent context of a selection set.
|
||||||
data AbstractType m
|
data AbstractType m
|
||||||
= AbstractUnionType (Out.UnionType m)
|
= AbstractUnionType (Out.UnionType m)
|
||||||
| AbstractInterfaceType (Out.InterfaceType m)
|
| AbstractInterfaceType (Out.InterfaceType m)
|
||||||
|
deriving Eq
|
||||||
|
|
||||||
-- | A Schema is created by supplying the root types of each type of operation,
|
-- | 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
|
-- query and mutation (optional). A schema definition is then supplied to the
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
resolver: lts-15.15
|
resolver: lts-15.16
|
||||||
|
|
||||||
packages:
|
packages:
|
||||||
- .
|
- .
|
||||||
|
Loading…
Reference in New Issue
Block a user