Datatypes a la Carte pt. I

DatatypesálaCarte.hs

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RankNTypes    #-}

module AlaCarte (
  -- newtypes
  Expr,
  -- types
  IntExpr,
  AddExpr,
  Algebra,
  Coalgebra,
  -- data
  Val,
  Add,
  (:+:),
  -- functions
  addExample,
  cata,
  ana,
  hylo,
  prepro,
  postpro,
  meta
  ) where

newtype Expr f = In { unIn :: f (Expr f) }

data Val e = Val Int
type IntExpr = Expr Val
instance Functor Val where
  fmap f (Val x) = Val x

data Add e = Add e e
type AddExpr = Expr Add
instance Functor Add where
  fmap f (Add a b) = Add (f a) (f b)

data (f :+: g) e = Inl (f e) | Inr (g e)

instance (Functor f, Functor g) => Functor (f :+: g) where
  fmap f (Inl e) = Inl (fmap f e)
  fmap f (Inr e) = Inr (fmap f e)

addExample :: Expr (Val :+: Add)
addExample = In (Inr (Add (In (Inl (Val 118))) (In (Inl (Val 1219)))))

-- Here is what we can do so far with Expr. Not so bad!

type f ~> g = forall a. f a -> g a 
type Algebra f = forall a. f a -> a
type Coalgebra f = forall a. a -> f a

cata :: Functor f => Algebra f -> Expr f -> a
cata φ = φ . fmap (cata φ) . unIn

ana :: Functor f => Coalgebra f -> a -> Expr f
ana ψ = In . fmap (ana ψ) . ψ

hylo :: Functor f => Algebra f -> Coalgebra f -> a -> b
hylo φ ψ = cata φ . ana ψ

prepro :: (Functor f, Functor g) => (f ~> g) -> Algebra g -> Expr f -> b
prepro η φ = cata (φ . η)

postpro :: (Functor f, Functor g) => (f ~> g) -> Coalgebra f -> a -> Expr g
postpro μ ψ = ana (μ . ψ)

meta :: Functor f => Algebra f -> Coalgebra f -> Expr f
meta φ ψ = ana ψ $ cata φ

-- Pt II. Abstracting over pattern functors