-- Определяем типы (алгебру) узлов дерева (int, add, …)
class Algebra rep where
	int :: Int     -> rep Int
	add :: rep Int -> rep Int -> rep Int
	
	lam :: (rep a -> rep b) -> rep (a -> b)
	app :: rep (a -> b)     -> rep a        -> rep b

-- «Визитор»-вычислитель выражения: объявление
newtype Eval a = E {unE :: a}

-- «Визитор»-вычислитель выражения: определение
instance Algebra Eval where
	int 	= E
	add	x y = E (unE x + unE y)
	lam f 	= E (unE . f . E)
	app f x = E ( (unE f) (unE x) )

-- «Визитор»-измеритель глубины выражения: объявление
newtype Depth a = D {unD :: Int}

-- «Визитор»-измеритель глубины выражения: определение
instance Algebra Depth where
	int _	= D 1
	add	x y = D (1 + max (unD x) (unD y))
	lam f 	= D (1 + unD (f (D 0)))
	app f x = D (1 + max (unD f) (unD x))

-- Пример дерева: (\x -> x + 2) 1
test2 :: Algebra rep => rep Int
test2  = app (lam (\x -> add x (int 2))) (int 1)

-- Основная программа: печатает результат вычисления test2 и его высоту
main = print $ (unE test2, unD test2) -- (3, 4)