cats.hs

{-# LANGUAGE RankNTypes, FlexibleContexts #-}
data Fix f = Fx (f (Fix f))

unFx :: Fix f -> f (Fix f)
unFx (Fx x) = x

type Alg f a = Functor f => f a -> a

cata :: Functor f => Alg f a -> Fix f -> a
cata alg = alg . fmap (cata alg) . unFx
-- Point-ful style:
--cata alg fixd = alg (fmap (cata alg) (unFx fixd))
-- 
data Expr k = Var Int
            | Plus k k
            deriving Show

instance Functor Expr where
  fmap f (Var x) = Var x
  fmap f (Plus lhs rhs) = Plus (f lhs) (f rhs)

eval :: Alg Expr Int
eval (Var x) = x
eval (Plus x y) = x + y

print :: Alg Expr String
print (Var x) = show x
print (Plus x y) = x ++ " + " ++ y

v = Fx $ Plus (Fx $ Var 3) (Fx $ Var 7)

-- Step by step:
final = cata Main.print v

s1 = cata Main.print (Fx (Plus (Fx (Var 3)) (Fx (Var 7))))
s2 = Main.print (fmap (cata Main.print) (unFx (Fx (Plus (Fx (Var 3)) (Fx (Var 7)))) ))
s3 = Main.print (fmap (cata Main.print) (Plus (Fx (Var 3)) (Fx (Var 7))))
s4 = Main.print (Plus (cata Main.print (Fx (Var 3))) (cata Main.print (Fx (Var 7))) )
s5 = Main.print (Plus (Main.print (fmap (cata Main.print) (unFx (Fx (Var 3))))) (Main.print (fmap (cata Main.print) (unFx (Fx (Var 7))))))
s6 = Main.print (Plus (Main.print (fmap (cata Main.print) (Var 3))) (Main.print (fmap (cata Main.print) (Var 7))) )
s7 = Main.print (Plus (Main.print (Var 3)) (Main.print (Var 7)) )
s8 = Main.print (Plus "3" "7")
s9 = "3 + 7"

main = do
  putStrLn $ show $ cata eval v
  putStrLn $ cata Main.print v