That's very interesting. <br>One problem is, if the set of event is closed, the set of possible data types is not (the user can choose any data type for a Message callback for example). I think this can be solved using a class instead of a GADT for "Type". One can also use a type witness?<br>
<br><div class="gmail_quote">On Tue, Sep 11, 2012 at 8:09 PM, Sean Leather <span dir="ltr"><<a href="mailto:leather@cs.uu.nl" target="_blank">leather@cs.uu.nl</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
On Tue, Sep 11, 2012 at 6:46 PM, David Menendez wrote:<div class="im"><br><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left-width:1px;border-left-color:rgb(204,204,204);border-left-style:solid;padding-left:1ex">
<div>
<div>Mixing GADTs and Typeable seems like a bad idea. If you really don't</div></div>want to put viewEvent in the Event typeclass, but the class of events<br>is closed, you could use a GADT to witness the event type.</blockquote>
<br></div><div class="gmail_quote"><div class="im">On Tue, Sep 11, 2012 at 7:03 PM, Corentin Dupont wrote:<br><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left-width:1px;border-left-color:rgb(204,204,204);border-left-style:solid;padding-left:1ex">
<span style="color:rgb(34,34,34);font-size:13px;font-family:arial,sans-serif">unfortunately it seems that I will be obliged to maintain 2 parallel structures:<br></span><span style="color:rgb(34,34,34);font-size:13px;font-family:arial,sans-serif">for each Event instance, I will have to add a ViewEvent element as well carrying the same information:</span> </blockquote>
</div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">That's why I like the all-GADT solution...</blockquote><div><br></div><div>Inspired by David's suggestion, here's another version without Typeable. In Corentin's version, the switching back and forth between explicit and forgetful typing bothered me. This version never forgets types. Also, viewEvent is really an instance of Show, as I would expect. I don't see the extra maintenance burden mentioned by Corentin.</div>
<div> </div></div><div><div><font face="courier new, monospace">{-# LANGUAGE TypeFamilies, GADTs #-}</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">data Player = Arrive | Leave deriving Show</font></div>
<div><font face="courier new, monospace">newtype Message t = Message String deriving (Eq, Show)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">
data Type :: * -> * where</font></div><div><font face="courier new, monospace"> Int :: Type (Message Int)</font></div><div><font face="courier new, monospace"> String :: Type (Message String)</font></div><div><font face="courier new, monospace"> Player :: Type Player</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">data TEq :: * -> * -> * where</font></div><div><font face="courier new, monospace"> Refl :: TEq a a</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">teq :: Type a -> Type b -> Maybe (TEq a b)</font></div><div><font face="courier new, monospace">teq Int Int = Just Refl</font></div>
<div><font face="courier new, monospace">teq String String = Just Refl</font></div><div><font face="courier new, monospace">teq Player Player = Just Refl</font></div><div><font face="courier new, monospace">teq _ _ = Nothing</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">type family Data t :: *</font></div><div><font face="courier new, monospace">type instance Data (Message t) = t</font></div>
<div><font face="courier new, monospace">type instance Data Player = Int</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">data Event t = Event (Type t) t</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 :: Event t -> (Data t -> IO ()) -> Handler</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">runHandler :: Eq t => Event t -> Data t -> Handler -> IO ()</font></div>
<div><font face="courier new, monospace">runHandler (Event t e) d (Handler (Event u e') f) =</font></div>
<div><font face="courier new, monospace"> case teq t u of</font></div><div><font face="courier new, monospace"> Just Refl | e == e' -> f d</font></div><div><font face="courier new, monospace"> _ -> return ()</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">runHandlers :: Eq t => Event t -> Data t -> [Handler] -> IO ()</font></div>
<div><font face="courier new, monospace">runHandlers e d hs = mapM_ (runHandler e d) hs</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">-- Replacement for viewEvent</font></div>
<div><font face="courier new, monospace">instance Show (Event t) where</font></div><div><font face="courier new, monospace"> show (Event ty e) =</font></div><div><font face="courier new, monospace"> case ty of</font></div>
<div><font face="courier new, monospace"> Int -> show e ++ " of type Int"</font></div>
<div><font face="courier new, monospace"> String -> show e ++ " of type String"</font></div><div><font face="courier new, monospace"> Player -> "Player " ++ show e</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">messageEvent :: Type (Message t) -> String -> Event (Message t)</font></div>
<div><font face="courier new, monospace">messageEvent t s = Event t (Message s)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">playerEvent :: Player -> Event Player</font></div>
<div><font face="courier new, monospace">playerEvent = Event Player</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">-- Tests</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">event1 = messageEvent Int "give me a number" -- No type signature necessary!</font></div>
<div><font face="courier new, monospace">handler1 = Handler event1 (\n -> putStrLn $ "Your number is: " ++ show n)</font></div><div><font face="courier new, monospace">test1 = runHandlers event1 1 [handler1] -- Yields "Your number is: 1"</font></div>
<div><br></div></div><div>Regards,</div>
<div>Sean</div>
</blockquote></div><br>