<div class="gmail_quote">On Tue, Sep 11, 2012 at 9:18 PM, Corentin Dupont wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div id=":xvu">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?</div>
</blockquote><div><br></div><div>Just a "bit" more complicated...</div><div><br></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">import Data.Typeable</font></div><div><font face="courier new, monospace">import Unsafe.Coerce</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"> MessageT :: Typeable t => Proxy t -> Type (Message t)</font></div><div><font face="courier new, monospace"> PlayerT :: Type Player</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">data Proxy t</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">typeOfProxy :: Typeable t => Proxy t -> TypeRep</font></div>
<div><font face="courier new, monospace">typeOfProxy x = typeOf (unproxy x)</font></div><div><font face="courier new, monospace"> where</font></div><div><font face="courier new, monospace"> unproxy :: Proxy t -> t</font></div>
<div><font face="courier new, monospace"> unproxy = undefined</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 (MessageT p) (MessageT q)</font></div><div><font face="courier new, monospace"> | typeOfProxy p == typeOfProxy q = Just (unsafeCoerce Refl)</font></div><div><font face="courier new, monospace">teq PlayerT PlayerT = 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"> MessageT t -> show e ++ " of type " ++ show (typeOfProxy t)</font></div><div><font face="courier new, monospace"> PlayerT -> "Player " ++ show e</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">messageEvent :: Typeable t => Proxy t -> String -> Event (Message t)</font></div><div><font face="courier new, monospace">messageEvent t s = Event (MessageT 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 PlayerT</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">int :: Proxy Int</font></div>
<div><font face="courier new, monospace">int = undefined</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>The Proxy type is not absolutely necessary, because you can use the type directly. But I think the Proxy makes it clear that no (non-bottom) terms of the type are expected.</div><div><br></div><div>Regards,</div>
<div>Sean</div></div>