[Haskell-cafe] SYB with class, simplified

[Benja Fallenstein]

Hi all,

The "scrap your boilerplate with class" sytstem [1] has two big
advantages over the plain SYB system from Data.Generics, IMHO: One, it
lets you declare an 'open' generic function as a type class, to which
new cases can be added by adding new instances (emphasized in the
paper); and two, it lets you write recursive functions that require
other type class constraints in addition to Data (not emphasized in
the paper, but something I've frequently found myself wanting with
Data.Generics).

[1] http://homepages.cwi.nl/~ralf/syb3/

However, when trying to convert the codebase I'm working on to
SYB-with-class, I've found that the type proxies and explicit
dictionaries used to simulate type class abstraction over type classes
are... annoying. Today, I've hit on an alternative approach to
implementing SYB-with-class (YAGS, yet another generics scheme...),
with less boilerplate per generic function. The approach may or may
not be new (I haven't studied *all* of the generics proposals out
there yet); in any case, it shares the use of type-level functions
with Smash Your Boilerplate, and it uses the same underlying gfoldl
operator as SYB, but implements it in a quite different way.

I believe that the equivalent of everywhere, mkT and friends can be
implemented as type-level functions in this framework, but I haven't
actually tried it yet.

This mail is a literate script demonstrating the approach. I'm hoping
to get some feedback on the idea. :)


On to the code:

> {-# OPTIONS_GHC -fglasgow-exts -fallow-overlapping-instances
> -fallow-undecidable-instances #-}

Yup, we need it all...

I'll start with three example generic functions.

* 'size' calculates the number of constructors in a term, except
  for lists, for which it returns one plus sum of the element sizes.
* 'inc' increases all Ints in a term by one.
* 'prints' prints out each subterm of a term on its own line,
  except for strings, for which it prints the string,
  but not its subterms.

Thus, the following code:

> test = ("Hello", 7::Int, [2,3::Int])
> main = do print (size test); print (inc test)
>           putStrLn ""; prints test; return ()

prints this:
----------------------------------------------------------------------
11
("Hello",8,[3,4])

("Hello",7,[2,3])
"Hello"
7
[2,3]
2
[3]
3
[]
----------------------------------------------------------------------

Here is the 'size' function:

> class Size a where size :: a -> Int
>
> data SizeF = SizeF
> instance Size a => Apply SizeF a Int where apply _ = size
>
> instance Size a => Size [a] where size xs = 1 + sum (map size xs)
> instance Apply (GMapQ SizeF) a [Int] => Size a where
>     size x = 1 + sum (gmapQ SizeF x)

The constraint (Apply f x r) means that 'f' is a type-level function
that, when applied to 'x,' returns 'r':

> class Apply f x r | f x -> r where apply :: f -> x -> r

Here is the 'inc' function:

> class Inc a where inc :: a -> a
>
> data IncF = IncF
> instance Inc a => Apply IncF a a where apply _ = inc
>
> instance Inc Int where inc = (+1)
> instance Apply (GMapT IncF) a a => Inc a where inc = gmapT IncF

And here is the 'prints' function; for illustration, the
implementation is in a slightly different style, which does without
the declaration of a new type class:

> data PrintsF = PrintsF;  prints x = apply PrintsF x
> instance Apply PrintsF String (IO String) where
>     apply _ x = print x >> return x
> instance (Show a, Apply (GMapM PrintsF) a (IO a)) =>
>          Apply PrintsF a (IO a) where
>     apply f x = print x >> gmapM f x

Note the 'Show' constraint: 'prints' can only be applied to values all
of whose subterms implement 'Show.' This is the kind of constraint you
can't have with the standard, not-with-class SYB code.


So much for the demo code; now, onwards to the actual library. The
core consists of the following three type classes:

> class Constr x   f where constr :: x -> a -> f a
> class Param  x p f where param  :: x -> f (p -> a) -> p -> f a
>
> class GFoldl x a f where gfoldl :: x -> a -> f a

Together, these classes form the equivalent of the standard SYB's
'gfoldl' method. (I'm ignoring the rest of the Data class at this
time, but I believe that it could be implemented in a similar
fashion.)

* 'Constr' and 'Param' correspond to the first and second argument
  of the standard SYB's gfoldl.

* The parameter 'x' specifies the type of fold to perform
  (GMapQ, GMapT and GMapM in the present module).

* We give an instance 'Constr' and 'Param' for each type of fold.
  We give an instance of 'GFoldl' for each type we want to fold over.

Here are the instances of GFoldl:

> instance Constr x f => GFoldl x ()   f where gfoldl = constr
> instance Constr x f => GFoldl x Char f where gfoldl = constr
> instance Constr x f => GFoldl x Int  f where gfoldl = constr
>
> instance (Constr x f, Param x a f, Param x [a] f) => GFoldl x [a] f where
>     gfoldl x [] = constr x []
>     gfoldl x (y:ys) = constr x (:) `p` y `p` ys where
>         p a b = param x a b
>
> instance (Constr x f, Param x a f, Param x b f, Param x c f) =>
>          GFoldl x (a,b,c) f where
>     gfoldl x (a,b,c) = constr x (,,) `p` a `p` b `p` c where
>         p a b = param x a b


What remains is the code for GMapQ, GMapT and GMapM:

> newtype GMapQ f = GMapQ f;  gmapQ f = apply (GMapQ f)
>
> newtype K a b = K { fromK :: a }
>
> instance GFoldl (GMapQ f) a (K [r]) => Apply (GMapQ f) a [r] where
>     apply (GMapQ f) x = reverse $ fromK $ gfoldl (GMapQ f) x
>
> instance Constr (GMapQ f) (K [r]) where constr _ _ = K []
> instance Apply f a r => Param (GMapQ f) a (K [r]) where
>     param (GMapQ f) (K xs) x = K (apply f x : xs)

> newtype GMapT f = GMapT f;  gmapT f = apply (GMapT f)
>
> newtype I a   = I { fromI :: a }
>
> instance GFoldl (GMapT f) a I => Apply (GMapT f) a a where
>     apply (GMapT f) x = fromI $ gfoldl (GMapT f) x
>
> instance Constr (GMapT f) I where constr _ = I
> instance Apply f a a => Param (GMapT f) a I where
>     param (GMapT f) (I x) y = I (x (apply f y))

> newtype GMapM f = GMapM f;  gmapM f = apply (GMapM f)
>
> instance (Monad m, GFoldl (GMapM f) a m) => Apply (GMapM f) a (m a) where
>     apply (GMapM f) x = gfoldl (GMapM f) x
>
> instance Monad m => Constr (GMapM f) m where constr _ = return
> instance (Monad m, Apply f a (m a)) => Param (GMapM f) a m where
>     param (GMapM f) m x = do fn <- m; arg <- apply f x; return (fn arg)


That ends the example. Comments would be appreciated! :-)

Thanks,
- Benja