Data types a là carte

ALaCarte.hs

----------------------------------------------------------------------
-- First, let's define the original `Expr`

data Fix f = Fix (f (Fix f))

fold :: Functor f => (f a -> a) -> Fix f -> a
fold alg (Fix x) = alg $ fmap (fold alg) x

-- Sum of two functors
data (f :+: g) x = Inl (f x) | Inr (g x) deriving (Functor)

data NumF x = NumF Int deriving (Functor)
data AddF x = AddF x x deriving (Functor)

-- `Expr` is essentially `Fix (NumF :+: AddF)`. Here, we *don't* want
-- to explicitly define it because that would make us commit to a
-- fixed `Expr`, which makes adding a case (without introducing a new
-- data type or modifying the original) impossible.

----------------------------------------------------------------------
-- Next, let's define the original `eval`. We do this in two steps:
-- 
-- 1. We define `evalOnce` for each constructor, which specifies how to
-- evaluate them given all their sub-terms have been evaluated.
--
-- 2. We define `eval` as uniformly applying `evalOnce` to an entire
-- term.

class Functor f => Eval f where
  evalOnce :: f Int -> Int

instance Eval NumF where
  evalOnce (NumF n) = n

instance Eval AddF where
  evalOnce (AddF n1 n2) = n1 + n2

-- we also define a `Eval` instance for sums
instance (Eval f, Eval g) => Eval (f :+: g) where
  evalOnce (Inl x) = evalOnce x
  evalOnce (Inr y) = evalOnce y

eval :: (Eval f) => Fix f -> Int
eval = fold evalOnce

----------------------------------------------------------------------
-- OK. At this point, we consider the question of adding a `Mul Int
-- Int` case to our `Expr` and extending the `eval` function to
-- accommdate that.

-- With data type a la carte, it's as simple as:

data MulF x = MulF x x deriving (Functor)

instance Eval MulF where
  evalOnce (MulF n1 n2) = n1 * n2

----------------------------------------------------------------------
-- Let's test it

-- 2 * (118 + 1219) is encoded as
example :: Fix (NumF :+: AddF :+: MulF)
example = Fix (Inr (MulF (Fix (Inl (Inl (NumF 2)))) (Fix (Inl (Inr (AddF (Fix (Inl (Inl (NumF 118)))) (Fix (Inl (Inl (NumF 1219))))))))))

-- Running `eval example` will correctly give back 2647. Note that
-- it's quite unpleasant to write terms in this way; the data types a
-- la carte paper shows a way to simplify this using smart
-- constructors