On Thu, Jun 14, 2012 at 2:04 PM, Corentin Dupont <corentin.dupont@gmail.com> wrote:
That look really nice!
Unfortunately I need to have an heterogeneous list of all events with their handlers.
With this test code it won't compile:

test1 = addEvent (New :: Event Player) (H (undefined::(Player -> IO ()))) []
test2 = addEvent (New :: Event Rule) (H (undefined::(Rule -> IO ()))) test1


Right, okay.  Heterogenous lists are tricky, but I think we can get away with using ExistentialQuantification, since you seem to only want to dispatch over the heterogenous types.  The assumption I made is a big deal!  It means you can't extract the d value.  You can only apply properly typed functions (your handlers) on it.
 
{-# LANGUAGE ExistentialQuantification #-} 

type Player = Int

type Rule = Int

data Event d = New d


class Handled data where -- Together with EventHandler, corresponds to your "Data" type

data EventHandler = forall d . (Handled d) => EH (Event d) (d -> IO ()) -- EventHandler takes the place of your (Event d, Handler d) pairs without referring to d.

instance Handled Player
instance Handled Rule


addEvent :: (Handled d) => Event d -> Handler d -> [EventHandler] -> [EventHandler] -- Every [EventHandler] made using addEvent will be of "correct" types (i.e., preserve the typing invariants you want), but YOU must ensure that only [EventHandler]s made in this way are used.  This can be done statically with another type and an explicit export list.  We can talk about that later, if this works in principle.
 
 
triggerEvent :: (Handled d) => Event d -> d -> [EventHandler] -> IO ()