The Comonad.Reader

 
{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}
import Control.Monad
import Control.Monad.Identity
import Control.Arrow ((&&&), (***),(+++), (|||))
 

I want to talk about duality briefly. I don't want to go all the way to Filinski-style or Haskell is Not Not ML-style value/continuation duality, but I do want to poke a bit at the variant/record duality explified by the extensible cases used to handle variants in MLPolyR.

The need for extensible cases to handle open variants is part of the expression problem as stated by Wadler:

The goal is to define a data type by cases, where one can add new cases to the data type and new functions over the data type, without recompiling existing code, and while retaining static type safety.

One obvious trick is to use an extensible record of functions as a 'case' statement, with each field corresponding to one of the variants. To index into records you can use an extensible variant of functions to represent a field selection. In a purer form ala the Filinski or the Haskell is Not Not ML approach mentioned above, you can replace the word 'function' with continuation and everything works out.

Sweirstra recently tackled the extensible variant side of the equation with in Data types a la carte using the free monad coproduct to handle the 'variant' side of things, leaving the handling of cases to typeclasses, but we can see if we can go one better and just exploit the variant/record duality directly.

Fight Club for Functors

Leaning a little on multi-parameter type classes we define:

 
class Dual f g | f -> g, g -> f where
        zap :: (a -> b -> c) -> f a -> g b -> c
 
(>$<) :: Dual f g => f (a -> b) -> g a -> b
(>$<) = zap id
 

The (>$<) operator takes a functor containing functions, and its 'dual functor' and annihilates them both obtaining a single value in a deterministic fashion.

The easiest inhabitant of this typeclass is the following:

 
instance Dual Identity Identity where
        zap f (Identity a) (Identity b) = f a b
 

After all there is only one item to be had on both the left and right so the choice is obvious. Now, we can take a couple of additional functors, the coproduct and product functors and define instances of Dual for them:

 
data (f :+: g) a = Inl (f a) | Inr (g a)
data (f :*: g) a = Prod (f a) (g a)
 
instance (Functor f, Functor g) => Functor (f :+: g) where
        fmap f (Inl x) = Inl (fmap f x)
        fmap f (Inr y) = Inr (fmap f y)
 
instance (Functor f, Functor g) => Functor (f :+: g) where
        fmap f (Prod x y) = Prod (fmap f x) (fmap f y)
 
instance (Dual f f', Dual g g') => Dual (f :+: g) (f' :*: g') where
        zap op (Inl f) (Prod a _) = zap op f a
        zap op (Inr f) (Prod _ b) = zap op f b
 
instance (Dual f f', Dual g g') => Dual (f :*: g) (f' :+: g') where
        zap op (Prod f _) (Inl a) = zap op f a
        zap op (Prod _ g) (Inr b) = zap op g b
 

Now, we can use the above to define an extensible case using (:*:)'s to handle any matching variant (:+:).

Clearly if you use any composition of the above, what will happen is whenever you have a product on the left you will have a sum on the right 'choosing' which half of the product you are interested, and whenever you have a sum on the left you will have a product on the right, and the sum in THAT case will choose which half of the product you are interested in. You will eventually reach a leaf (or evaluate to bottom), and the only base case we have is the Identity functor on both sides, so you will have only one candidate value to return.

The 'dispatch' of the function call is handled by some choices being made by sums on the left and others being made by sums on the right, but always in order to preserve duality, there is a corresponding pair of options on the other side.

A more straightforward insight might be obtained by extending this logic to bifunctors to eliminate some of the noise and allow your types to vary more.

 
-- | Bifunctor Duality
class BiDual p q | p -> q, q -> p where
        bizap :: (a -> c -> e) -> (b -> d -> e) -> p a b -> q c d -> e
 
(>>$<<):: BiDual p q => p (a -> c) (b -> c) -> q a b -> c
(>>$<<) = bizap id id
 
instance BiDual (,) Either where
        bizap l r (f,g) (Left a)  = l f a
        bizap l r (f,g) (Right b) = r g b
 
instance BiDual Either (,) where
        bizap l r (Left f) (a,b)  = l f a
        bizap l r (Right g) (a,b) = r g b
 

With the latter definition in hand, we can use products of functions to annihilate sums of values, or sums of functions to annihilate products of values.

 
ten :: Int
ten = ((*2),id) >>$<< Left 5
 
four :: Int
four = Left (/2) >>$<< (8.0, True)
 

We can use the earlier definitions to define the different algebra instances used by Swierstra as functions as a product of functions thereby decoupling us from the typeclass machinery.

I'll leave this bit as an exercise for the reader. The translation is pretty much straightforward.

[Edit: See a simple worked example in the comments]

However, the catamorphism used in the a la Carte paper to deconstruct the free monad with an initial algebra is not the only way you may want to take a free monad apart!

We can also use the cofree comonad of its dual functor, exploiting the same duality we used above to construct the algebra itself. And similarly we can stick a bunch of functions in the free monad of a the dual of a functor to pick a value out of a cofree comonad.

Where the a la Carte paper approach let you carry around different variants, the cofree comonad product construction allows you to 'carry around more stuff in each one.' The record/variant stuff has been around since Oleg et al.'s HList/OOHaskell stuff, but I don't recall seeing records of functions used to handle variants in that setting. I'm sure someone will correct me with a 15 year old example.

Recall the relevant portions of the free monad and cofree comonad:

 
newtype Cofree f a = Cofree { runCofree :: (a, f (Cofree f a)) }
newtype Free f a = Free { runFree :: Either a (f (Free f a)) }
 
instance Functor f => Functor (Cofree f) where
        fmap f = Cofree . (f *** fmap (fmap f)) . runCofree
instance Functor f => Functor (Free f) where
        fmap f = Free . (f +++ fmap (fmap f)) . runFree
 
anaC :: Functor f => (a -> f a) -> a -> Cofree f a
anaC t = Cofree . (id &&& fmap (anaC t) . t)
 
instance Functor f => Monad (Free f) where
        return = Free . Left
        m >>= k = (k ||| (inFree . fmap (>>= k))) (runFree m)
 
inFree :: f (Free f a) -> Free f a
inFree = Free . Right
 

Now, we can use the bizap we defined above for bifunctors to handle the (,) and Either portions and the zap function defined above to handle the nested functor, obtaining:

 
instance Dual f g => Dual (Cofree f) (Free g) where
        zap op (Cofree fs) (Free as) = bizap op (zap (zap op)) fs as
 
instance Dual f g => Dual (Free f) (Cofree g) where
        zap op (Free fs) (Cofree as) = bizap op (zap (zap op)) fs as
 

The most trivial example of a free monad and a cofree comonad would be the 'natural number' free monad and the 'stream' comonad, which both coincidentally can be obtained from the Identity functor -- how convenient! Its almost like I planned this.

 
type Nat a = Free Identity a
type Stream a = Cofree Identity a
 

We can define a successor function for our Naturals:

 
suck :: Nat a -> Nat a
suck = inFree . Identity
 

And we can build up a stream of integers, just to have a stream to search through:

 
ints :: Stream Int
ints = anaC (return . (+1)) 0
 

Then we can look at the nth element of the stream, by annihilating it with a free monad of the dual of its base functor.

In other words, we can ask for the element at a position that is given as a natural number!

 
two :: Int
two = suck (suck (return id)) >$< ints
 

And by duality we can take a stream of functions, and use it to annihilate a Nat functor wrapped around a value. Another exercise for the reader.

These are of course the simplest example of a free monad and a cofree comonad, but it works for any dualizable construction.

i.e. Given a binary tree containing values you index with a path into the tree. If your tree is potentially non-infinite then your path has to be decorated with functions in order to handle potential leaves. If your path is non-infinite then your tree has to be decorated with values. The types enforce that you'll either return bottom or find a single value at some point.

Two functors enter, one value leaves.

Source Code

No, this isn't some uplifting piece about deriving courage from sloth in the face of adversity.

What I want to talk about is monadic strength.

Transcribing the definition from category theory into Haskell we find that a strong monad is a functor such that there exists a morphism:

with a couple of conditions on it that I'll get to later.

Currying that to get something that feels more natural to a Haskell programmer we get:

 
mstrength :: Monad m => m a -> b -> m (a,b)
 

Pardo provided us with a nice definition for that in Towards merging recursion and comonads:

 
mstrength ma b = ma >>= (\a -> return (a,b))
 

which we can rewrite by pulling the return out of the function:

 
mstrength' ma b = ma >>= return . (\a -> (a,b))
 

Now, one of the nice monad laws we have says that if your Monad is a Functor, which it should be, then:

 
fmap f xs == xs >>= return . f
 

This law is what gives us the definition for liftM modulo the do-sugar used when writing it.

This lets us write:

 
strength :: Functor f => f a -> b -> f (a,b)
strength fa b = fmap (\a -> (a,b)) fa
 

Then by the monad laws any definition for Monad for this Functor must be strong in the sense that if it was made into a monad, this strength function would be a valid strength for the monad.

So we get the interesting observation that all functors in Haskell are 'strong'. Lets look at a couple:

Example ((,)c)

 
instance Functor ((,)c) where
	fmap f ~(a,b) = (a,f b)
 

The above may be familiar as the reader comonad, or as the functor induced by the (,) Bifunctor.

What is the meaning of its strength?

 
strength{(,)c} :: ((c,a),b) -> (c,(a,b))
 

Well, thats just the associative law for the (,) bifunctor.

Example (Either a)

What about the built-in functor instance for (Either a)?

 
instance Functor (Either a) where
	fmap f (Left a) = Left a
	fmap f (Right b) = Right (f b)
 

 
strength{Either c} :: (Either c a, b) -> Either c (a,b)
 

This strength gives us a (slightly weak) form of distributive law for sums over products in Haskell.

Having strength lets us know that if we have a functor of a's I can go through it and just drop in b's in along side each of the a's.

The show is over. Everyone can go home.

Not quite. What about comonadic costrength?

with a couple of laws we can ignore for the moment.

Since we can derive strength for all Functors in Haskell, we'd think at first
that we could do the same for costrength, after all most constructions work out that way when you can
construct one, its dual usually means something interesting and works out fine.

Here I'll introduce a typeclass, foreshadowing that this probably won't go so smoothly:

 
class Functor w => Costrong w where
	costrength :: w (Either a b) -> Either (w a) b
 

Unfortunately costrength cannot be derived for every functor in Haskell. Lets look at what it does and see why.

With costrength, given a data structure decorated at each point with either an 'a' or a 'b' I can walk the entire structure and if I found a's everywhere then I know I have 'a's in every position, so I can strengthen the type to say that it just contains 'a's. Otherwise I found a b, so I'll give you one of the b's I found. This requires that I'm somehow able to decide if the structure contains b's anywhere and constructively give you one if it does.

Lets find a functor that you can't do this to.

 
instance Functor ((->)e) where
         fmap  = (.)
 

An instance of costrength for (->) e,

 
costrength{(->)e} :: (e -> Either a b) -> Either (e -> a) b
 

would be equivalent to deciding that the function returns only Left's for all inputs.

Epic failure; functions are out.

Now, if we restrict ourselves to polynomial functors, we can try again, but what about infinite data structures?

 
data Stream a = a <: Stream a
 

Lets define the following stream comparison function:

 
eqstream :: Eq a => Stream a -> Stream a -> Stream (Either () ())
eqstream (a <: as) (b <: bs) = c <: eqstream as bs where
	c = if a == b then Right () else Left ()
 

Deciding equality of streams is complete , so this would imply that we have an oracle for the halting problem!

Ok, so infinite data structures are out.

This rules out 'coinductive' structures in general, but inductive structures are fine.

So what is in?

In Scheme you can define costrength with a the use of call-cc, which I'll leave as an exercise to the reader.

But, you can't use fmap to do that in Haskell, because call-cc passing around the current continuation is a form of monadic side effect. You could use the old Data.FunctorM and a Cont monad, but we like to think in terms of Data.Traversable today.

Unfortunately 'Either' isn't a Haskell monad in general because of some noise about trying to support 'fail', but if we define a less restrictive Either monad than the one in Control.Monad.Error, like the following:

 
instance Monad (Either a) where
	return = Right
	Left a >>= k = Left a
	Right a >>= k = k a
 

then using the version of mapM in Data.Traversable,

 
mapM :: (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b)
 

if we look at this especialized to 'id',

 
mapM{Either a}  id :: Traversable f => f (Either a b) -> Either a (f b)
 

we have almost has the right type. (In fact the above is probably a more natural signature for costrength in Haskell, because it is a distributive law for any Traversable functor f over (Either a). In fact mapM id (also known as sequence) is a distributive law for a traversable functor over any monad.

If we note the fact that sums are symmetric:

 
class Symmetric p where
     swap :: p a b -> p b a
 
instance Symmetric Either where
    swap (Left a) = Right a
    swap (Right a) = Left a
 

then:

 
costrength :: Traversable f => f (Either a b) = Either (f a) b
costrength = swap . mapM swap
 

The ability to define strength in general came from the fact that we were lazy enough that 'strength' doesn't try to evaluate the potentially infinite structure (there are little hidden functions all over the place in the form of thunks). The trade off is that we aren't 'strict' enough for 'costrength' to be definable in general.

A couple of uses for costrength:

Example (Either c)

 
costrength {Either c} :: Either c (Either a b) = Either (Either c a) b
 

is just the coassociative law for Either.

Example ((,)c)

 
costrength {(,)c} :: (c, Either a b) = Either (c,a) b
 

lets us distribute sums over products another way.

Example []

Finally,

 
costrength {[]} :: [Either a b] -> Either [a] b
 

lets us pretend that we can solve the stream problem above, but it just bottoms out if you apply it to an infinite list.

In short, in Haskell, every Functor is strong and every Traversable Functor is costrong.

[Edit: Dan Doel pointed out that instead of mapM id you could use sequence]

In case it wasn't obvious, I thought I should mention that Kabanov and Vene's dynamorphisms which optimize histomorphisms for dynamic programming can be expressed readily as chronomorphisms; they just use an anamorphism instead of a futumorphism.

 
-- | dynamorphism
dyna :: Functor f =>
        (f (Cofree f b) -> b) ->
        (a -> f a) ->
        (a -> b)
dyna f g = extract . dyna' f g
 
-- | dynamorphism kernel
dyna' :: Functor f =>
        (f (Cofree f b) -> b) ->
        (a -> f a) ->
        (a -> Cofree f b)
--dyna' f g = hylo (Cofree . (f &&& id)) g
dyna' f g = chrono' f (fmap return . g) . return
 
-- | generalized dynamorphism
g_dyna :: (Functor f, Functor h) =>
        (forall b. f (h b) -> h (f b)) ->
        (f (Cofree h b) -> b) ->
        (a -> f a) ->
        (a -> b)
g_dyna k f g = extract . g_dyna' k f g
 
-- | generalized dynamorphism kernel
g_dyna' :: (Functor f, Functor h) =>
        (forall b. f (h b) -> h (f b)) ->
        (f (Cofree h b) -> b) ->
        (a -> f a) ->
        (a -> Cofree h b)
g_dyna' k f g = g_chrono' k id f (fmap return . g) . return
 

Moreover, as an interesting aside, since one side is an anamorphism, there is no power to be gained for a dynamorphism by introducing a natural transformation term, even though dynamorphism is a form of chronomorphism, because 'eta' can be folded into the anamorphism side of the chronomorphism, as you do with a normal hylomorphism.

Source Code

Back in the days of HYLO, it was common to write hylomorphisms with an additional natural transformation in them. Well, I was still coding in evil imperative languages back then, but I have it on reliable, er.. well supposition, that this is probably the case, or at least that they liked to do it back in the HYLO papers anyways.

Transcoding the category theory mumbo-jumbo into Haskell, so I can have a larger audience, we get the following 'frat combinator' -- you can blame Jules Bean from #haskell for that.

 
hyloEta :: Functor f =>
     (g b -> b) ->
     (forall a. f a -> g a) ->
     (a -> f a)
hyloEta phi eta psi = phi . eta . fmap (hyloEta phi eta psi) . psi
 

We placed eta in the middle of the argument list because it is evocative of the fact that it occurs between phi and psi, and because that seems to be where everyone else puts it.

Now, clearly, we could roll eta into phi and get the more traditional hylo where f = g. Less obviously we could roll it into psi because it is a natural transformation and so the following diagram commutes:

This 'Hylo Shift' property (mentioned in that same paper) allows us to move the 'eta' term into the phi term or into the psi term as we see fit. Since we can move the eta term around and it adds no value to the combinator, it quietly returned to the void from whence it came. hyloEta offers us no more power than hylo, so out it goes.

So, if its dead, why talk about it?

Well, when we move to a generalized hylomorphism we have a design decision that has some performance effects, and my initial pass at a generalized hylomorphism isn't as general as it could be. When we open up the generalized hylomorphism and look at its guts (check the slightly updated source code from yesterday) we see:

 
g_hylo' w m f g = liftW f . w . fmap duplicate . fmap (g_hylo' w m f g) . fmap join . m . liftM g
 

expanding that to include the eta term gives us 4 candidate locations where we can abuse its status as a natural transformation to slot it in.

 
g_hylo'1 w m f eta g =
    liftW f .
    w . eta . fmap duplicate . fmap (g_hylo' w m f g) . fmap join . m .
    liftM g
g_hylo'2 w m f eta g =
    liftW f .
    w . fmap duplicate . eta . fmap (g_hylo' w m f g) . fmap join . m .
    liftM g
g_hylo'3 w m f eta g =
    liftW f .
    w . fmap duplicate . fmap (g_hylo' w m f g) . eta . fmap join . m .
    liftM g
g_hylo'4 w m f eta g =
    liftW f .
    w . fmap duplicate . fmap (g_hylo' w m f g) . fmap join . eta . m .
    liftM g
 

g-hylo'1 and g_hylo'4 are particularly interesting because we have functions sitting right next to them that we can fuse it into by generalizing the type signatures only slightly and because that leaves a run of 3 fmaps in a row that we can fuse together. If we generalize the signatures of both w and m we get the following definition that allows you to place it on the left or the right, and for g_hylo to not have to care about it.

-- new and improved!
g_hylo :: (Comonad w, Functor f, Monad m) =>
          (forall a. f (w a) -> w (g a)) ->
          (forall a. m (e a) -> f (m a)) ->
          (g (w b) -> b) ->
          (a -> e (m a)) ->
          (a -> b)
g_hylo w m f g = extract . g_hylo' w m f g . return

-- | the kernel of the generalized hylomorphism
g_hylo' :: (Comonad w, Functor f, Monad m) =>
           (forall a. f (w a) -> w (g a)) ->
           (forall a. m (e a) -> f (m a)) ->
           (g (w b) -> b) ->
           (a -> e (m a)) ->
           (m a -> w b)
g_hylo' w m f g = liftW f . w . fmap (duplicate . g_hylo' w m f g . join) . m . liftM g

The slightly generalized signatures for our two distributive laws now allow them to change functors on the way through, but we shed a superfluous argument.

Note that while 3 'Functors' e, f and g are involved, only f needs to be a Functor in Hask because we do the duplication, hylomorphism and join all inside f in either case. And most of the time e = f = g. For instance e or g could be exponential or contravariant.

So now that we've generalized our generalized hylomorphism we're done right?

Not quite. Unfortunately the same trick doesn't work for the generalized chronomorphism defined last night.

To see why, we have open up chrono and peek at its guts.

 
chrono = g_chrono id id
 

Well, that was boring. Digging deeper we find:

 
g_chrono :: (Functor f, Functor g, Functor m, Functor w) =>
            (forall b. f (w b) -> w (f b)) ->
            (forall b. m (f b) -> f (m b)) ->
            (f (Cofree w b) -> b) ->
            (a -> f (Free m a)) ->
            a -> b
g_chrono w m = g_hylo (distCofree w) (distFree m)
 

Sticking in hylo's vestigial natural transformation, we get:

 
g_chronoEta :: (Functor f, Functor g, Functor m, Functor w) =>
            (forall b. g (w b) -> w (g b)) ->
            (forall b. m (f b) -> f (m b)) ->
            (g (Cofree w b) -> b) ->
            (forall c. f a -> g a) ->
            (a -> f (Free m a)) ->
            a -> b
g_chronoEta w m f eta g = g_hylo (distCofree w . eta) (distFree m) f g
-- g_chronoEta w m f eta g = g_hylo (distCofree w) (eta . distFree m) f g
 

And so, we roll up our sleeves ready to merge it into something, be it f, g, w, m, anything, but it seems the only places eta can go is to merge into one of the distributive laws, because f and g are executed lifted.

Unfortunately, the user passed us rules for distributing the base functor of the cofree comonad and free monad, not for distributing the whole cofree comonad. And my efforts to generalize distFree and distCofree have thus far met with some frustration, there isn't much to grab onto there to write the more general signature.

Ideally, I'd just be able to merge it into one of the distributive laws. Since the HYLO guys liked to put it on the left of the recursive call to the hylomorphism, we'll look at distCofree. The desired signature for distCofree' would be:

 
distCofree' ::   (Functor f, Functor g, Functor h) =>
                (forall a. f (h a) -> h (g a)) ->
                f (Cofree h a) -> Cofree h (g a)
 

and it should have the property that:

 
distCofree' (f . eta) == distCofree' f . eta
 

Without that, g_chronoEta is more powerful than g_chrono. Naturally.

Source Code

First, we can make the generalized hylomorphism from the other day more efficient by noting that once you inline the hylomorphism, you can see that you do 3 fmaps over the same structure, so we can fuse those together yielding:

 
g_hylo :: (Comonad w, Functor f, Monad m) =>
          (forall a. f (w a) -> w (f a)) ->
	  (forall a. m (f a) -> f (m a)) ->
	  (f (w b) -> b) ->
	  (a -> f (m a)) ->
          (a -> b)
g_hylo w m f g = extract . g_hylo' w m f g . return
 
-- | the kernel of the generalized hylomorphism
g_hylo' :: (Comonad w, Functor f, Monad m) =>
          (forall a. f (w a) -> w (f a)) ->
	  (forall a. m (f a) -> f (m a)) ->
	  (f (w b) -> b) ->
	  (a -> f (m a)) ->
          (m a -> w b)
g_hylo' w m f g =
    liftW f . w .
    fmap (duplicate . g_hylo' w m f g . join) .
    m . liftM g
 

Also, the above made me realize that most of the generalized cata/ana, etc morphisms give you a little more interesting stuff to do if you separate out the recursive part. Then you can pass it a monad built with something other than return to perform substitution on, or inspect the comonadic wrapper on the result.

Oh, and to support my earlier claim that g_hylo generalizes g_cata and g_ana here are derivations of each in terms of g_hylo.

 
g_cata :: (Functor f, Comonad w) =>
          (forall a. f (w a) -> w (f a)) ->
          (f (w a) -> a) ->
          Mu f -> a
 
g_cata k f = g_hylo k (fmap Id . runId) f (fmap Id . outF)
 
g_ana :: (Functor f, Monad m) =>
         (forall a. m (f a) -> f (m a)) ->
         (a -> f (m a)) ->
         a -> Nu f
g_ana k g = g_hylo (Id . fmap runId) k (InF . fmap runId) g
 

As an aside, histomorphisms have a dual that seems to be elided from most lists of recursion schemes: Uustalu and Vene call it a futumorphism. It basically lets you return a structure with seeds multiple levels deep rather than have to plumb 'one level at a time' through the anamorphism. While a histomorphism is a generalized catamorphism parameterized by the cofree comonad of your functor, a futumorphism is a generalized anamorphism parameterized by the free monad of your functor.

 
futu :: Functor f => (a -> f (Free f a)) -> a -> Nu f
futu f = ana ((f ||| id) . runFree) . return
 

Now, g_hylo is painfully general, so lets look at a particularly interesting choice of comonad and monad for a given functor that always have a distributive law: the cofree comonad, and the free monad of that very same functor!

This gives rise to a particular form of morphism that I haven't seem talked about in literature, which after kicking a few names around on the haskell channel we chose to call a chronomorphism because it subsumes histo- and futu- morphisms.

 
chrono :: Functor f =>
          (f (Cofree f b) -> b) ->
          (a -> f (Free f a)) ->
          a -> b
 

Unlike most of the types of these generalized recursion schemes, chrono's type is quite readable!

A chronomorphism's fold operation can 'look back' at the results it has given, and its unfold operation can 'jump forward' by returning seeds nested multiple levels deep. It relies on the fact that you always have a distributive law for the cofree comonad of your functor over the functor itself and also one for the functor over its free monad and so it works for any Functor.

You can generalize it like you generalize histomorphisms and futumorphisms, and derive ana and catamorphisms from it by noting the fact that you can fmap extract or fmap return to deal with the cofree comonad or free monad parts of the term.

Alternately, since the 'identity comonad' can be viewed as the cofree comonad of the Functor that maps everything to , you can also choose to rederive generalized futumorphisms from generalized chronomorphism using the distributive law of the identity comonad.

Below you'll find source code for generalized hylo- cata- ana- histo- futu- chrono- etc... morphisms and their separated kernels.

Source Code

As an aside, Dan Doel (dolio) has started packaging these up for addition to category-extras in Hackage.

I haven't seen written up anywhere the following operator (g_hylo), defined in the spirit of generalized catamorphisms and generalized anamorphisms, which seems to follow rather naturally from the definition of both -- I'm using liftW & liftM rather than fmap to make it clear what is being lifted over what.

 
class Functor w => Comonad w where
        -- minimal definition: extend & extract or duplicate & extract
        duplicate :: w a -> w (w a)
        extend :: (w a -> b) -> w a -> w b
        extract :: w a -> a
        extend f = fmap f . duplicate
        duplicate = extend id
 
liftW :: Comonad w => (a -> b) -> w a -> w b
liftW f = extend (f . extract)
 
g_hylo :: (Comonad w, Functor f, Monad m) =>
          (forall a. f (w a) -> w (f a)) ->
          (forall a. m (f a) -> f (m a)) ->
          (f (w b) -> b) ->
          (a -> f (m a)) ->
          a -> b
g_hylo w m f g =
     extract .
     hylo (liftW f . w . fmap duplicate) (fmap join . m . liftM g)
     . return
   where
     hylo f g = f . fmap (hylo f g) . g
 

In the above, w and m are the distributive laws for the comonad and monad respectively, and hylo is a standard hylomorphism. In the style of Dave Menendez's Control.Recursion code it would be a 'refoldWith' and it can rederive a whole lot of recursion and corecursion patterns if not all of them.

Anyone?

Today I'd like to talk about free monads.

The free monad of a functor is a monad that is uniquely determined by the functor (up to isomorphism, etc), given by:

 
data Free f a = Roll (f (Free f a)) | Return a
-- newtype Free f a = Free { unfree :: Either a (f (Free f a))) }
 

Usually the above is written up using a newtype around a sum (Either) so you can write it using nice point-free style, but I think this makes for clearer introduction this way.

The idea is that you take the functor and recursively fold it in upon a choice of either itself or a naked variable.

 
instance Functor f => Functor (Free f) where
	fmap f (Roll x) = Roll $ fmap (fmap f) x
	fmap f (Return x) = Return (f x)
 

Now, we wouldn't call it the free 'monad' without reason. Return is the obvious candidate for 'return', but bind is a little trickier:

 
instance Functor f => Monad (Free f) where
	return = Return
	Return m >>= k = k m -- given by: return m >>= k = k m
	Roll m >>= k = Roll $ fmap (>>= k) m
 

(>>=) substitutes 'subtrees' for all of the naked variables in our monad. This is the gist of the monads of (co)trees section of Uustalu and Vene's The Dual of Substitution is Redecoration.

We can define a form of catamorphism for the free monad:

 
foldF :: Functor f => (f a -> a) -> Free f a -> a
foldF phi (Roll x) = phi $ fmap (foldF phi) x
foldF _ (Return x) = x
 

The problem is you want to be able to perform different folds that return different types, so lets quantify over the variable in the monad.

 
newtype Forall f = Forall { unforall :: forall a. f a } 
 
cataF :: Functor f => (f a -> a) -> Forall (Free f) -> a
cataF phi = foldF . unforall
 

Lets motivate this with an example. Take the identity functor, and give it a funny name:

 
data Succ a = Succ a
instance Functor Succ where
	fmap f (Succ a) = Succ (f a)
 

We can steal a nice typeclass from Laemmel and Rypacek:

 
instance (Show a, Show (f (Free f a))) => Show (Free f a) where
        show (Roll x) = "(Roll (" ++ show x ++ "))"
        show (Return x) = "(Return (" ++ show x ++ "))"
 

And with it we can see that the members of the monad "Free Succ" are terms of the form:

 
Return x
Roll (Succ (Return x))
Roll (Succ (Roll (Succ (Return x))))
...
 

Which if we look through it with goggles that quantify over x and ignore the Return/Roll noise looks like the Peano numerals!

 
type Peano = Forall (Free Succ)
 

Then working in the monad "Free Succ", the bind function (>>=) hunts down the value of the 'a' term and substitutes the
output of the function.

For example:

 
Roll (Succ (Roll (Succ ()))) >>= const Roll (Succ ())
    == Roll (Succ (Roll (Succ (Roll (Succ ()))))
 

We can easily convert natural numbers to Peano form, exploiting this:

 
toNat :: Int -> Free Succ ()
toNat n | n > 0 = toNat (n - 1) >> Succ ()
toNat 0 	= return ()
 

And we can translate back from Peano form, by first replacing the () with a 0, and then using the non-polymorphic
fold operation from before.