How to define a superclass constraint for free monoids? - haskell

Consider the following type class for free monoids.
class FreeMonoid f where
inj :: a -> f a
univ :: Monoid m => (a -> m) -> f a -> m
inj injects a value into the free monoid, and univ is the universal property of free monoids.
Instances of this class should satisfy the following laws.
Identity: univ f . inj = f
Free empty: univ f mempty = mempty
Free append: univ f (m <> n) = univ f m <> univ f n
Note that if f is an instance of FreeMonoid then (f a) must be an instance of Monoid. Otherwise, the last two laws don't make sense. So, how do I specify this constraint? Here's what I tried.
class Monoid (f a) => FreeMonoid f where
inj :: a -> f a
univ :: Monoid m => (a -> m) -> f a -> m
Not having this constraint makes it inconvenient to use this class. For example, consider the following function.
mapFreeMonoid :: (FreeMonoid f, Monoid (f b)) => (a -> b) -> f a -> f b
mapFreeMonoid f = univ (inj . f)
Since f is an instance of FreeMonoid, we shouldn't have to specify the Monoid (f b) constraint. Ideally, we should be able to define the above function as follows.
mapFreeMonoid :: FreeMonoid f => (a -> b) -> f a -> f b
mapFreeMonoid f = univ (inj . f)

You can try experimenting with the QuantifiedConstraints extension.
class (forall a. Monoid (f a)) => FreeMonoid f where
...
Your code then compiles without the additional constraint.
mapFreeMonoid :: FreeMonoid f => (a -> b) -> f a -> f b
mapFreeMonoid f = univ (inj . f)

You may use the QuantifiedConstraints extension as chi’s answer said. Take a look at the analogous definition for free categories, the CFree constraint here.

Related

What's distributing a functor over a tuple called?

Is there a name for this family of operations?
Functor f => f (a, b) -> (f a, f b)
Functor f => f (a, b, c) -> (f a, f b, f c)
...
Functor f => f (a, b, ..., z) -> (f a, f b, ..., f z)
They're easy to implement, just trying to figure out what to call it.
\fab -> (fst <$> fab, snd <$> fab)
For me, it came up in the context of f ~ (x ->).
In your specific context f ~ (x ->), I think they can be called "power laws".
Indeed, in theory, it is common to write A -> B as the power B^A. The pair type (A,B) is also commonly written as a product (A*B).
Your first law is then written as
(A*B)^C = A^C * B^C
and is a classic type isomorphism. This can be easily generalized to tuples in the obvious way.
In the general case, where f is an arbitrary functor, I can't think of nothing else than "distribution", right now.
There is Data.Distributive which is the dual of Data.Traversable. It provides the distribute function which can be specialized e.g. as f (Stream a) -> Stream (f a) or distribute :: f (Vec n a) -> Vec n (f a). The latter example is a homogeneous variant of your family of functions.
But we can generalize Data.Distributive a bit just like lenses generalize functors. Enter Colens:
type Colens s t a b = forall f. Functor f => (f a -> b) -> f s -> t
Here is the mirror of Control.Lens.Each:
class Coeach s t a b | s -> a, t -> b, s b -> t, t a -> s where
coeach :: Colens s t a b
instance (a~a', b~b') => Coeach (a,a') (b,b') a b where
coeach f p = (f $ fst <$> p, f $ snd <$> p)
instance (a~a2, a~a3, b~b2, b~b3) => Coeach (a,a2,a3) (b,b2,b3) a b where
coeach f p = ...
...
And just like with each we can iterate over tuples
each_id1 :: Applicative f => (f a, f a) -> f (a, a)
each_id1 = each id
each_id2 :: Applicative f => (f a, f a, f a) -> f (a, a, a)
each_id2 = each id
with coeach we can coiterate over tuples:
coeach_id1 :: Functor f => f (a, a) -> (f a, f a)
coeach_id1 = coeach id
coeach_id2 :: Functor f => f (a, a, a) -> (f a, f a, f a)
coeach_id2 = coeach id
This is still homogeneous, though. I don't know lens much, so can't say whether there is a heterogeneous each and the corresponding coeach.

Applicative laws for alternative class formulations

A well-known alternative formulation of Applicative (see, e.g., Typeclassopedia) is
class Functor f => Monoidal f where
unit :: f ()
pair :: f a -> f b -> f (a, b)
This leads to laws that look more like typical identity and associativity laws than what you get from Applicative, but only when you work through pair-reassociating isomorphisms. Thinking about this a few weeks ago, I came up with two other formulations that avoid this problem.
class Functor f => Fapplicative f where
funit :: f (a -> a)
fcomp :: f (b -> c) -> f (a -> b) -> f (a -> c)
class Functor f => Capplicative f where
cunit :: Category (~>) => f (a ~> a)
ccomp :: Category (~>) => f (b ~> c) -> f (a ~> b) -> f (a ~> c)
It's easy to implement Capplicative using Applicative, Fapplicative using Capplicative, and Applicative using Fapplicative, so these all have equivalent power.
The identity and associativity laws are entirely obvious. But Monoidal needs a naturality law, and these must as well. How might I formulate them? Also: Capplicative seems to suggest an immediate generalization:
class (Category (~>), Functor f) => Appish (~>) f where
unit1 :: f (a ~> a)
comp1 :: f (b ~> c) -> f (a ~> b) -> f (a ~> c)
I am a bit curious about whether this (or something similar) is good for something.
This is a really neat idea!
I think the free theorem for fcomp is
fcomp (fmap (post .) u) (fmap (. pre) v) = fmap (\f -> post . f . pre) (fcomp u v)

What is this thing similar to KleisliFunctor?

Here is how we can define KleisliFunctor:
class (Monad m, Functor f) => KleisliFunctor m f where
kmap :: (a -> m b) -> f a -> f b
kmap f = kjoin . fmap f
kjoin :: f (m a) -> f a
kjoin = kmap id
Does this type class
class (Functor f, Monad m) => Absorb f m where
(>>~) :: f a -> (a -> m b) -> m b
a >>~ f = ajoin $ fmap f a
ajoin :: f (m a) -> m a
ajoin a = a >>~ id
fit somewhere into category theory? What are the laws? Are they
a >>~ g . f === fmap f a >>~ g
a >>~ (f >=> g) === a >>~ f >>= g
?
This is a speculative answer. Proceed with caution.
Let's first consider KleisliFunctor, focusing on the bind-like arrow mapping:
class (Monad m, Functor f) => KleisliFunctor m f where
kmap :: (a -> m b) -> f a -> f b
For this to actually be a functor from the Kleisli category of m to Hask, kmap has to follow the relevant functor laws:
-- Mapping the identity gives identity (in the other category).
kmap return = id
-- Mapping a composed arrow gives a composed arrow (in the other category).
kmap (g <=< f) = kmap g . kmap f
The fact that there are two Functors involved makes things a little unusual, but not unreasonable -- for instance, the laws do hold for mapMaybe, which is the first concrete example the KleisliFunctor post alludes to.
As for Absorb, I will flip the bind-like method for the sake of clarity:
class (Functor f, Monad m) => Absorb f m where
(~<<) :: (a -> m b) -> f a -> m b
If we are looking for something analogous to KleisliFunctor, a question that immediately arises is which category would have functions of type f a -> m b as arrows. It certainly cannot be Hask, as its identity (of type f a -> m a) cannot be id. We would have to figure out not only identity but also composition. For something that is not entirely unlike Monad...
idAbsorb :: f a -> m a
compAbsorb :: (f b -> m c) -> (f a -> m b) -> (f a -> m c)
... the only plausible thing I can think of right now is having a monad morphism as idAbsorb and using a second monad morphism in the opposite direction (that is, from m to f) so that compAbsorb can be implemented by applying the first function, then going back to f and finally applying the second function. We would need to work that out in order to see if my assumptions are appropriate, if this approach works, and if it leads to something useful for your purposes.

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

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?)
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.
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.
Because every Monad is a Functor, you can use the same ContT trick.
pure becomes return
fmap f x becomes x >>= (return . f)

Is there a generalization of these Free-like constructions?

I was playing around with free-like ideas, and found this:
{-# LANGUAGE RankNTypes #-}
data Monoid m = Monoid { mempty :: m, mappend :: m -> m -> m }
data Generator a m = Generator { monoid :: Monoid m, singleton :: a -> m }
newtype Free f = Free { getFree :: forall s. f s -> s }
mkMonoid :: (forall s. f s -> Monoid s) -> Monoid (Free f)
mkMonoid f = Monoid {
mempty = Free (mempty . f),
mappend = \a b -> Free $ \s -> mappend (f s) (getFree a s) (getFree b s)
}
freeMonoid :: Monoid (Free Monoid)
freeMonoid = mkMonoid id
mkGenerator :: (forall s. f s -> Generator a s) -> Generator a (Free f)
mkGenerator f = Generator {
monoid = mkMonoid (monoid . f),
singleton = \x -> Free $ \s -> singleton (f s) x
}
freeGenerator :: Generator a (Free (Generator a))
freeGenerator = mkGenerator id
I would like to find the conditions under which I could write a funcion:
mkFree :: (??? f) => f (Free f)
but I have been unable to find a meaningful structure for f (other than the trivial one in which mkFree is a method of ???) which would allow this function to be written. In particular, my aesthetic sense would prefer if this structure did not mention the Free type.
Has anyone seen something like this before? Is this generalization possible? Is there a known generalization in a direction that I have not thought of yet?
The link to universal algebra was a good starting point, and after reading up on it a bit everything fell into place. What we're looking for is an F-algebra:
type Alg f x = f x -> x
for any (endo)functor f. For example, for a Monoid algebra the functor is:
data MonoidF m = MEmpty | MAppend m m deriving Functor
For any Monoid instance there's the obvious monoid algebra:
monoidAlg :: Monoid m => Alg MonoidF m
monoidAlg MEmpty = mempty
monoidAlg (MAppend a b) = mappend a b
Now we can take the free functor definition from the free-functors package, and replace the class constraint with the f-algebra:
newtype Free f a = Free { runFree :: forall b. Alg f b -> (a -> b) -> b }
The free functor is in some sense the best way to turn any set a into an algebra. This is how:
unit :: a -> Free f a
unit a = Free $ \_ k -> k a
It is the best way because for any other way to turn a into an algebra b, we can give a function from the free algebra to b:
rightAdjunct :: Functor f => Alg f b -> (a -> b) -> Free f a -> b
rightAdjunct alg k (Free f) = f alg k
What is left is to actually show that the free functor creates an f-algebra (and this is what you asked for):
freeAlg :: Functor f => Alg f (Free f a)
freeAlg ff = Free $ \alg k -> alg (fmap (rightAdjunct alg k) ff)
To explain a bit: ff is of type f (Free f a) and we need to build a Free f a. We can do that if we can build a b, given alg :: f b -> b and k :: a -> b. So we can apply alg to ff if we can map every Free f a it contains to a b, but that's exactly what rightAdjunct does with alg and k.
As you might have guessed, this Free f is the free monad on the functor f (the church encoded version to be precise.)
instance Functor f => Monad (Free f) where
return = unit
m >>= f = rightAdjunct freeAlg f m

Resources