Play With Your Boilerplate

by Neil Mitchell

Generic traversals and queries are often referred to as boilerplate code - they remain relatively similar as the action performed by the code changes, and can often outnumber the actual intent of the code in terms of lines. While other generic traversal schemes have shown how powerful new features can be added to compilers, and how the type system can be manipulated into accepting these operations, this document focuses on a conceptually simpler generic concept. The Play class is introduced, which abstracts over common traversals and queries in a simple manner.

There have been several attempts at generic traversal/query methods in Haskell. One initial paper was "Scrap your boilerplate: a practical design pattern for generic programming" (free copy) - which I will refer to as SYB. Another mechanism is "A Pattern for Almost Compositional Functions" (free copy) - which I refer to as Compos (after the name of their class).

The principle advantage of the Play class over these two papers is that it requires no type system extensions, compared to rank-2 types for SYB and GADT's for Compos. The simplicity of the types required means that the user is free to concentrate on the operations within the class, without requiring thought as to the type trickery required. The Play pattern has been implemented in Yhc for the Core data type, and in Catch on several data types within the program.

This document proceeds as follows:

  1. The motivation and use cases for Play
  2. How to use the Play class
  3. Derivation of a Play instance for your own data type
  4. Extension to PlayEx
  5. A comparison to the SYB paper
  6. A comparison to the Compos paper

All the examples used in this document can be found in the darcs repository, under the Examples directory.

darcs get --partial http://www.cs.york.ac.uk/fp/darcs/play

If you only wish to read a small fraction of this document, can I suggest you pay particular attention to mapUnder and allOver - these are by far the most common transformational patterns.

Acknowledgements

Thanks to Björn Bringert for feedback on an earlier version of this document, Eric Mertens for various ideas and code snippets, and to Matt Naylor and Tom Shackell for helpful discussions.

Motivation and Use Cases

The idea behind the Play class is that there exists a data structure, usually with a reasonable number of constructors, which is often transformed or analysed. The usual example of this would be a compiler, which has at its core an expression type. This can be seen as a form of generic programming.

The Play class has the following goals:

The ideas behind the Play class have been used extensively, in both the Yhc compiler and the Catch tool. In Catch there are 109 traversals using the Play class (as at Nov 2006), showing that the Play class gets extensive use.

Using Play

These examples revolve around a small arithmetic language, given here:

import Data.Play

data Expr = Val Int
          | Add Expr Expr
          | Sub Expr Expr
          | Div Expr Expr
          | Mul Expr Expr
          | Neg Expr
          deriving (Show, Eq)

Assume that a Play class has already been written; so now instance Play Expr is available to us. Some examples are presented, in rough order of increasingly complexity. These examples are all available in the Examples/Expr.hs file.

Checking for division by zero

allOver :: Play on => on -> [on]

If an expression is divided by zero, this causes a runtime error in our language. As part of the compiler, it's nice to give the user a warning message about this. This can be done with the following test:

hasDivZero :: Expr -> Bool
hasDivZero x = not $ null [() | Div _ (Val 0) <- allOver x]

Here the only Play method being used is allOver. Given a tree, allOver returns all the root of the tree, and all it's subtrees at all levels. This can be used to quickly flatten a tree structure into a list, for quick analysis via list comprehensions, as is done above. For each division by zero found, any value is created in the list comprehension, and then this is checked to see if anything did match. Returning the count of divide by zero errors is trivial, simply use length instead of not $ null. Extra context could perhaps be given by printing some of the value that is being divided by zero, to help narrow down the error.

Exercise: Write a function to find all literals that occur in an expression, together with their count.

Basic optimisation

mapUnder :: Play on => (on -> on) -> on -> on

If we are negating a literal value, this computation can be performed in advance, so let's write a function to do this.

optimise :: Expr -> Expr
optimise = mapUnder $ \x -> case x of
    Neg (Val i) -> Val (negate i)
    x -> x

Here the Play method being used is mapUnder. This applies the given function to all the children of an expression, before applying it to the parent. This can be thought of as bottom-up traversal of the data structure. There is an equivalent mapOver defined, but generally mapUnder is used about 90% of the time. The optimise code merely pattern matches on the negation of a literal, and replaces it with the literal. Using mapUnder means that Neg (Neg (Val 1)) is reduced to 1, using mapOver would only perform the inner most reduction.

Now lets add another optimisation into the same pass, just before the x -> x line insert:

    Add x y | x == y -> Mul x (Val 2)

This takes an addition where two terms are equal and changes it into a multiplication, causing the nested expression to be executed only once. This shows that normal Haskell applies, the Play lets you write code as before.

Exercise: Extend the optimisation to so that adding x to Mul x (Val 2) produces a multiplication by 3.

Elimination of Negation

mapOver :: Play on => (on -> on) -> on -> on

It is possible to eliminate negation entirely, and perhaps this would be a useful computation to perform:

noNegate :: Expr -> Expr
noNegate = mapOver $ \x -> case x of
    Neg (Val i) -> Val (negate i)
    Neg (Neg x) -> x
    Neg (Sub a b) -> Sub b a
    Neg (Add a b) -> Add (Neg a) (Neg b)
    Neg (Div a b) -> Div (Neg a) b
    Neg (Mul a b) -> Mul (Neg a) b
    x -> x

This is an example where a bottom up traversal would not work, as information is being pushed from the top downwards. Note how each line states a mathematical property, which can be proved in isolation, and that the Play class handles the traverals.

Exercise: Write a similar transformation to eliminate subtraction. These two transformations can be composed, to give a reduced expression language. Can any other expressions be eliminated?

Depth of an expression

fold :: Play on => ([res] -> tmp) -> (on -> tmp -> res) -> on -> res

Now lets imagine that programmers in your language are paid by the depth of expression they produce, so lets write a function that computes the maximum depth of an expression.

depth :: Expr -> Int
depth = fold (foldr max 0) $ const (+1)

This function performs a fold over the data structure. The foldr max is being used as maximum, with a starting value of 0. The next bit simply says that for each iteration, add one to the previous depth. An evaluator for this expression language can also be modelled as a fold, see inside the example directory to see an implementation.

Each fold collects all the values from the children of an expression, combines them using the first function, then generates a new value based on the expression. Often the combining function will simply be id.

Exercise: Write a function that counts the maximum depth of addition only.

Renumbering literals

mapUnderM :: (Monad m, Play on) => (on -> m on) -> on -> m on

The literal values need to be replaced with a sequence of numbers, each unique. This is unlikely for an arithmetic expression, but consider bound variables in lambda calculus and it starts to become a bit more plausible:

uniqueLits :: Expr -> Expr
uniqueLits x = evalState (mapUnderM f x) [0..]
    where
        f (Val i) = do
            y:ys <- get
            put ys
            return (Val y)
        f x = return x

Here a monadic computation is required, the program needs to keep track of what the next item in the list to use is, and replace the current item. By using the state monad, this can be done easily.

Exercise: Allow each literal to occur only once, when a second occurance is detected, replace that literal with zero.

Generating mutants

allOverContext :: Play on => on -> [(on, on -> on)]

The person who is inputting the expression thinks they made a mistake, they suspect they got one of the values wrong by plus or minus one. Generate all the expressions they might have written.

mutate :: Expr -> [Expr]
mutate x = concat [[gen $ Val $ i-1, gen $ Val $ i+1]
                  | (Val i, gen) <- allOverContext x]

The mapUnder function is useful for doing an operation to all nodes in a tree, but sometimes you only want to apply a transformation once. This is less common, but is sometimes required. The idea is that the context provides the information required to recreate the original expression, but with this node altered.

Exercise: Replace one multiplication with addition, if there are no multiplications return the original expression.

Reverse notation

replaceChildren :: Play on => on -> ([on], [on] -> on)

In general, allOver and mapUnder are used most of the time, and fold is used occasionally. The Play class is built upon the operation replaceChildren, which takes an expression, and returns a pair with the children of that expression, and a function to generate that expression with a new set of children in place. This operation can be directly exploited if required, although should be handled with caution.

Let us make a function that reverses the order of all the inputs, say if the user is working in Right-to-Left mode on their computer:

reverseExpr :: Expr -> Expr
reverseExpr = mapUnder f
    where
        f x = generate $ reverse collect
            where (collect,generate) = replaceChildren x

This expression does a standard mapUnder, but at each iteration calls replaceChildren, then reverses the children set before regenerating the original expression. This shows the underlying mechanism on which the library is based, and isn't recommended for average users.

Defining a Play instance

As shown in the reversal example (just above), the only method in the Play class is replaceChildren. The Play class is defined as:

class Play on where
    replaceChildren :: on -> ([on], [on] -> on)

The idea is that given an item, you want to return all the children, and a function that will replace all the children. An invariant is that the list given to the second function will be the same length as that returned in the first element of the pair. Let's start by constructing the Play instance for the expression type.

instance Play Expr of
    replaceChildren x =
        case x of
            Add a b -> ([a,b], \[a,b] -> Add a b)
            ...
            Neg a -> ([a], \[a] -> Neg a)
            Val i -> ([], \[] -> Val i)

A short study of the code should show how this works. The other constructors such as Mul follow the same pattern as Add. There are some additional combinators defined in the Play class to make this a bit easier.

instance Play Expr of
    replaceChildren x =
        case x of
            Add x y -> playTwo Add x y
            ...
            Neg x   -> playOne Neg x
            x -> playDefault x

Here playTwo takes a constructor of two expressions, and the expressions within them. The function playOne operates similarly on one expression. The remaining playDefault, which handles Val is for expressions with no recursive element.

Using PlayEx

The PlayEx class is not standard Haskell, requiring multi-parameter type classes. Where possible try and use the standard Play class. The PlayEx class is necessary when working with a data structure that has multiple types within it.

class Play with => PlayEx on with where
    replaceChildrenEx :: on -> ([with], [with] -> on)

The replaceChildrenEx method operates much like the replaceChildren, except for the different types. When the types of on and with are different, replaceChildrenEx returns the closest children of the requested type. When the types are the same, this function returns the root element, not it's children.

There are three mechanisms for writing PlayEx instances:

Using the operations from PlayEx

To see various operations being used from the PlayEx class, take a look at Examples/ComposPaper.hs. Typically the operations are just the same as Play, with Ex on the end. To use the Ex methods either import Data.PlayMPTC or Data.PlaySYB - depending on how the instances are to be written.

mapUnderEx :: PlayEx on with => (with -> with) -> on -> on
mapUnderExM :: (Monad m, PlayEx on with) => (with -> m with) -> on -> m on
allOverEx :: PlayEx on with => on -> [with]

Defining PlayEx manually

To see an example of this style of definition, see Examples/ComposBasic.hs. Here the useful combinations for definitions are:

playExDefault :: (Play on, PlayEx on with) => on -> ([with], [with] -> on)
playSelf :: a -> ([a], [a] -> a)
playMore :: PlayEx a b => (a -> c) -> a -> ([b],[b] -> c)

The playSelf function simply operates on values of the same data type, so typically a defintion will be created such as:

instance PlayEx Expr Expr where
    replaceChildrenEx = playSelf

The playExDefault takes on the same role as playDefault - when there are remaining definitions without any further interesting elements in. The playMore is designed to continue on the recursion, where elements on interest may lay within other elements.

Defining a PlayEx class using these combinations and direct operations is quite hard, and quite error prone. It is not recommend unless there is no alternative due to implementation restrictions. Note however than even if a PlayEx class is defined with the more powerful tools, an equivalent requiring only MPTC's does exist, so your code is not tied to the extensions forever.

Using the PlayEx combinators

To define the PlayEx class, there are three combinatiors that can be used. These automate much of the definition:

play :: on -> ([with],[with] -> on)
(/\) :: PlayEx item with => ([with], [with] -> item -> on) -> item -> ([with], [with] -> on)
(/\!) :: ([with], [with] -> item -> on) -> item -> ([with], [with] -> on)

Note, the above are presented with type signatures for completeness. They are intended to be used mechanically, without excessive thought.

To define a PlayEx instance for the Expr type introduced earlier:

instance PlayEx Expr a where
    replaceChildrenEx x =
        case x of
            Val a -> play Val /\! a
            Add a b -> play Add /\ a /\ b
            Sub a b -> play Sub /\ a /\ b
            ...
            Neg a -> play Neg /\ a

The definition follows mechanically. The only choice a user makes is whether to use the (/\) operator (which recurses into the child on the right), or the (/\!) operator, which doesn't. For example, here we have decided not to traverse inside the Int of Val. This can be changed, and would require a PlayEx instance for Int.

If using this style of definition, a special instance must be defined for the self case:

instance PlayEx Expr Expr where
    replaceChildrenEx = playSelf

Unfortunately this requires undecidable instances. A Play instance still needs to be written for each definition.

Using Scrap Your Boilerplate instances

To define Play and PlayEx instances for all types, in all combinations, simply:

import Data.PlaySYB

data Expr ... deriving (Typeable, Data)

The disadvatages of this are the lack of type safety - you can now do entirely meaningless operations, which the earlier definitions would have spotted as being an error. This code will also only work where Data.Generics is supported, namely GHC at the present time.

The clear advantage is that there is almost no work to creating Play instances.

Comparison to the SYB Paper

Many of the examples from the original SYB paper are recapped in the Compos paper, so have been covered in the next section. This section focuses on the underlying traversal mechanism employed by both types.

SYB vs Play, notion of children

Both traversals are based on the idea of finding the immediate children of a node. The difference is that Play considers a child to be one of the same type, which may not be immediately below the node. In contrast SYB considers all the immediate children. The above diagram shows the difference, where the orange nodes are all of the same type, and those with a black border are considered children.

While the SYB approach is clearly more logical in an untyped language, in a typed language it requires a considerable amount of trickery to get the types correct. The primary SYB traversal function is:

gfoldl :: (forall a b. Term a => w (a -> b)
                              -> a -> w b)
       -> (forall g. g -> w g)
       -> a -> w a

In the original SYB paper the authors note "Trying to understand the type of gfoldl directly can lead to brain damage." When compared to the type of replaceChildren, it is easy to see which is simpler at the type level.

replaceChildren :: on -> ([on], [on] -> on)

The basic difference between SYB and Play is the choice of the notion of children. It is reasonably easy to see that SYB is more powerful - there are many nodes in the above example that Play cannot reach. However in a typed language this has come at the cost of substantial type based thought. Play on the other hand simplified things with its alternative definition of child.

Comparison to the Compos Paper

The Compos paper provides a similar mechansim, so the obvious question is how they related. A summary of the advantages and disadvantages is provided, followed by reimplementations of their operations using Play and PlayEx. This code can be found in the ComposPaper file. This section is designed to be read with a copy of the Compos paper to hand, alternatives are given, but the tasks are not explained in this section.

Advantages of Play:

Advantages of Compos:

Now I compare the examples in the paper, with the equivalent using Play. The Compos variant is shown in italics.

Examples from Section 3

First off, I replicate the data structure from their paper, along with a Play instance.

data Exp = EAbs String Exp
         | EApp Exp Exp
         | EVar String
         deriving Show

instance Play Exp where
    replaceChildren x =
        case x of
            EAbs a c -> playOne (EAbs a) c
            EApp c1 c2 -> playTwo EApp c1 c2
            x -> playDefault x

The rename function

Now let us examine the rename function. In addition to the Compos and Play versions, I first present the version written without any traveral code:

rename :: Exp -> Exp
rename e = case e of
    EAbs x b -> EAbs ("_" ++ x) (rename b)
    EApp c a -> EApp (rename c) (rename a)
    EVar x   -> EVar ("_" ++ x)

And now the two variants from the libraries:

rename :: Exp -> Exp
rename e = case e of
    EAbs x b -> EAbs ("_" ++ x) (rename b)
    EVar x   -> EVar ("_" ++ x)
    _        -> composOp rename e
rename :: Exp -> Exp
rename = mapUnder $ \e -> case e of
    EAbs s x -> EAbs ("_" ++ s) x
    EVar s -> EVar ("_" ++ s)
    x -> x

Note that in the Compos version there is only one function, in contrast to two in the Play version. However, in the Play version the traversal code is at the top, whereas with Compos it is the base case. Also note that in EAbs Compos has to continue the recursion, if the (rename b) call was missed then this would not work - Play takes care of this detail automatically.

The free function

free :: Exp -> [String]
free e = case e of
    EAbs x b -> delete x (free b)
    EVar x -> [x]
    _ -> composOpFold [] union free e
free :: Exp -> [String]
free = fold (nub . concat) $ \e y -> case e of
    EAbs s x -> delete s y
    EVar s -> [s]
    x -> y

In this function the two approaches are relatively similar, in Compos the fold information is at the bottom, in Play it is at the top. Play gives slightly more freedom by allowing the combining function to combine a list in the heirarchy at a time, while Compos only lets a merge function merge two elements.

The fresh function

fresh :: Exp -> Exp
fresh x = evalState (f [] x) names
    where
        names = ["_" ++ show n | n <- [0..]]
        f vs t = case t of
            EAbs x b -> do
                y:fs <- get
                put fs
                liftM (EAbs y) (f ((x,y):vs) b)
            EVar x ->
                return (EVar (fromMaybe x (lookup x vs)))
            _ -> composOpM (f vs) t
fresh :: Exp -> Exp
fresh x = evalState (f [] x) names
    where
        names = ["_" ++ show n | n <- [0..]]
        f vs t = case t of
            EAbs x b -> do
                y:fs <- get
                put fs
                liftM (EAbs y) (f ((x,y):vs) b)
            EVar x ->
                return (EVar (fromMaybe x (lookup x vs)))
            _ -> composM (f vs) t

In this particular example, none of the built in traversals provided by Play are much better than Compos, so instead the compos operator has been defined in the Play framework. This shows that anything Compos can do, Play can copy at the very least. (The code from the Compos example has been updated to use Control.Monad.State, to make it more accessible)

Examples from Section 4

The types manipulated by Secion 4 are:

data Stm = SDecl Typ Var
         | SAss  Var Exp
         | SBlock [Stm]
         | SReturn Exp

data Exp = EStm Stm
         | EAdd Exp Exp
         | EVar Var
         | EInt Int

data Var = V String

data Typ = T_int | T_float

The first thing done by the Compos paper is to translate this into a GADT, which destroys abstraction. If a data structure representing a program was also defined, then this would have to be merged into the single GADT. Play on the other hand accepts the definition as supplied.

The manual PlayEx instances for this data structure are not particularly nice, this is mainly due to the decision to have EStm in the Exp data type. A much more natural definition would be either to merge Stm and Exp, or to add SExp to Stm. If either of these things were done, then the Play instances would be vastly simplified. Because of the ugliness of the manual Play instances, I merely list the instances defined, the code for them is available in the example.

instance Play Stm
instance Play Exp
instance Play Var

instance PlayEx Stm Stm
instance PlayEx Exp Exp
instance PlayEx Stm Exp
instance PlayEx Exp Stm
instance PlayEx Stm Var
instance PlayEx Exp Var

Of course, it is possible to write the Play instances using the PlayEx combinators (if we are willing to pay for undecidable instances), and for Exp this is shown:

instance Play Exp where
    replaceChildren x =
        case x of
            EStm s -> playMore EStm s
            EAdd a b -> playTwo EAdd a b
            x -> playDefault x

instance PlayEx Exp Exp where; replaceChildrenEx = playSelf

instance Play a => PlayEx Exp a where
    replaceChildrenEx x =
        case x of
            EStm a -> play EStm /\ a
            EAdd a b -> play EAdd /\ a /\ b
            EVar a -> play EVar /\ a
            EInt a -> play EInt /\! a

These instances are more work than Compos, in particlar two copies have to be written compared to Compos, but they are at least relatively straight forward. If this is still too much work then:

data Stm = ... deriving (Data,Typeable)
data Exr = ... deriving (Data,Typeable)
data Var = ... deriving (Data,Typeable)

This permits the use of the SYB definitions, at the cost of some type safety. No instances need to be written at all.

While the choice of how to write the underlying functions is much more confusing with Play, compared to Compos, there is a good deal of flexibility. Depending on what features a user wishes to leverage, progressively shorter Play definitions can be specified. Hopefully the cost of writing instances will be low, compared to the use of Play functions. In one project the ratio is about 1:50, which supports this argument.

The rename function

rename :: Tree c -> Tree c
rename t = case t of
    V x -> V ("_" ++ x)
    _   -> composOp rename t
rename :: PlayEx x Var => x -> x
rename = mapUnderEx $ \(V x) -> V ("_" ++ x)

The first thing to note is the Play function is shorter, there is only one constructor in type Var. In contrast Compos has merged all constructors into one GADT, and can not benefit from this. The Compos function works over all trees, including those based on Typ, which is meaningless, since types do not contain variables. The Play class only operates on Exp and Stm types.

The warnAssign function

warnAssign :: Tree c -> IO ()
warnAssign t = case t of
    SAss _ _ -> putChar (chr 7)
    _ -> composM_ warnAssign t
warnAssign :: PlayEx x Stm => x -> IO ()
warnAssign = mapUnderExM_ $ \x -> case x of
    SAss _ _ -> putChar (chr 7)
    _ -> return ()

Here the traversals are very similar, both threading a Monad through the code. This example shows how monadic actions can be threading through a traversal, however, this is not usually necessary. Using the Play class, a more natural traversal emerges:

warnAssign :: PlayEx x Stm => x -> IO ()
warnAssign x = putStr [chr 7 | SAss{} <- allOverEx x]

Here the Play class is very concise. The Play approach extracts the relevant bits with a list comprehension. Hopefully this shows how analysis functions can often be implemented with allOver, rathern than a traversal. The Compos version could be written using a fold, which would reduce it's complexity, although would still be more complex than the Compos version.

The symbols function

symbols :: Tree c -> [(Tree Var, Tree Typ)]
symbols t = case t of
    SDecl typ var -> [(var,typ)]
    _ -> composOpMonoid symbols t
symbols :: PlayEx x Stm => x -> [(Var,Typ)]
symbols x = [(v,t) | SDecl t v <- allOverEx x]

Here the Compos function does a traversal of the tree, however again the Play class simply extracts the right bits. This example is almost identical to the previous warnAssign using Play, however the Compos approach introduces distinctions by requiring a more ordered approach to traversal.

The constFold function

constFold :: Tree c -> Tree c
constFold e = case e of
    EAdd x y -> case (constFold x, constFold y) of
                    (EInt n, EInt m) -> EInt (n+m)
                    (x',y') -> EAdd x' y'
    _ -> composOp constFold e
constFold :: PlayEx x Exp => x -> x
constFold = mapUnderEx $ \e -> case e of
    EAdd (EInt n) (EInt m) -> EInt (n+m)
    x -> x

The constant folding operation is a bottom-up traversal, requiring sub expressions to have been replaced before they are examined. Unfortunately Compos only supports top-down traversals, requiring the user to manually do a small traversal in the middle. Play supports both types of traversals, and experience has shown that bottom-up is almost always what the user wants. This allows Play to produce shorter code.

Section 7.1.1

The examples in Section 7.1.1 require lots of data types and lots of different styles of traversal. As such manual Play instances would not really be appropriate for this type of task - the instances would take too long to write. If we use the SYB instances, by importing Data.PlaySYB then we can start and take a look at the traversals. For this section, the SYB instance is presented first, followed by the Compos one, followed by the Play one.

For completeness the data definition is reproduced here. For SYB and Play, deriving clauses have to be added. For Compos the whole thing is replaced by a GADT. All the code for Play is in the file Examples/SYB.hs.

data Company = C [Dept]
data Dept = D Name Manager [Unit]
data Unit = PU Employee | DU Dept
data Employee = E Person Salary
data Person = P Name Address
data Salary = S Float
type Manager = Employee
type Name = String
type Address = String

The increase function

increase :: Data a => Float -> a -> a
increase k = everywhere (mkT (incS k))

incS :: Float -> Salary -> Salary
incS k (S s) = S (s * (1+k))
increase :: Float -> Tree c -> Tree c
increase k c = case c of
    S s -> S (s * (1+k))
    _ -> composOp (increase k) c
increase :: PlayEx x Salary => Float -> x -> x
increase k = mapUnderEx (\(S s) -> S (s * (1+k)))

Here the Play uses seems to be the most intuative. It requires no rank-2 types, no GADT's, and yet still provides the shortest code. The SYB approach requires separate functions to get the type classes working, and use of rather complex intermediates such as mkT and everywhere. The Compos function appears to be much simpler than SYB, but by merging all the data constructors has to perform a case on the value. By keeping the original structure intact, Play can simply state the property.

The incrOne function

incrOne :: Data a => Name -> Float -> a -> a
incrOne n k a | isDept n a = increase k a
              | otherwise = gmapT (incrOne n k) a

isDept :: Data a => Name -> a -> Bool
isDept n = False `mkQ` isDeptD n

isDeptD :: Name -> Dept -> Bool
isDeptD n (D n2 _ _) = n==n2
incrOne :: Name -> Float -> Tree c -> Tree c
incrOne d k c = case c of
    D n _ _ | n == d -> increase k c
    _ -> composOp (incrOne d k) c
incrOne :: PlayEx x Dept => String -> Float -> x -> x
incrOne name k = mapUnderEx (\d@(D n _ _) -> if name == n then increase k d else d)

Here SYB has grown substantially more complex, to accomodate the invariant, requiring two different utility functions. Compos still retains the same structure as before, requiring a case to distinguish between the types of constructor. Play remains shorter - although in this case the complexity is roughly the same as the Compos solution.

The salaryBill function

salaryBill :: Company -> Float
salaryBill = everything (+) (0 `mkQ` billS)

billS :: Salary -> Float
billS (S f) = f
salaryBill :: Tree c -> Float
salaryBill c = case c of
    S s -> s
    _ -> composOpFold 0 (+) salaryBill c
salaryBill :: PlayEx x Salary => x -> Float
salaryBill x = sum [x | S x <- allOverEx x]

Here the Play instance wins by being able to use a list comprehension to select the salary value out of a Salary object. The Play class is the only one that is able to use the standard Haskell sum function, not requiring an explicit fold to be performed. In this case it could easily be argued that billS is probably a general function, so the cost of writting it is not really correctly attributed to the SYB approach. If billS is a generally defined function, then you can rewrite the Play example as:

salaryBill2 :: PlayEx x Salary => x -> Float
salaryBill2 = sum . map billS . allOverEx

This solution is nice in that it is a very specification orientated view of the problem. Take all the salaries, get their value, and sum them.