Safe Haskell | None |
---|---|
Language | Haskell2010 |
Provides a field wrapper type to make Generic1
work with Functor10
etc.
GHC can't derive Generic1
instances for types that apply
their type parameter to a constant type (e.g. data Thing f = Thing (f
Int)
, but it can handle the equivalent type when the application is hidden
under a newtype: data Thing f = Thing (Ap10 Int f)
. So, by wrapping each
field in this newtype and providing the appropriate instances, we can use
Generics to derive instances for the whole hierarchy of
Functor10
and related classes.
Field Wrapper
newtype Ap10 (a :: k) (f :: k -> Type) Source #
A Functor10
made by applying the argument to some type.
Instances
c a => Constrained10 (c :: k -> Constraint) (Ap10 a :: (k -> Type) -> Type) Source # | |
Defined in Data.Ten.Field constrained10 :: Ap10 a (Dict1 c) Source # | |
Foldable10 (Ap10 a :: (k -> Type) -> Type) Source # | |
Functor10 (Ap10 a :: (k -> Type) -> Type) Source # | |
Applicative10 (Ap10 a :: (k -> Type) -> Type) Source # | |
Traversable10 (Ap10 a :: (k -> Type) -> Type) Source # | |
Defined in Data.Ten.Traversable mapTraverse10 :: forall f m n r. Applicative f => (Ap10 a n -> r) -> (forall (a0 :: k0). m a0 -> f (n a0)) -> Ap10 a m -> f r Source # | |
Update10 (Ap10 a :: (k -> Type) -> Type) Source # | |
FieldPaths10 (Ap10 a :: (k -> Type) -> Type) Source # | |
Defined in Data.Ten.Field fieldPaths10 :: Ap10 a (Const [PathComponent]) Source # | |
Representable10 (Ap10 a :: (k -> Type) -> Type) Source # | |
(EqCtx f a, EqAp f) => Eq (Ap10 a f) Source # | |
(OrdCtx f a, OrdAp f, EqCtx f a, EqAp f) => Ord (Ap10 a f) Source # | |
Defined in Data.Ten.Ap | |
(ReadCtx f a, ReadAp f) => Read (Ap10 a f) Source # | |
(ShowCtx f a, ShowAp f) => Show (Ap10 a f) Source # | |
Generic (Ap10 a f) Source # | |
(DefaultCtx f a, DefaultAp f) => Default (Ap10 a f) Source # | |
Defined in Data.Ten.Ap | |
(NFDataCtx f a, NFDataAp f) => NFData (Ap10 a f) Source # | |
Defined in Data.Ten.Ap | |
(HashableCtx f a, HashableAp f) => Hashable (Ap10 a f) Source # | |
Defined in Data.Ten.Ap | |
(PortrayCtx f a, PortrayAp f) => Portray (Ap10 a f) Source # | |
Defined in Data.Ten.Ap | |
(DiffCtx f a, DiffAp f) => Diff (Ap10 a f) Source # | |
type Rep10 (Ap10 a :: (k -> Type) -> Type) Source # | |
type Rep (Ap10 a f) Source # | |
Defined in Data.Ten.Ap |
Instances
- Note: Ap10 instances
Since Ap10 a f
is a newtype over f a
, it can adopt any instance that
f a
has, e.g. Eq (f a) => Eq (Ap10 a f)
. This doesn't play very nicely
with inference of derived instance contexts, though: if you say deriving
Eq
on a type with an f
type parameter with an Ap10 T f
field, GHC will
complain about the missing instance Eq (f T)
rather than adding it to the
context. However, if we can arrange for this to be expressed as a
Haskell98-looking constraint of the form C f
, GHC will be willing to add
that to the inferred context.
We can do this by adding a new class EqAp f
with the instance we really
want as a superclass, and using that as the context of Ap10
's Eq
instance. Now when trying to solve Eq (Ap10 T f)
, GHC will simplify to
(EqAp f, EqCtx f T)
. However, if we have just a catch-all instance for
EqAp
, GHC will simplify it further to the instance context of that
instance, which would bring us back to a constraint GHC won't add to the
context, forall a. Eq a => Eq (f a)
. We have to prevent GHC from doing
that simplification, which we can achieve by overlapping it with some other
instance, so that GHC can't choose the catch-all instance without knowing
more about f
. To avoid weird behavior from the overlap, we make an
otherwise-unused type Decoy
to carry the instance.
Finally, because Ap10
is poly-kinded, if we used Eq
directly as the
context of that quantified constraint, we'd be saying that Ap10
can only
be Eq
when its hidden kind parameter is Type
. Instead, we generalize it
to an associated type family EqCtx
. This might be e.g.
KnownNat
for Nat
s, or simply nothing for
phantom type parameters. I'm not yet sure how to approach the instances for
other kinds -- for instance, should we provide stock ones, or expect users
to write kind-level newtypes and provide their own instances?
This trickery is applied to all the instances of Ap10. In particular this
means deriving (Eq, Ord, Read, Show, Default, NFData)
and
deriving (Portray, Diff) via Wrapped Generic T
will all work.