Catamorphisms

{-# LANGUAGE DeriveFunctor #-}


{-
data Expr = Const Int
          | Parens Expr
          | Add Expr Expr
          | Mul Expr Expr
  deriving Show


eval :: Expr -> Int
eval (Const i) = i
eval (Parens e) = eval e
eval (Add e1 e2) = eval e1 + eval e2
eval (Mul e1 e2) = eval e1 * eval e2

height :: Expr -> Int
height (Const _) = 1
height (Parens e) = 1 + size e
height (Add e1 e2) = 1 + max (height e1) (height e2)
height (Mul _ _) = undefined


data List a = Nil | Cons a (List a) deriving Show

foldList :: b -> (a -> b -> b) -> (List a -> b)
foldList z _ Nil = z
foldList z f (Cons x xs) = f x (foldList z f xs)

instance Foldable List where
  foldr = flip foldList


data Tree a = Leaf | Branch (Tree a) a (Tree a) deriving Show


foldTree :: b -> (b -> a -> b -> b) -> (Tree a -> b)
foldTree z _ Leaf = z
foldTree z f (Branch l x r) = f (foldTree z f l) x (foldTree z f r)

-}


newtype Mu f = Fold (f (Mu f))

fold :: f (Mu f) -> Mu f
fold = Fold

unfold :: Mu f -> f (Mu f)
unfold (Fold a) = a


data ExprF x = Const Int
             | Parens x
             | Add x x
             | Mul x x

instance Functor ExprF where
  fmap _ (Const i)   = Const i
  fmap f (Parens x)  = Parens (f x)
  fmap f (Add x1 x2) = Add (f x1) (f x2)
  fmap f (Mul x1 x2) = Mul (f x1) (f x2)


type Expr = Mu ExprF

val12 :: Expr
val12 = Fold $ Const 12

testExpr :: Expr
testExpr = Fold $ Mul
             (Fold $ Add
               (Fold $ Const 1)
               (Fold $ Const 2))
             (Fold $ Const 3)


{-
ev :: ExprF Int -> Int
-}
ev :: Algebra ExprF Int
ev (Const i)   = i
ev (Parens x)  = x
ev (Add x1 x2) = x1 + x2
ev (Mul x1 x2) = x1 * x2

{-
ht :: ExprF Integer -> Integer
-}
ht :: Algebra ExprF Integer
ht (Const _)   = 1
ht (Parens x)  = 1 + x
ht (Add x1 x2) = 1 + max x1 x2
ht (Mul x1 x2) = 1 + max x1 x2


type Algebra f b = f b -> b
type Coalgebra f b = b -> f b


cata :: Functor f => Algebra f a -> (Mu f -> a)
cata alg = alg . fmap (cata alg) . unfold


ana :: Functor f => Coalgebra f a -> (a -> Mu f)
ana coalg = fold . fmap (ana coalg) . coalg



data ListF a x = Nil | Cons a x
  deriving Functor

type List a = Mu (ListF a)

len :: Algebra (ListF a) Integer
len Nil = 0
len (Cons _ b) = 1 + b

toList :: List a -> [a]
toList = cata alg
  where
    alg Nil = []
    alg (Cons x xs) = x : xs


myzip :: ([a], [b]) -> List (a, b)
myzip = ana alg
  where
    alg :: ([a], [b]) -> ListF (a, b) ([a], [b])
    alg ([], _) = Nil
    alg (_, []) = Nil
    alg (x:xs,y:ys) = Cons (x, y) (xs, ys)