How to construct an Applicative instance with constraints (similarly to constructing Monad instances using ContT)

Question

This question deals with constructing a proper Monad instance from something that is a monad, but only under certain constraints - for example Set. The trick is to wrap it into ContT, which defers the constraints to wrapping/unwrapping its values.

Now I'd like to do the same with Applicatives. In particular, I have an Applicative instance whose pure has a type-class constraint. Is there a similar trick how to construct a valid Applicative instance?

(Is there "the mother of all applicative functors" just as there is for monads?)

Pice

Sort of guessing at your use-case, but could you make use of the Apply type class, i.e. class Apply f where apply :: f (a->b) -> f a -> f b ? – Chamberlain

@JohnL Looks like a good idea, I didn't know about the package. – Pice

Thanks for the link, I was unable to find it last night. One common use case is for DSL's, where you can implement apply and bind easily but it's not possible to lift arbitrary values in, which seems like it might be related to what you're doing. – Chamberlain

Answer 1

What may be the most consistent way available is starting from Category, where it's quite natural to have a restriction to objects: Object!

class Category k where
  type Object k :: * -> Constraint
  id :: Object k a => k a a
  (.) :: (Object k a, Object k b, Object k c)
     => k b c -> k a b -> k a c

Then we define functors similar to how Edward does it

class (Category r, Category t) => Functor f r t | f r -> t, f t -> r where
  fmap :: (Object r a, Object t (f a), Object r b, Object t (f b))
             => r a b -> t (f a) (f b)

All of this works nicely and is implemented in the constrained-categories library, which – shame on me! – still isn't on Hackage.

Applicative is unfortunately a bit less straightforward to do. Mathematically, these are monoidal functors, so we first need monoidal categories. categories has that class, but it doesn't work with the constraint-based version because our objects are always anything of kind * with a constraint. So what I did is make up a Curry class, which kind of approximates this.

Then, we can do Monoidal functors:

class (Functor f r t, Curry r, Curry t) => Monoidal f r t where
  pure :: (Object r a, Object t (f a)) => a `t` f a
  fzipWith :: (PairObject r a b, Object r c, PairObject t (f a) (f b), Object t (f c))
              => r (a, b) c -> t (f a, f b) (f c)

This is actually equivalent to Applicative when we have proper closed cartesian categories. In the constrained-categories version, the signatures unfortunately look very horrible:

  (<*>) :: ( Applicative f r t
           , MorphObject r a b, Object r (r a b)
           , MorphObject t (f a) (f b), Object t (t (f a) (f b)), Object t (f (r a b))
           , PairObject r (r a b) a, PairObject t (f (r a b)) (f a)
           , Object r a, Object r b, Object t (f a), Object t (f b))
       => f (r a b) `t` t (f a) (f b)

Still, it actually works – for the unconstrained case, duh! I haven't yet found a convenient way to use it with nontrivial constraints.

But again, Applicative is equivalent to Monoidal, and that can be used as demonstrated in the Set example.

Ravage

Answer 2

I'm not sure the notion of "restricted applicative" is unique, as different presentations are not isomorphic. That said here is one and something at least somewhat along the lines of Codensity. The idea is to have a "free functor" together with a unit

{-# LANGUAGE TypeFamilies, ConstraintKinds, ExistentialQuantification #-}

import GHC.Prim (Constraint)
import Control.Applicative

class RFunctor f where
  type C f :: * -> Constraint
  rfmap :: C f b => (a -> b) -> f a -> f b

class RFunctor f => RApplicative f where
  rpure :: C f a => a -> f a
  rzip :: f a -> f b -> f (a,b)

data UAp f a
  = Pure  a
  | forall b. Embed (f b) (b -> a)

toUAp :: C f a => f a -> UAp f a
toUAp x = Embed x id

fromUAp :: (RApplicative f, C f a) => UAp f a -> f a
fromUAp (Pure x) = rpure x
fromUAp (Embed x f) = rfmap f x

zipUAp :: RApplicative f => UAp f a -> UAp f b -> UAp f (a,b)
zipUAp (Pure a) (Pure b) = Pure (a,b)
zipUAp (Pure a) (Embed b f) = Embed b (\x -> (a,f x))
zipUAp (Embed a f) (Pure b) = Embed a (\x -> (f x,b))
zipUAp (Embed a f) (Embed b g) = Embed (rzip a b) (\(x,y) -> (f x,g y))

instance Functor (UAp f) where
  fmap f (Pure a) = Pure (f a)
  fmap f (Embed a g) = Embed a (f . g)

instance RApplicative f => Applicative (UAp f) where
  pure = Pure
  af <*> ax = fmap (\(f,x) -> f x) $ zipUAp af ax

EDIT: Fixed some bugs. That is what happens when you don't compile before posting.

Golf

In the spirit of Applicative-ought-to-be-a-superclass-of-Monad, would you be prepared to add an explanation of the UAp bits thus explaining this independently of the monad explanation elsewhere? – Harter

Could you please add whatever is needed to compile the snippet? I added ExistentialQuantification, ConstraintKinds, TypeFamilies extensions, import GHC.Prim (Constraint), but it fails to compile. – Pice

That is pretty much exactly how the constraint-kinds library does it. Rather too ad-hoc for my tastes, but you can certainly get some stuff done this way. – Ravage

Answer 3

Because every Monad is a Functor, you can use the same ContT trick.

pure becomes return

fmap f x becomes x >>= (return . f)

Biometrics

I'm not sure this helps. Without a >>= in the underlying restricted applicative, you can't project out of ContT. – Golf

@PhilipJF Yes, this is exactly the problem with using ContT, it's not possible to project the result. – Pice