ten-0.1.0.2: Typeclasses like Functor, etc. over arity-1 type constructors.
Safe HaskellNone
LanguageHaskell2010

Data.Ten.Ap

Description

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.

Synopsis

Field Wrapper

newtype Ap10 (a :: k) (f :: k -> Type) Source #

A Functor10 made by applying the argument to some type.

Constructors

Ap10 

Fields

Instances

Instances details
c a => Constrained10 (c :: k -> Constraint) (Ap10 a :: (k -> Type) -> Type) Source # 
Instance details

Defined in Data.Ten.Field

Methods

constrained10 :: Ap10 a (Dict1 c) Source #

Foldable10 (Ap10 a :: (k -> Type) -> Type) Source # 
Instance details

Defined in Data.Ten.Foldable

Methods

foldMap10 :: Monoid w => (forall (a0 :: k0). m a0 -> w) -> Ap10 a m -> w Source #

Functor10 (Ap10 a :: (k -> Type) -> Type) Source # 
Instance details

Defined in Data.Ten.Functor

Methods

fmap10 :: (forall (a0 :: k0). m a0 -> n a0) -> Ap10 a m -> Ap10 a n Source #

Applicative10 (Ap10 a :: (k -> Type) -> Type) Source # 
Instance details

Defined in Data.Ten.Applicative

Methods

pure10 :: (forall (a0 :: k0). m a0) -> Ap10 a m Source #

(<*>!) :: forall (m :: k0 -> Type) (n :: k0 -> Type). Ap10 a (m :->: n) -> Ap10 a m -> Ap10 a n Source #

liftA210 :: (forall (a0 :: k0). m a0 -> n a0 -> o a0) -> Ap10 a m -> Ap10 a n -> Ap10 a o Source #

Traversable10 (Ap10 a :: (k -> Type) -> Type) Source # 
Instance details

Defined in Data.Ten.Traversable

Methods

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 # 
Instance details

Defined in Data.Ten.Update

Methods

overRep10 :: forall (a0 :: k0) m. Rep10 (Ap10 a) a0 -> (m a0 -> m a0) -> Ap10 a m -> Ap10 a m Source #

FieldPaths10 (Ap10 a :: (k -> Type) -> Type) Source # 
Instance details

Defined in Data.Ten.Field

Representable10 (Ap10 a :: (k -> Type) -> Type) Source # 
Instance details

Defined in Data.Ten.Representable

Associated Types

type Rep10 (Ap10 a) :: k -> Type Source #

Methods

index10 :: forall m (a0 :: k0). Ap10 a m -> Rep10 (Ap10 a) a0 -> m a0 Source #

tabulate10 :: (forall (a0 :: k0). Rep10 (Ap10 a) a0 -> m a0) -> Ap10 a m Source #

(EqCtx f a, EqAp f) => Eq (Ap10 a f) Source # 
Instance details

Defined in Data.Ten.Ap

Methods

(==) :: Ap10 a f -> Ap10 a f -> Bool #

(/=) :: Ap10 a f -> Ap10 a f -> Bool #

(OrdCtx f a, OrdAp f, EqCtx f a, EqAp f) => Ord (Ap10 a f) Source # 
Instance details

Defined in Data.Ten.Ap

Methods

compare :: Ap10 a f -> Ap10 a f -> Ordering #

(<) :: Ap10 a f -> Ap10 a f -> Bool #

(<=) :: Ap10 a f -> Ap10 a f -> Bool #

(>) :: Ap10 a f -> Ap10 a f -> Bool #

(>=) :: Ap10 a f -> Ap10 a f -> Bool #

max :: Ap10 a f -> Ap10 a f -> Ap10 a f #

min :: Ap10 a f -> Ap10 a f -> Ap10 a f #

(ReadCtx f a, ReadAp f) => Read (Ap10 a f) Source # 
Instance details

Defined in Data.Ten.Ap

Methods

readsPrec :: Int -> ReadS (Ap10 a f) #

readList :: ReadS [Ap10 a f] #

readPrec :: ReadPrec (Ap10 a f) #

readListPrec :: ReadPrec [Ap10 a f] #

(ShowCtx f a, ShowAp f) => Show (Ap10 a f) Source # 
Instance details

Defined in Data.Ten.Ap

Methods

showsPrec :: Int -> Ap10 a f -> ShowS #

show :: Ap10 a f -> String #

showList :: [Ap10 a f] -> ShowS #

Generic (Ap10 a f) Source # 
Instance details

Defined in Data.Ten.Ap

Associated Types

type Rep (Ap10 a f) :: Type -> Type #

Methods

from :: Ap10 a f -> Rep (Ap10 a f) x #

to :: Rep (Ap10 a f) x -> Ap10 a f #

(DefaultCtx f a, DefaultAp f) => Default (Ap10 a f) Source # 
Instance details

Defined in Data.Ten.Ap

Methods

def :: Ap10 a f #

(NFDataCtx f a, NFDataAp f) => NFData (Ap10 a f) Source # 
Instance details

Defined in Data.Ten.Ap

Methods

rnf :: Ap10 a f -> () #

(HashableCtx f a, HashableAp f) => Hashable (Ap10 a f) Source # 
Instance details

Defined in Data.Ten.Ap

Methods

hashWithSalt :: Int -> Ap10 a f -> Int #

hash :: Ap10 a f -> Int #

(PortrayCtx f a, PortrayAp f) => Portray (Ap10 a f) Source # 
Instance details

Defined in Data.Ten.Ap

Methods

portray :: Ap10 a f -> Portrayal #

portrayList :: [Ap10 a f] -> Portrayal #

(DiffCtx f a, DiffAp f) => Diff (Ap10 a f) Source # 
Instance details

Defined in Data.Ten.Ap

Methods

diff :: Ap10 a f -> Ap10 a f -> Maybe Portrayal #

type Rep10 (Ap10 a :: (k -> Type) -> Type) Source # 
Instance details

Defined in Data.Ten.Representable

type Rep10 (Ap10 a :: (k -> Type) -> Type) = (:~:) a
type Rep (Ap10 a f) Source # 
Instance details

Defined in Data.Ten.Ap

type Rep (Ap10 a f) = D1 ('MetaData "Ap10" "Data.Ten.Ap" "ten-0.1.0.2-3evwmmGM3iXFtbdnvF27Zi" 'True) (C1 ('MetaCons "Ap10" 'PrefixI 'True) (S1 ('MetaSel ('Just "unAp10") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f a))))

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 Nats, 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.