Traversing polymorphic structures and performing a transformation only in few cases

Question

Suppose we represent a company hierarchy in the following way:

{-# LANGUAGE DeriveDataTypeable #-}

import           Data.Data
import           Data.Generics.Aliases
import           Data.Generics.Schemes

data CompanyAsset = Employee Name Salary
                  | Plant Name
                  | Boss Name Performance Salary [CompanyAsset]
                  | Pet Name
                  | Car Id
                  | Guild [CompanyAsset]
                  | Fork CompanyAsset CompanyAsset
                  -- ... and imagine 100 more options that recursively use `CompanyAsset`.
                  deriving (Show, Data)

-- Performance of the department.
data Performance = Good | Bad deriving (Show, Data)

type Name = String

type Id = Int

newtype Salary = Salary Double deriving (Show, Data, Typeable)

raise :: Salary -> Salary

And I would like to defne a function that raises the salaries of company assets that do not have a Boss ancestor whose department had a Bad performance. Such a function can be easily defined as follows:

raiseSalaries :: CompanyAsset -> CompanyAsset
raiseSalaries (Boss n Good s as) = Boss n Good (raise s) (raiseSalaries <$> as)
raiseSalaries a@(Boss _ Bad _ _) = a -- The salaries of everything below are not raised if the performance is 'Bad'
raiseSalaries ... -- and from here onwards we have **boilerplate**!

The problem is that this requires a lot of boilerplate (for the sake of the discussion, please assume that the CompanyAsset is given and cannot be changed).

So my question is whether there is a way of traversing data structures in such a way that the boilerplate above can be avoided.

This question is related to a similar one I posted, but in this case the use of everywhere' won't help, since there are cases in which salaries should not be raised.

Answer 1

This can be accomplished with a Traversal for CompanyAsset. You can write it yourself, or use uniplate or plate from lens.

For illustration, I'm going to write a traversal for CompanyAsset explicitly. It applies an operation (which I call p as in pure) to each direct descendant of a company asset. Note that traverse_ca pure == pure.

traverse_ca :: Applicative f => (CompanyAsset -> f CompanyAsset) -> CompanyAsset -> f CompanyAsset
traverse_ca p ca =
  case ca of
    Fork ca1 ca2      -> Fork <$> p ca1 <*> p ca2
    Boss n perf s cas -> Boss n perf s <$> traverse p cas
    Guild cas         -> Guild <$> traverse p cas
    otherwise         -> pure ca

By itself this is enough to define raiseSalaries without any additional boilerplate.

import Data.Functor.Identity

raiseSalaries :: CompanyAsset -> CompanyAsset
raiseSalaries (Boss n Good s as) = Boss n Good (raise s) (raiseSalaries <$> as)
raiseSalaries a@(Boss _ Bad _ _) = a -- The salaries of everything below are not raised if the performance is 'Bad'
raiseSalaries a = runIdentity $ traverse_ca (pure . raiseSalaries) a