
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