import Monad
import Data.Typeable

-- shamelessly stolen from "Scrap your boilerplate: a practical design pattern for generic programming"

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

genCom :: Company
genCom = C [D "Research" ralf [PU joost, PU marlow], D "Strategy" blair [DU (D "bla" blae [])]]
ralf, joost, marlow, blair, blae :: Employee
ralf = E (P "Ralf" "Amsterdam") (S 8000)
joost = E (P "Joost" "Amsterdam") (S 1000)
marlow = E (P "Marlow" "Cambridge") (S 2000)
blair = E (P "Blair" "London") (S 100000)
blae = E (P "Blae" "London") (S 100000)

-- nechceme odvozovat gmapT, gMapQ, a pripadne dalsi prochazeci funkce

class Typeable a => Data a where
  gfoldl :: (forall x y . Data x => w (x->y) -> x -> w y) -> -- pridani operandu
	    (forall x y .  w (x->y) -> x -> w y) -> -- pridani operandu, ktery nechceme prochazet
            (forall g . g-> w g) -- vytvoreni pocatecni hodnoty z konstruktoru
	    -> a -- struktura
	    -> w a -- vysledek

-- gmapT -- specialni pripad -- w je identita
newtype Id x = Id {unId :: x}
gmapT :: Data a => (forall b. Data b => b -> b) -> a -> a
gmapT f s = unId $ gfoldl (\p x -> Id (unId p (f x))) (\p x -> Id (unId p x)) Id s

-- gmapQ -- specialni pripad -- w je seznam vysledku.  [r]->[r] kvuli obraceni asociativity.
newtype Q r a = Q {unQ :: [r]->[r]}
gmapQ :: Data a => (forall b. Data b => b -> r) -> a -> [r]
gmapQ f x = unQ (gfoldl k k' (const (Q id)) x) []
  where
    k (Q c) x = Q (\rs -> c (f x : rs))
    k' (Q c) _ = Q (\rs -> c rs)

-- gmapQ :: (forall b. Data b => b -> r) -> a -> [r]

instance Data Company where
  gfoldl f r i (C depts) = i C `f` depts
instance Data Dept where
  gfoldl f r i (D name man subs) = ((i D `r` name) `f` man) `f` subs
instance Data SubUnit where
  gfoldl f r i (PU emp) = i PU `f` emp
  gfoldl f r i (DU dept) = i DU `f` dept
instance Data Employee where
  gfoldl f r i (E per sal) = (i E `f` per) `f` sal
instance Data Person where
  gfoldl f r i p = i p
instance Data Salary where
  gfoldl f r i s = i s

instance Data a => Data [a] where
  gfoldl f r i [] = i []
  gfoldl f r i (x : xs) = (i (:) `f` x) `f` xs