Code to accompany my series on algebraic data types.

ADT.hs

{-# LANGUAGE FlexibleContexts, UndecidableInstances, RankNTypes, ConstraintKinds #-}

module ADT where

------------
-- Part 1 --
------------


-- The unit type '1', equivalent to '()'
data Unit = Unit deriving Show

-- The sum type 'a + b', equivalent to 'Either a b'
data Add a b = AddL a | AddR b deriving Show

-- The product type 'a * b', equivalent to '(a,b)'
data Mul a b = Mul a b deriving Show

-- The zero type 'Void'
data Void

-- The expontial type 'b ^ a', 
data Exp b a = Exp (a -> b)




------------
-- Part 2 --
------------


-- The option type

type Option a = Add Unit a





-- The recursive type 'mu', equivalent to 'Fix'
data Mu f = Mu (f (Mu f))




-- The intermediate step in constructing the recursive list type. We need this
-- type to have something to recurse on. Note that the type
--
--     Lst a b
--
-- is exactly equivalent to
--
--     Add () (a, b)
--
-- but the type checker requires the newtype wrapper so that it knows when to
-- terminate.
newtype Lst a b = Lst (Add () (a,b)) deriving Show

-- Type synonym for lists.
type List a = Mu (Lst a)


-- List constructors 'nil' and 'const'
nil :: List a
nil = Mu (Lst (AddL ()))

cons :: a -> List a -> List a
cons a as = Mu (Lst (AddR (a, as)))


-- List accessors 'hd' and 'tl'
hd :: List a -> a
hd (Mu (Lst (AddR (a, _)))) = a

tl :: List a -> List a
tl (Mu (Lst (AddR (_, t)))) = t





-- The intermediate step in constructing the recursive tree type. Note that
--
--    Tree_ a b
--
-- is equivalent to
--
--    Add () (a, (b, b))
--
newtype Tree_ a b = Tree_ (Add () (a, (b,b))) deriving Show

-- Type synonym for trees.
type Tree a = Mu (Tree_ a)


-- Tree constructors 'empty' and 'node'
empty :: Tree a
empty = Mu (Tree_ (AddL ()))

node :: a -> Tree a -> Tree a -> Tree a
node a l r = Mu (Tree_ (AddR (a,(l,r))))


-- Tree accessors 't_data', 't_left' and 't_right'
t_data :: Tree a -> a
t_data (Mu (Tree_ (AddR (a,_)))) = a

t_left :: Tree a -> Tree a
t_left (Mu (Tree_ (AddR (_,(l,_))))) = l

t_right :: Tree a -> Tree a
t_right (Mu (Tree_ (AddR (_,(_,r))))) = r







-- Stuff that's needed to keep everything flowing nicely --


-- I don't quite understand why the Show instance for Mu can't be derived
-- automatically - maybe someone smarter can explain it to me?
instance Show (f (Mu f)) => Show (Mu f) where
    show (Mu f) = "Mu (" ++ show f ++ ")"