I finally come up with this version, which allows to do pattern matching against the events.<br>I&#39;m sure it could be cleaned a bit, but it think the idea is there.<br>I would like to thank again everybody on this list, that&#39;s very friendly and helpful!<br>

Corentin<br><br><i>{-# LANGUAGE ExistentialQuantification, TypeFamilies, DeriveDataTypeable, GADTs, ScopedTypeVariables, StandaloneDeriving #-}<br><br>import Data.Typeable<br><br>data Player = Arrive | Leave deriving (Show, Typeable, Eq)<br>

data Message m = Message String deriving (Show, Typeable, Eq)<br><br>data Event a where<br>  PlayerEvent  :: Player -&gt; Event Player<br>  MessageEvent :: Message m -&gt; Event (Message m)<br><br>data Data a where<br>  PlayerData  :: Int -&gt; Data (Event Player)<br>

  MessageData :: m -&gt; Data (Event (Message m))<br><br>data Handler where<br>  Handler :: (Typeable e) =&gt; Event e -&gt; (Data (Event e) -&gt; IO ()) -&gt; Handler<br><br>deriving instance Eq (Event a)<br>deriving instance Typeable1 Data<br>

deriving instance Typeable1 Event<br><br>addEvent :: (Typeable e) =&gt; Event e -&gt; (Data (Event e) -&gt; IO ()) -&gt; [Handler] -&gt; [Handler]<br>addEvent e h hs = (Handler e h) : hs<br><br>triggerEvent :: (Eq e, Typeable e) =&gt; Event e -&gt; (Data (Event e)) -&gt; [Handler] -&gt; IO ()<br>

triggerEvent e d hs = do<br>    let filtered = filter (\(Handler e1 _) -&gt; e1 === e) hs<br>    mapM_ f filtered where<br>        f (Handler _ h) = case cast h of<br>            Just castedH -&gt; do<br>                castedH d<br>

            Nothing -&gt; return ()<br><br>viewEvent :: (Typeable e) =&gt; (Event e) -&gt; IO()<br>viewEvent (PlayerEvent p) = putStrLn $ &quot;Player &quot; ++ show p<br>viewEvent m@(MessageEvent s) = putStrLn $ &quot;Message &quot; ++ show s ++ &quot; of type &quot; ++  (show $ typeOf m)<br>

<br>-- | an equality that tests also the types.
<br>(===) :: (Typeable a, Typeable b, Eq b) =&gt; a -&gt; b -&gt; Bool
<br>(===) x y = cast x == Just y<br><br>--TEST<br>testPlayer = addEvent (PlayerEvent Arrive) (\(PlayerData d) -&gt; putStrLn $ show d) []<br>msg :: Message Int<br>msg = Message &quot;give me a number&quot;<br>myList = addEvent (MessageEvent msg) (\(MessageData n) -&gt; putStrLn $ &quot;Your number is: &quot; ++ show n) []<br>

trigger = triggerEvent (MessageEvent msg) (MessageData 1) myList --Yelds &quot;Your number is: 1&quot;</i><br><br><br><div class="gmail_quote">On Tue, Sep 11, 2012 at 5:06 PM, Corentin Dupont <span dir="ltr">&lt;<a href="mailto:corentin.dupont@gmail.com" target="_blank">corentin.dupont@gmail.com</a>&gt;</span> wrote:<br>

<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Yes.<br>That&#39;s fantastic! This GADT is the missing piece of my puzzle. I transformed a bit your solution, polluting it with some classes instances and fleshing the functions:<br>

<br><i>data Player = Arrive | Leave deriving (Show, Typeable, Eq)<br>
data Message m = Message String deriving (Show, Typeable, Eq)<div><br><br>data Data a where<br>  PlayerData  :: Int -&gt; Data Player<br>  MessageData :: m -&gt; Data (Message m)<br><br>data Handler where<br></div>
  Handler :: (Typeable e) =&gt; e -&gt; (Data e -&gt; IO ()) -&gt; Handler<br>
<br>instance forall e. (Typeable e) =&gt; Typeable (Data e) where<br>    typeOf _  = mkTyConApp (mkTyCon( (&quot;Expression.EventData (&quot; ++ (show $ typeOf (undefined::e))) ++ &quot;)&quot; )) []<br><br>addEvent :: (Typeable e) =&gt; e -&gt; (Data e -&gt; IO ()) -&gt; [Handler] -&gt; [Handler]<br>


addEvent e h hs = (Handler e h) : hs<br><br>triggerEvent :: (Eq e, Typeable e) =&gt; e -&gt; Data e -&gt; [Handler] -&gt; IO ()<br>triggerEvent e d hs = do<br>    let filtered = filter (\(Handler e1 _) -&gt; e1 === e) hs<br>


    mapM_ f filtered where<br>        f (Handler _ h) = case cast h of<br>            Just castedH -&gt; do<br>                castedH d<br>            Nothing -&gt; return ()<br><br>viewEvent :: (Typeable e) =&gt; e -&gt; IO()<div>

<br>
viewEvent event = do<br>    case cast event of<br></div>        Just (a :: Player) -&gt; putStrLn $ &quot;Player&quot; ++ show a<div><br>        Nothing -&gt; return ()<br>    case cast event of<br></div>        (Just (Message s)) -&gt; putStrLn $ &quot;Player&quot; ++ s<br>


        Nothing -&gt; return ()</i><br><br><br>Unfortunately, I still cannot pattern match on the events to view them (<i>viewEvent won&#39;t compile)</i>...<br><br>Best,<br>Corentin<div><div><br>
<br><br><div class="gmail_quote">On Tue, Sep 11, 2012 at 4:10 PM, Sean Leather <span dir="ltr">&lt;<a href="mailto:leather@cs.uu.nl" target="_blank">leather@cs.uu.nl</a>&gt;</span> wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div class="gmail_quote">On Tue, Sep 11, 2012 at 3:39 PM, Corentin Dupontwrote:<div><div><br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">


@Oleg: Yes the set of events is closed and I would be much happier with a GADT! But no matter how hard I tried I couldn&#39;t manage.<br>


Here is the full problem:<br><br><i>{-# LANGUAGE ExistentialQuantification, TypeFamilies, DeriveDataTypeable #-}<br><br>import Data.Typeable<br><br>-- | Define the events and their related data<br>class (Eq e, Typeable e, Show e) =&gt; Event e where<br>





    data EventData e<br><br>-- | Groups of events<br>data PlayerEvent = Arrive | Leave deriving (Typeable, Show, Eq)<br><br>-- | events types<br>data Player          = Player PlayerEvent deriving (Typeable, Show, Eq)<br>




data Message m  = Message String     deriving (Typeable, Show, Eq)<br>
<br>-- | event instances<br>instance Event Player                                      where data EventData Player             = PlayerData {playerData :: Int}<br>instance (Typeable m) =&gt; Event (Message m)   where data EventData (Message m)   = MessageData {messageData :: m}<br>





<br>-- | structure to store an event<br>data EventHandler = forall e . (Event e) =&gt;<br>     EH {eventNumber :: Int,<br>         event :: e,<br>         handler :: (EventData e) -&gt; IO ()} deriving Typeable<br><br>-- store a new event with its handler in the list<br>





addEvent :: (Event e) =&gt; e -&gt; (EventData e -&gt; IO ()) -&gt; [EventHandler] -&gt; [EventHandler]<br>addEvent event handler ehs = undefined<br><br>-- trigger all the corresponding events in the list, passing the </i><i><i>data to the </i>handlers<br>





triggerEvent :: (Event e) =&gt; e -&gt; (EventData e) -&gt; [EventHandler] -&gt; IO ()<br>triggerEvent event edata ehs = undefined<br><br>--Examples:<br>msg :: Message Int<br>msg = Message &quot;give me a number&quot;<br>





myList = addEvent msg (\(MessageData n) -&gt; putStrLn $ &quot;Your number is: &quot; ++ show n) []<br>trigger = triggerEvent msg (MessageData 1) </i><i><i>myList</i> --Yelds &quot;Your number is: 1&quot;</i><br><br>Has you can see this allows me to associate an arbitrary data type to each event with the type family &quot;EventData&quot;. Furthermore some events like &quot;Message&quot; let the user choose the data type using the type parameter. This way I have nice signatures for the functions &quot;addEvent&quot; and &quot;triggerEvent&quot;. The right types for the handlers and the data passed is enforced at compilation time. <br>





But I couldn&#39;t find any way to convert this into a GATD and get rid of the &quot;Event&quot; class......<br></blockquote><div><br></div></div></div><div>Would this work?</div><div><br></div><div><font face="courier new, monospace">data Player = Arrive | Leave</font></div>


<div>

<div><font face="courier new, monospace">data Message m = Message String</font></div><div><font face="courier new, monospace"><br></font></div></div><div><font face="courier new, monospace">data Data a where</font></div>


<div><font face="courier new, monospace">  PlayerData  :: Int -&gt; Data Player</font></div>

<div><font face="courier new, monospace">  MessageData :: m -&gt; Data (Message m)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">data Handler where</font></div>




<div><font face="courier new, monospace">  Handler :: Int -&gt; e -&gt; (Data e -&gt; IO ()) -&gt; Handler</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">addEvent :: e -&gt; (Data e -&gt; IO ()) -&gt; [Handler] -&gt; [Handler]</font></div>




<div><font face="courier new, monospace">addEvent = undefined</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">triggerEvent :: e -&gt; Data e -&gt; [Handler] -&gt; IO ()</font></div>




<div><font face="courier new, monospace">triggerEvent = undefined</font></div><div><br></div><div>Regards,</div><div>Sean</div></div>
</blockquote></div><br>
</div></div></blockquote></div><br>