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
_______________________________________________
Haskell-Cafe mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to