Computes Fibonacci number with a histomorphism -- correction: Actually it's a dynamorphism as it uses an anamorphism to generate intermediary step

Dyna.hs

data Cofree f a = a :< (f (Cofree f a))

-- Fix point
newtype Mu f = Mu { unMu :: f (Mu f) }

extract :: Cofree f a -> a
extract (a :< _) = a

-- catamorphism
cata :: Functor f => (f b -> b) -> Mu f -> b
cata f = f . fmap (cata f) . unMu

-- anamporhism (catamorphism dual)
ana :: Functor f => (a -> f a) -> a -> Mu f
ana f a = Mu $ fmap (ana f) (f a)

-- hylomorphism (anamorphism and catamorphism composition)
hylo :: Functor f => (a -> f a) -> (f b -> b) -> a -> b
hylo f g = cata g . ana f

-- dynamorphism
dyna :: Functor f => (a -> f a) -> (f (Cofree f b) -> b) -> a -> b
dyna fa fc = extract . hylo fa (\fb -> fc fb :< fb)

-- Natural numbers
data Nat a = Zero | Succ a

instance Functor Nat where
    fmap f (Succ a) = Succ $ f a
    fmap _ Zero     = Zero

nat :: b -> (a -> b) -> Nat a -> b
nat b _ Zero     = b
nat _ f (Succ a) = f a

getN_1 :: Cofree Nat a -> a
getN_1 = extract

getN_2 :: a -> Cofree Nat a -> a
getN_2 a (_ :< as) = nat a getN_1 as

fib :: Integer -> Integer
fib = dyna gen crush where
  gen 0 = Zero
  gen n = Succ (n - 1)

  crush Zero = 0
  crush (Succ ns) =
      let n_1 = getN_1 ns
          n_2 = getN_2 1 ns in
      n_1 + n_2