syb.hs

{-# LANGUAGE DeriveDataTypeable #-}
module Syb where

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

data Company = C [Dept] deriving (Data, Typeable, Eq, Show)
data Dept = D Name Manager [SubUnit] deriving (Data, Typeable, Eq, Show)
data SubUnit = PU Employee | DU Dept deriving (Data, Typeable, Eq, Show)
data Employee = E Person Salary deriving (Data, Typeable, Eq, Show)
data Person = P Name Address deriving (Data, Typeable, Eq, Show)
data Salary = S Float deriving (Data, Typeable, Eq, Show)
type Manager = Employee
type Name = String
type Address = String

genCom :: Company
genCom = C [D "Research" ralf [PU joost, PU marlow],
            D "Strategy" blair []]

ralf, joost, marlow, blair :: Employee
ralf = E (P "Ralf" "Amsterdam") (S 8000)
joost = E (P "Joost" "Amsterdam") (S 10000)
marlow = E (P "Marlow" "Cambridge") (S 2000)
blair = E (P "Blair" "London") (S 100000)


increase :: Float -> Company -> Company
increase k (C ds) = C (map (incD k) ds)

incD :: Float -> Dept -> Dept
incD k (D nm mgr us) = D nm (incE k mgr) (map (incU k) us)

incU :: Float -> SubUnit -> SubUnit
incU k (PU e) = PU (incE k e)
incU k (DU d) = DU (incD k d)

incE :: Float -> Employee -> Employee
incE k (E p s) = E p (incS k s)

incS :: Float -> Salary -> Salary
incS k (S s) = S (s * (1 + k))

increaseGeneric :: Float -> Company -> Company
increaseGeneric k = everywhere (mkT (incS k))