Hi,
it works very well!
I tried to implement it. Here is my test code. Apparently I need some casts to search the list.
The syntax looks good. Only addEvent will be on the interface, so that should be fine. If I understand well, that's this function that enforces the right types to be used. The events are referenced via the type of data they use.
It just bothers me a little that I'm not able to enumerate the events, and also that the user is able to create events with wrong types (like New :: Event String), even if they won't be able to register them.

I also have several unrelated events that use the same type of data, so this would be a problem. Adding more events like
data Event d = NewPlayer | NewRule deriving (Typeable, Eq)
is not correct because I can add wrong events like:
addEvent (NewPlayer :: Event Rule) (H(undefined::(Rule -> IO()))) []

Also one question: I don't understand the "where" clause in your class. If I remove it, it works the same...

Here is my code:

newtype Player = P Int deriving Typeable
newtype Rule = R Int deriving Typeable
data Event d = New deriving (Typeable, Eq)

class (Typeable d) => Handled d where
data Handler d = H (d -> IO ())

data EventHandler = forall d . (Handled d) => EH (Event d) (Handler d)

instance Handled Player
instance Handled Rule

addEvent :: (Handled d) => Event d -> Handler d -> [EventHandler] -> [EventHandler]
addEvent e h ehs = (EH e h):ehs

triggerEvent :: (Handled d) => Event d -> d -> [EventHandler] -> IO ()
triggerEvent e d ehs = do
    let r = find (\(EH myEvent _) -> cast e == Just myEvent) ehs
    case r of
       Nothing -> return ()
       Just (EH _ (H h)) -> case cast h of
        Just castedH -> castedH d
        Nothing -> return ()

h1 :: Player -> IO ()
h1 (P a) = putStrLn $ "Welcome Player " ++ (show a) ++ "!"
h2 :: Rule -> IO ()
h2 (R a) = putStrLn $ "New Rule " ++ (show a)
eventList1 = addEvent (New :: Event Player) (H h1) []
eventList2 = addEvent (New :: Event Rule) (H h2) eventList1

trigger1 = triggerEvent (New :: Event Player) (P 1) eventList2 -- yelds "Welcome Player 1!"
trigger2 = triggerEvent (New :: Event Rule) (R 2) eventList2 --yelds "New Rule 2"

Best,
Corentin

On Fri, Jun 15, 2012 at 12:40 AM, Alexander Solla <alex.solla@gmail.com> wrote:

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 ()