Sat Jul 27 16:56:51 JST 2013

Prelude> data Tree a = Leaf a | Tree a :^: Tree a deriving Show
Prelude> let treeMap f t = case t of { Leaf x -> Leaf $ f x ; l :^: r -> (treeMap f l) :^: (treeMap f r) }
Prelude> treeMap succ ((Leaf 0) :^: (((Leaf 2) :^: (Leaf 3)) :^: (Leaf 4)))
Leaf 1 :^: ((Leaf 3 :^: Leaf 4) :^: Leaf 5)

data Tr a = Lf a | Tr a :^: Tr a deriving Show

instance Functor Tr where
  fmap f (Lf x) = Lf (f x)
  fmap f (l :^: r) = (fmap f l) :^: (fmap f r)

main = print $ a where
  t = ((Lf 1 :^: Lf 2) :^: Lf 3) :^: Lf 4
  a = fmap (+1) t