Catamorphisms, Anamorphisms, and Hylomorphisms.

Hylo.hs

{-# LANGUAGE UndecidableInstances #-}

module Hylo where

-- An attempt to derive a hylomorphism from the type signature (at the time of
-- writing I don't recall ever seeing the implementation of one).

type Algebra f a = f a -> a

type Coalgebra f a = a -> f a

newtype Fix f = Fix { unFix :: f (Fix f) }

-- I shamelessly copied this from `Data.Fix`.
instance Show (f (Fix f)) => Show (Fix f) where
    showsPrec n x = showParen (n > 10) $ \s ->
        "Fix " ++ showsPrec 11 (unFix x) s

-- I have seen catamorphisms before (and writen some Gists about it), so it
-- wasn't hard to derive.
cata :: Functor f => Algebra f a -> Fix f -> a
cata alg = alg . fmap (cata alg) . unFix

-- I don't recall seeing anamorphisms, but considering they are the opposite
-- of catamorphisms it was pretty easy to write something that typechecks.
ana :: Functor f => Coalgebra f a -> a -> Fix f
ana coalg = Fix . fmap (ana coalg) . coalg

-- Wow. This was pretty easy. Defining catamorphisms and anamorphisms made the
-- definition extremely obvious.
hylo :: Functor f => Algebra f b -> Coalgebra f a -> a -> b
hylo alg coalg = cata alg . ana coalg

-- Ok. So, let's have some functions with catamorphisms.

data NatF a
    = Z
    | S a
    deriving Show

instance Functor NatF where
    fmap f Z     = Z
    fmap f (S x) = S (f x)

type Nat = Fix NatF

z :: Nat
z = Fix Z

s :: Nat -> Nat
s = Fix . S

plus :: Nat -> Nat -> Nat
plus n = cata phi
    where
    phi Z     = n
    phi (S m) = s m

int :: Nat -> Int
int = cata phi
    where
    phi Z     = 0
    phi (S n) = succ n

-- And a single use of an anamorphism.
nat :: Int -> Nat
nat = ana psi
    where
    psi 0 = Z
    psi n = S (pred n)