Just wondering, could type families be of any help here?<br>I don&#39;t know type families, but can it be a mean to regroup together the event types, that are now completely separated :<br><i>data NewPlayer deriving Typeable<br>

data NewRule deriving Typeable</i><br><br><br><div class="gmail_quote">On Fri, Jun 15, 2012 at 10:59 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">I made some modifications based on your suggestions (see below).<br>I made a two parameters class:<br>
<i>class (Typeable e, Typeable d) =&gt; Handled e d </i><br>Because after all what I want is to associate an event with its type parameters.<br>I don&#39;t know why I cannot implement you suggestion to restrict the instances of Event:<br>

<i>data </i><i>(Handled e d) =&gt; </i><i>Event e = Event deriving (Typeable, Eq) <br></i>gives me a <br><i>Not in scope: type variable `d&#39;</i><br><br>But apart from that it works very well! It&#39;s quite a nice interface!<br>

Also just to know, is there a way of getting ride of all these &quot;Typeable&quot;?<br><br>{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable, MultiParamTypeClasses #-}<br><br><i>module Events (addEvent, newPlayer, newRule) where<br>

<br>import Control.Monad<br>import Data.List<br>import Data.Typeable<div class="im"><br><br>newtype Player = P Int deriving Typeable <br>newtype Rule = R Int deriving Typeable<br></div>data Event e = Event deriving (Typeable, Eq)<br>
<br>data NewPlayer deriving Typeable<br>
data NewRule deriving Typeable<br><br>newPlayer :: Event NewPlayer<br>newPlayer = Event<br>newRule :: Event NewRule<br>newRule = Event<br><br>class (Typeable e, Typeable d) =&gt; Handled e d <br>instance Handled NewPlayer Player<br>

instance Handled NewRule Rule<br><br>data EventHandler = forall e d . (Handled e d) =&gt; EH (Event e) (d -&gt; IO ()) <br><br>addEvent :: (Handled e d) =&gt; Event e -&gt; (d -&gt; IO ()) -&gt; [EventHandler] -&gt; [EventHandler] <br>
<div class="im">
addEvent e h ehs = (EH e h):ehs<br> <br></div>triggerEvent :: (Handled e d) =&gt; Event e -&gt; d -&gt; [EventHandler] -&gt; IO ()<div class="im"><br>triggerEvent e d ehs = do<br>    let r = find (\(EH myEvent _) -&gt; cast e == Just myEvent) ehs<br>

    case r of<br>       Nothing -&gt; return ()<br></div>       Just (EH _ h) -&gt; case cast h of<div class="im"><br>        Just castedH -&gt; castedH d<br>        Nothing -&gt; return ()<br><br></div>-- TESTS<div class="im">
<br>h1 :: Player -&gt; IO ()<br>h1 (P a) = putStrLn $ &quot;Welcome Player &quot; ++ (show a) ++ &quot;!&quot;<br>
h2 :: Rule -&gt; IO ()<br>h2 (R a) = putStrLn $ &quot;New Rule &quot; ++ (show a)<br></div>eventList1 = addEvent newPlayer h1 []<br>eventList2 = addEvent newRule h2 eventList1<br><br>trigger1 = triggerEvent newPlayer (P 1) eventList2 --Yelds &quot;Welcome Player 1!&quot; <br>

trigger2 = triggerEvent newRule (R 2) eventList2 --Yelds &quot;New Rule 2&quot; </i><br><br><br><br><div class="gmail_quote"><div class="im">On Fri, Jun 15, 2012 at 4:53 PM, Alexander Solla <span dir="ltr">&lt;<a href="mailto:alex.solla@gmail.com" target="_blank">alex.solla@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"><br><br><div class="gmail_quote"><div>On Fri, Jun 15, 2012 at 6:38 AM, 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">
<br>
It just bothers me a little that I&#39;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&#39;t be able to register them.<br>


</blockquote><div><br></div></div><div>This can be solved with an explicit export list/smart constructors.</div><div><br></div><div>newPlayer :: Event Player</div><div>newRule    :: Event Rule</div><div>(hide the New constructor)</div>


<div><br></div><div>In any case, my thinking was that your original</div><div><br></div><div>data Event = <i>NewPlayer | NewRule</i></div><div><i><br></i></div><div>was basically trying to &quot;join&quot; the semantics of &quot;new things&quot; with Player and Rule.  But the original approach ran into the problem you mention below -- it is difficult to maintain invariants, since the types want to &quot;multiply&quot;.  So formally, I factored:</div>


<div><br></div><div>data Event = NewPlayer | NewRule ==&gt;</div><div>data Event = New (Player | Rule)    ==&gt;</div><div>data Event d = New -- (since the original event didn&#39;t want a Player or Rule value.  It witnessed the type relation)</div>


<div><br></div><div>On the other hand, if you want to make sure that a type must be &quot;Handled&quot; before you can issue an Event, you can do:</div><div><br></div><div>data (Handled d) =&gt; Evend d = New</div><div><br>


</div><div>I&#39;m pretty sure the compiler will complain if you try to make a (New :: Event String).  I like this idea better than smart constructors for events, if only because you get to use ScopedTypeVariables.</div>

<div><div>
 </div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
I also have several unrelated events that use the same type of data, so this would be a problem. </blockquote><div><br></div></div><div>Can you clarify?</div></div></blockquote></div><div><br>I mean that I have events like:<br>

Message String<br>UserEvent String<br>That have a &quot;data&quot; of the same type, but they are not related.<br><br> </div><div><div class="h5"><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">

<div class="gmail_quote"><div><div> </div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
Adding more events like<br><i>data Event d = NewPlayer | NewRule deriving (Typeable, Eq)</i><br>is not correct because I can add wrong events like:<br>
addEvent (NewPlayer :: Event Rule) (H(undefined::(Rule -&gt; IO()))) []<br><i></i><br>Also one question: I don&#39;t understand the &quot;where&quot; clause in your class. If I remove it, it works the same...<br></blockquote>


<div><br></div></div><div>Yes, unnecessary where clauses are optional. </div><div><div><div><br></div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Here is my code:<br>


<br><i>newtype Player = P Int deriving Typeable <br>newtype Rule = R Int deriving Typeable<br>data Event d = New deriving (Typeable, Eq) <br><br>class (Typeable d) =&gt; Handled d where <br><div>data Handler d = H (d -&gt; IO ())<br>



<br></div>data EventHandler = forall d . (Handled d) =&gt; EH (Event d) (Handler d)<div><br><br>instance Handled Player<br>instance Handled Rule<br><br>addEvent :: (Handled d) =&gt; Event d -&gt; Handler d -&gt; [EventHandler] -&gt; [EventHandler] <br>


</div>
addEvent e h ehs = (EH e h):ehs<div><br> <br>triggerEvent :: (Handled d) =&gt; Event d -&gt; d -&gt; [EventHandler] -&gt; IO ()<br></div>triggerEvent e d ehs = do<br>    let r = find (\(EH myEvent _) -&gt; cast e == Just myEvent) ehs<div>


<br>
    case r of<br>       Nothing -&gt; return ()<br></div>       Just (EH _ (H h)) -&gt; case cast h of<br>        Just castedH -&gt; castedH d<br>        Nothing -&gt; return ()<br><br>h1 :: Player -&gt; IO ()<br>h1 (P a) = putStrLn $ &quot;Welcome Player &quot; ++ (show a) ++ &quot;!&quot;<br>



h2 :: Rule -&gt; IO ()<br>h2 (R a) = putStrLn $ &quot;New Rule &quot; ++ (show a)<br>eventList1 = addEvent (New :: Event Player) (H h1) []<br>eventList2 = addEvent (New :: Event Rule) (H h2) eventList1<br><br>trigger1 = triggerEvent (New :: Event Player) (P 1) eventList2 -- yelds &quot;Welcome Player 1!&quot;<br>



trigger2 = triggerEvent (New :: Event Rule) (R 2) eventList2 --yelds &quot;New Rule</i> 2&quot;<br><br>Best,<br>Corentin<div><div><br><br><div class="gmail_quote">On Fri, Jun 15, 2012 at 12:40 AM, Alexander Solla <span dir="ltr">&lt;<a href="mailto:alex.solla@gmail.com" target="_blank">alex.solla@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"><br><br><div class="gmail_quote"><div>On Thu, Jun 14, 2012 at 2:04 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">
That look really nice!<br>Unfortunately I need to have an heterogeneous list of all events with their handlers.<br>With this test code it won&#39;t compile:<br><br>test1 = addEvent (New :: Event Player) (H (undefined::(Player -&gt; IO ()))) []<br>





test2 = addEvent (New :: Event Rule) (H (undefined::(Rule -&gt; IO ()))) test1<div><div><br></div></div></blockquote><div><br></div></div><div>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&#39;t extract the d value.  You can only apply properly typed functions (your handlers) on it.</div>




<div> </div></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"></blockquote><i><div style="text-align:left;display:inline!important">{-# LANGUAGE ExistentialQuantification #-} </div></i><br><blockquote style="margin:0 0 0 40px;border:none;padding:0px">




</blockquote><i><div style="display:inline!important"><div style="text-align:left;display:inline!important"><i><div style="display:inline!important">type Player = Int</div></i></div></div></i><div><br><blockquote style="margin:0 0 0 40px;border:none;padding:0px">




</blockquote><i><div style="display:inline!important"><div style="text-align:left;display:inline!important"><i><div style="display:inline!important">type Rule = Int</div></i></div></div></i><br><blockquote style="margin:0 0 0 40px;border:none;padding:0px">




</blockquote><i><div style="text-align:left;display:inline!important"><i>data Event d = New d</i></div></i><br><i><br></i><blockquote style="margin:0 0 0 40px;border:none;padding:0px"></blockquote></div><i style="text-align:left">class Handled data where -- Together with EventHandler, corresponds to your &quot;Data&quot; type</i><br>




<i><br></i><blockquote style="margin:0 0 0 40px;border:none;padding:0px"></blockquote><i style="text-align:left">data EventHandler = forall d . (Handled d) =&gt; EH (Event d) (d -&gt; IO ()) -- EventHandler takes the place of your (Event d, Handler d) pairs without referring to d.</i><div>



<br>
<i><br></i><blockquote style="margin:0 0 0 40px;border:none;padding:0px"></blockquote><i style="text-align:left">instance Handled Player</i><br><blockquote style="margin:0 0 0 40px;border:none;padding:0px"></blockquote><i style="text-align:left">instance Handled Rule</i><br>




<div style="text-align:left"><br></div><div style="text-align:left"><br></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"></blockquote></div><i style="text-align:left">addEvent :: (Handled d) =&gt; Event d -&gt; Handler d -&gt; [EventHandler] -&gt; [EventHandler] -- Every [EventHandler] made using addEvent will be of &quot;correct&quot; 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.</i><br>




<blockquote style="margin:0 0 0 40px;border:none;padding:0px"></blockquote><span style="text-align:left"> </span><br><blockquote style="margin:0 0 0 40px;border:none;padding:0px"></blockquote><span style="text-align:left"> </span><br>




<div class="gmail_quote"><div><div><div class="gmail_quote"><div class="gmail_quote"><div style="text-align:left"><i>triggerEvent :: (Handled d) =&gt; Event d -&gt; d -&gt; [EventHandler] -&gt; IO ()</i></div>
</div></div></div></div></div><div class="gmail_quote"><div> </div></div><br>
</blockquote></div><br>
</div></div></blockquote></div></div></div><br>
</blockquote></div></div></div><br>
</blockquote></div><br>