-- Expression trees and their fold

data Tree o a = Node o (Tree o a) (Tree o a) | Leaf a  deriving Show

data Oper = Add | Mul | Sub  deriving Show

type Expr = Tree Oper Integer

fold f g (Leaf a)     = f a
fold f g (Node o l r) = g o (fold f g l) (fold f g r)


-- Evaluation and pretty-printing

syn Add = "+" ;  syn Mul = "*" ;  syn Sub = "-"
sem Add = (+) ;  sem Mul = (*) ;  sem Sub = (-)

eval = fold id   sem
pprt = fold show inf  ::  Expr->String

inf o l r = concat ["(", l, syn o ,r, ")"]


-- Tracing a calculation

comb op ls@(l:_) (r:tr) = let (&) = Node op in
  Leaf (eval (l&r)) : [x&r | x<-ls] ++ [last ls & y | y<-tr]

trace = fold ((:[]) . Leaf) comb

sep = foldl1 (\x y -> x++"\n  =>  "++y)

calc = putStr . sep . map pprt . reverse . trace


-- Test data

[(+:), (*:), (-:)] = map Node [Add,Mul,Sub]

test0 = (Leaf 2 +: Leaf 3) *: (Leaf 4 +: (Leaf 5 +: Leaf 6))

test1 = (Leaf 2 *: Leaf 3) +: (Leaf 4 *: Leaf 5)

test2 = fold (Leaf . succ) Node test1 -: test1