content: {-# LANGUAGE DeriveFunctor #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE StandaloneDeriving #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE UndecidableInstances #-}
  
  type Algebra f a = f a -> a
  
  type Coalgebra f a = a -> f a
  
  newtype Fix f = Fix {unFix :: f (Fix f)}
  
  -- catamorphism
  cata :: Functor f => Algebra f a -> Fix f -> a
  cata alg = alg . fmap (cata alg) . unFix
  
  -- anamorphism
  ana :: Functor f => Coalgebra f a -> a -> Fix f
  ana coalg = Fix . fmap (ana coalg) . coalg
  
  -- hylomorphism
  hylo :: Functor f => Algebra f b -> Coalgebra f a -> a -> b
  hylo f g = cata f . ana g
  
  type Nat = Fix NatF
  
  data NatF a = S a | Z deriving (Eq, Show)
  
  instance Functor NatF where
    fmap f Z = Z
    fmap f (S x) = S (f x)
  
  plus :: Nat -> Nat -> Nat
  plus n = cata phi
    where
      phi Z = n
      phi (S m) = s m
  
  times :: Nat -> Nat -> Nat
  times n = cata phi
    where
      phi Z = z
      phi (S m) = plus n m
  
  int :: Nat -> Int
  int = cata phi
    where
      phi Z = 0
      phi (S f) = 1 + f
  
  nat :: Integer -> Nat
  nat = ana (psi Z S)
    where
      psi f _ 0 = f
      psi _ f n = f (n -1)
  
  z :: Nat
  z = Fix Z
  
  s :: Nat -> Nat
  s = Fix . S
  
  type Str = Fix StrF
  
  data StrF x = Cons Char x | Nil
  
  instance Functor StrF where
    fmap f (Cons a as) = Cons a (f as)
    fmap f Nil = Nil
  
  nil :: Str
  nil = Fix Nil
  
  cons :: Char -> Str -> Str
  cons x xs = Fix (Cons x xs)
  
  str :: Str -> String
  str = cata phi
    where
      phi Nil = []
      phi (Cons x xs) = x : xs
  
  str' :: String -> Str
  str' = ana (psi Nil Cons)
    where
      psi f _ [] = f
      psi _ f (a : as) = f a as
  
  map' :: (Char -> Char) -> Str -> Str
  map' f = hylo g unFix
    where
      g Nil = Fix Nil
      g (Cons a x) = Fix $ Cons (f a) x
  
  type Tree a = Fix (TreeF a)
  
  data TreeF a f = Leaf a | Tree a f f deriving (Show)
  
  instance Functor (TreeF a) where
    fmap f (Leaf a) = Leaf a
    fmap f (Tree a b c) = Tree a (f b) (f c)
  
  depth :: Tree a -> Int
  depth = cata phi
    where
      phi (Leaf _) = 0
      phi (Tree _ l r) = 1 + max l r
  
  example1 :: Int
  example1 = int (plus (nat 125) (nat 25))
  -- 150
  