Полнофункциональные гетерогенные списки

list.hs

{-# LANGUAGE GADTs #-}

class Clickable a where
    click :: a -> String
class Renderable a where
    render :: a -> String

data Interface a where
    Clickable :: Clickable a => Interface a
    Renderable :: Renderable a => Interface a

class Object a where
    interfaces :: a -> [Interface a]
data Obj where
    Obj :: Object a => a -> Obj

data Circle = Circle { radius :: Double }
    deriving Show

instance Renderable Circle where render = show
instance Object Circle where interfaces _ = [Renderable]

data Rectangle = Rectangle { x, y, w, h :: Double }
    deriving Show

instance Clickable Rectangle where click r = "Click on " ++ show r
instance Renderable Rectangle where render = show
instance Object Rectangle where interfaces _ = [Clickable, Renderable]

test = do
    print [ render a | Obj a <- list, Renderable <- interfaces a ]
    print [ click a  | Obj a <- list, Clickable <- interfaces a ]
    print [ render a ++ click a
          | Obj a <- list, Clickable <- interfaces a, Renderable <- interfaces a ]
    where list =
              [ Obj $ Circle 10
              , Obj $ Rectangle 1 2 3 4 ]