[Haskell-cafe] traversal transformations

[Sjoerd Visscher]

Hi,

While playing with Church Encodings of data structures, I realized  
there are generalisations in the same way Data.Foldable and  
Data.Traversable are generalisations of lists.

The normal Church Encoding of lists is like this:

 > newtype List a = L { unL :: forall b. (a -> b -> b) -> b -> b }

It represents a list by a right fold:

 > foldr f z l = unL l f z

List can be constructed with cons and nil:

 > nil      = L $ \f -> id
 > cons a l = L $ \f -> f a . unL l f

Oleg has written about this: http://okmij.org/ftp/Haskell/zip-folds.lhs

Now function of type (b -> b) are endomorphisms which have a  
Data.Monoid instance, so the type can be generalized:

 > newtype FM a = FM { unFM :: forall b. Monoid b => (a -> b) -> b }
 > fmnil      = FM $ \f -> mempty
 > fmcons a l = FM $ \f -> f a `mappend` unFM l f

Now lists are represented by (almost) their foldMap function:

 > instance Foldable FM where
 >   foldMap = flip unFM

But notice that there is now nothing list specific in the FM type,  
nothing prevents us to add other constructor functions.

 > fmsnoc l a = FM $ \f -> unFM l f `mappend` f a
 > fmlist = fmcons 2 $ fmcons 3 $ fmnil `fmsnoc` 4 `fmsnoc` 5

*Main> getProduct $ foldMap Product fmlist
120

Now that we have a container type represented by foldMap, there's  
nothing stopping us to do a container type represented by traverse  
from Data.Traversable:

{-# LANGUAGE RankNTypes #-}

import Data.Monoid
import Data.Foldable
import Data.Traversable
import Control.Monad
import Control.Applicative

newtype Container a = C { travC :: forall f b . Applicative f => (a ->  
f b) -> f (Container b) }

czero :: Container a
cpure :: a -> Container a
ccons :: a -> Container a -> Container a
csnoc :: Container a -> a -> Container a
cpair :: Container a -> Container a -> Container a
cnode :: Container a -> a -> Container a -> Container a
ctree :: a -> Container (Container a) -> Container a
cflat :: Container (Container a) -> Container a

czero       = C $ \f -> pure czero
cpure x     = C $ \f -> cpure <$> f x
ccons x l   = C $ \f -> ccons <$> f x <*> travC l f
csnoc l x   = C $ \f -> csnoc <$> travC l f <*> f x
cpair l r   = C $ \f -> cpair <$> travC l f <*> travC r f
cnode l x r = C $ \f -> cnode <$> travC l f <*> f x <*> travC r f
ctree x l   = C $ \f -> ctree <$> f x <*> travC l (traverse f)
cflat l     = C $ \f -> cflat <$> travC l (traverse f)

instance Functor Container where
   fmap g c = C $ \f -> travC c (f . g)
instance Foldable Container where
   foldMap  = foldMapDefault
instance Traversable Container where
   traverse = flip travC
instance Monad Container where
   return   = cpure
   m >>= f  = cflat $ fmap f m
instance Monoid (Container a) where
   mempty   = czero
   mappend  = cpair

Note that there are all kinds of "constructors", and they can all be  
combined. Writing their definitions is similar to how you would write  
Traversable instances.

So I'm not sure what we have here, as I just ran into it, I wasn't  
looking for a solution to a problem. It is also all quite abstract,  
and I'm not sure I understand what is going on everywhere. Is this  
useful? Has this been done before? Are there better implementations of  
foldMap and (>>=) for Container?

Finally, a little example. A Show instance (for debugging purposes)  
which shows the nesting structure.

newtype ShowContainer a = ShowContainer { doShowContainer :: String }
instance Functor ShowContainer where
   fmap _ (ShowContainer x) = ShowContainer $ "(" ++ x ++ ")"
instance Applicative ShowContainer where
   pure _ = ShowContainer "()"
   ShowContainer l <*> ShowContainer r = ShowContainer $ init l ++ ","  
++ r ++ ")"
instance Show a => Show (Container a) where
   show = doShowContainer . traverse (ShowContainer . show)

greetings,
--
Sjoerd Visscher
sjoerd at w3future.com