Chapter "Generic Programming" from Bob Harper, in Haskell

GenericChapter.hs

module GenericChapter where


-- | We define our own "Polynomial functor" type class.
-- Declaring an instance for this type class means to state a rule in
-- the 14.1 rule system for "poly" (static semantics). The respective
-- implementation of @pfmap@ realises the dynamic semantics (evaluation).
class PolyFunc p where
    pfmap :: (a -> b) -> p a -> p b

------------------------------------------------------------
-- | Identity on types, not totally straightforward though. BTW the
-- functor instance for @Data.Functor.Identity@ uses @fmap = coerce@
newtype Id a = Id a
    deriving (Eq, Show)

instance PolyFunc Id -- 14.1a: "Id is a poly"
    where pfmap f (Id x) = let exe' = f x -- 14.3a
                           in  Id exe' -- @Id a@ is a newtype, so this
                                       -- is actually just @exe'@

------------------------------------------------------------
-- | unit, or to be precise, the constant type function unit. Same
-- remark holds here about not being completely straightforward
newtype Unit a = Unit ()
    deriving (Eq, Show)

instance PolyFunc Unit -- 14.1b
    where pfmap f (Unit e) = Unit e -- actually represented as e

------------------------------------------------------------
-- | Product, with helpers
-- The confusing part is that we need functors in the components
data Times x y t = Times (x t) (y t) -- angle brackets
    deriving (Eq, Show)
left  :: Times x y t -> x t -- "l" suffix
left  (Times l _) = l
right :: Times x y t -> y t -- "r" suffix
right  (Times _ r) = r

-- Now, how do we construct a "normal" pair (a,b) from this? The
-- answer is, we cannot, unless a or b is a type constant, or else
-- a==b==t; because we only handle type functions of one argument, t.

instance (PolyFunc tau1, PolyFunc tau2) -- 14.1c, 2 premises
    => PolyFunc (Times tau1 tau2)
    where pfmap f (Times el er) -- 14.3c
              = Times (pfmap f el) (pfmap f er)

------------------------------------------------------------
-- | Void type function, with no constructors for the result
data Void a

-- must be derived "stand-alone". Throws exceptions in ghci
instance Eq (Void a) where (==) = const (const False)
instance Show (Void a) where show x = x `seq` "Wot?" 

instance PolyFunc Void -- 14.1d
    where pfmap _ = error "How did we get here?"

------------------------------------------------------------
-- | Sum type with two constructors (l and r prefix)
data Sum a b t = L (a t) | R (b t)
    deriving (Eq, Show)

instance (PolyFunc tau1, PolyFunc tau2)  -- 14.1e, premises
    => PolyFunc (Sum tau1 tau2)
    where pfmap f e
              = case e of                -- 14.3e. Confusing part is
                  L x1 -> L (pfmap f x1) -- that the target type is
                  R x2 -> R (pfmap f x2) -- again the same sum type

@jberthold You may hit the error for non-terminating arguments of type Void t. I think the following is closer to the PFPL version:

    where pfmap v = case v of { }

I'd probably implement Eq and Show similarly.