Thanks Martijn, Oleg and Ryan for your kind replies! @Ryan and Martijn: I considered putting the viewEvent in the typeclass, but I figured out that would break the separation of concerns. Indeed this typeclass "Event" belongs to the inner engine, while the display is done in another component (not even the same library) using a specific technology (for instance HTML). So it doesn't feel right to mix the logic of the event engine with the display... @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't manage. Here is the full problem: *{-# LANGUAGE ExistentialQuantification, TypeFamilies, DeriveDataTypeable #-} import Data.Typeable -- | Define the events and their related data class (Eq e, Typeable e, Show e) => Event e where data EventData e -- | Groups of events data PlayerEvent = Arrive | Leave deriving (Typeable, Show, Eq) -- | events types data Player = Player PlayerEvent deriving (Typeable, Show, Eq) data Message m = Message String deriving (Typeable, Show, Eq) -- | event instances instance Event Player where data EventData Player = PlayerData {playerData :: Int} instance (Typeable m) => Event (Message m) where data EventData (Message m) = MessageData {messageData :: m} -- | structure to store an event data EventHandler = forall e . (Event e) => EH {eventNumber :: Int, event :: e, handler :: (EventData e) -> IO ()} deriving Typeable -- store a new event with its handler in the list addEvent :: (Event e) => e -> (EventData e -> IO ()) -> [EventHandler] -> [EventHandler] addEvent event handler ehs = undefined -- trigger all the corresponding events in the list, passing the **data to the handlers triggerEvent :: (Event e) => e -> (EventData e) -> [EventHandler] -> IO () triggerEvent event edata ehs = undefined --Examples: msg :: Message Int msg = Message "give me a number" myList = addEvent msg (\(MessageData n) -> putStrLn $ "Your number is: " ++ show n) [] trigger = triggerEvent msg (MessageData 1) **myList --Yelds "Your number is: 1"* Has you can see this allows me to associate an arbitrary data type to each event with the type family "EventData". Furthermore some events like "Message" let the user choose the data type using the type parameter. This way I have nice signatures for the functions "addEvent" and "triggerEvent". The right types for the handlers and the data passed is enforced at compilation time. But I couldn't find any way to convert this into a GATD and get rid of the "Event" class...... Thanks, Corentin On Tue, Sep 11, 2012 at 1:51 PM, Martijn Schrage wrote:

On 11-09-12 08:53, oleg@okmij.org wrote:

Corentin Dupon wrote about essentially the read-show problem:

class (Typeable e) => Event e

data Player = Player Int deriving (Typeable) data Message m = Message String deriving (Typeable)

instance Event Player

instance (Typeable m) => Event (Message m)

viewEvent :: (Event e) => e -> IO () viewEvent event = do case cast event of Just (Player a) -> putStrLn $ show a Nothing -> return () case cast event of Just (Message s) -> putStrLn $ show s Nothing -> return ()

Indeed the overloaded function cast needs to know the target type -- the type to cast to. In case of Player, the pattern (Player a) uniquely determines the type of the desired value: Player. This is not so for Message: the pattern (Message s) may correspond to the type Message (), Message Int, etc.

To avoid the problem, just specify the desired type explicitly

I had the same idea, but it doesn't work. Fixing m to () causes the cast to fail for any other type, so viewEvent (Message "yes" :: Message ())will work, but viewEvent (Message "no" :: Message Char) won't.

Putting viewEvent in the Event class though, like Ryan suggested, seems to be an elegant solution that stays close to the original source.

Cheers, Martijn

case cast event of Just (Message s::Message ()) -> putStrLn $ show s Nothing -> return ()

(ScopedTypeVariables extension is needed). The exact type of the message doesn't matter, so I chose Message ().

BTW, if the set of events is closed, GADTs seem a better fit

data Player data Message s

data Event e where Player :: Int -> Event Player Message :: String -> Event (Message s)

viewEvent :: Event e -> IO () viewEvent (Player a) = putStrLn $ show a viewEvent (Message s) = putStrLn $ show s

_______________________________________________ Haskell-Cafe mailing listHaskell-Cafe@haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe

_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Yes. That'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: *data Player = Arrive | Leave deriving (Show, Typeable, Eq) data Message m = Message String deriving (Show, Typeable, Eq) data Data a where PlayerData :: Int -> Data Player MessageData :: m -> Data (Message m) data Handler where Handler :: (Typeable e) => e -> (Data e -> IO ()) -> Handler instance forall e. (Typeable e) => Typeable (Data e) where typeOf _ = mkTyConApp (mkTyCon( ("Expression.EventData (" ++ (show $ typeOf (undefined::e))) ++ ")" )) [] addEvent :: (Typeable e) => e -> (Data e -> IO ()) -> [Handler] -> [Handler] addEvent e h hs = (Handler e h) : hs triggerEvent :: (Eq e, Typeable e) => e -> Data e -> [Handler] -> IO () triggerEvent e d hs = do let filtered = filter (\(Handler e1 _) -> e1 === e) hs mapM_ f filtered where f (Handler _ h) = case cast h of Just castedH -> do castedH d Nothing -> return () viewEvent :: (Typeable e) => e -> IO() viewEvent event = do case cast event of Just (a :: Player) -> putStrLn $ "Player" ++ show a Nothing -> return () case cast event of (Just (Message s)) -> putStrLn $ "Player" ++ s Nothing -> return ()* Unfortunately, I still cannot pattern match on the events to view them (*viewEvent won't compile)*... Best, Corentin On Tue, Sep 11, 2012 at 4:10 PM, Sean Leather wrote:

On Tue, Sep 11, 2012 at 3:39 PM, Corentin Dupontwrote:

@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't manage. Here is the full problem:

*{-# LANGUAGE ExistentialQuantification, TypeFamilies, DeriveDataTypeable #-}

import Data.Typeable

-- | Define the events and their related data class (Eq e, Typeable e, Show e) => Event e where data EventData e

-- | Groups of events data PlayerEvent = Arrive | Leave deriving (Typeable, Show, Eq)

-- | events types data Player = Player PlayerEvent deriving (Typeable, Show, Eq) data Message m = Message String deriving (Typeable, Show, Eq)

-- | event instances instance Event Player where data EventData Player = PlayerData {playerData :: Int} instance (Typeable m) => Event (Message m) where data EventData (Message m) = MessageData {messageData :: m}

-- | structure to store an event data EventHandler = forall e . (Event e) => EH {eventNumber :: Int, event :: e, handler :: (EventData e) -> IO ()} deriving Typeable

-- store a new event with its handler in the list addEvent :: (Event e) => e -> (EventData e -> IO ()) -> [EventHandler] -> [EventHandler] addEvent event handler ehs = undefined

-- trigger all the corresponding events in the list, passing the **data to the handlers triggerEvent :: (Event e) => e -> (EventData e) -> [EventHandler] -> IO () triggerEvent event edata ehs = undefined

--Examples: msg :: Message Int msg = Message "give me a number" myList = addEvent msg (\(MessageData n) -> putStrLn $ "Your number is: " ++ show n) [] trigger = triggerEvent msg (MessageData 1) **myList --Yelds "Your number is: 1"*

Has you can see this allows me to associate an arbitrary data type to each event with the type family "EventData". Furthermore some events like "Message" let the user choose the data type using the type parameter. This way I have nice signatures for the functions "addEvent" and "triggerEvent". The right types for the handlers and the data passed is enforced at compilation time. But I couldn't find any way to convert this into a GATD and get rid of the "Event" class......

Would this work?

data Player = Arrive | Leave data Message m = Message String

data Data a where PlayerData :: Int -> Data Player MessageData :: m -> Data (Message m)

data Handler where Handler :: Int -> e -> (Data e -> IO ()) -> Handler

addEvent :: e -> (Data e -> IO ()) -> [Handler] -> [Handler] addEvent = undefined

triggerEvent :: e -> Data e -> [Handler] -> IO () triggerEvent = undefined

Regards, Sean

I'm not sure I understand On Tue, Sep 11, 2012 at 11:06 AM, Corentin Dupont wrote:

Yes. That'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:

data Player = Arrive | Leave deriving (Show, Typeable, Eq) data Message m = Message String deriving (Show, Typeable, Eq)

data Data a where PlayerData :: Int -> Data Player MessageData :: m -> Data (Message m)

data Handler where Handler :: (Typeable e) => e -> (Data e -> IO ()) -> Handler

instance forall e. (Typeable e) => Typeable (Data e) where typeOf _ = mkTyConApp (mkTyCon( ("Expression.EventData (" ++ (show $ typeOf (undefined::e))) ++ ")" )) []

addEvent :: (Typeable e) => e -> (Data e -> IO ()) -> [Handler] -> [Handler] addEvent e h hs = (Handler e h) : hs

triggerEvent :: (Eq e, Typeable e) => e -> Data e -> [Handler] -> IO () triggerEvent e d hs = do let filtered = filter (\(Handler e1 _) -> e1 === e) hs mapM_ f filtered where f (Handler _ h) = case cast h of Just castedH -> do castedH d Nothing -> return ()

viewEvent :: (Typeable e) => e -> IO()

viewEvent event = do case cast event of Just (a :: Player) -> putStrLn $ "Player" ++ show a

Nothing -> return () case cast event of (Just (Message s)) -> putStrLn $ "Player" ++ s Nothing -> return ()

Unfortunately, I still cannot pattern match on the events to view them (viewEvent won't compile)...

Mixing GADTs and Typeable seems like a bad idea. If you really don't want to put viewEvent in the Event typeclass, but the class of events is closed, you could use a GADT to witness the event type. class Event e where eventType :: EventType e ... data EventType e where PlayerEvent :: EventType Player MessageEvent :: EventType (Message m) viewEvent :: Event e => e -> IO () viewEvent = viewEvent' eventType viewEvent' :: EventType e -> e -> IO () viewEvent' PlayerEvent e = ... viewEvent' MessageEvent (Message s) = ... -- Dave Menendez http://www.eyrie.org/~zednenem/

On Tue, Sep 11, 2012 at 6:46 PM, David Menendez wrote:

Mixing GADTs and Typeable seems like a bad idea. If you really don't want to put viewEvent in the Event typeclass, but the class of events is closed, you could use a GADT to witness the event type.

On Tue, Sep 11, 2012 at 7:03 PM, Corentin Dupont wrote:

unfortunately it seems that I will be obliged to maintain 2 parallel structures: for each Event instance, I will have to add a ViewEvent element as well carrying the same information:

That's why I like the all-GADT solution... 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. {-# LANGUAGE TypeFamilies, GADTs #-} data Player = Arrive | Leave deriving Show newtype Message t = Message String deriving (Eq, Show) data Type :: * -> * where Int :: Type (Message Int) String :: Type (Message String) Player :: Type Player data TEq :: * -> * -> * where Refl :: TEq a a teq :: Type a -> Type b -> Maybe (TEq a b) teq Int Int = Just Refl teq String String = Just Refl teq Player Player = Just Refl teq _ _ = Nothing type family Data t :: * type instance Data (Message t) = t type instance Data Player = Int data Event t = Event (Type t) t data Handler where Handler :: Event t -> (Data t -> IO ()) -> Handler runHandler :: Eq t => Event t -> Data t -> Handler -> IO () runHandler (Event t e) d (Handler (Event u e') f) = case teq t u of Just Refl | e == e' -> f d _ -> return () runHandlers :: Eq t => Event t -> Data t -> [Handler] -> IO () runHandlers e d hs = mapM_ (runHandler e d) hs -- Replacement for viewEvent instance Show (Event t) where show (Event ty e) = case ty of Int -> show e ++ " of type Int" String -> show e ++ " of type String" Player -> "Player " ++ show e messageEvent :: Type (Message t) -> String -> Event (Message t) messageEvent t s = Event t (Message s) playerEvent :: Player -> Event Player playerEvent = Event Player -- Tests event1 = messageEvent Int "give me a number" -- No type signature necessary! handler1 = Handler event1 (\n -> putStrLn $ "Your number is: " ++ show n) test1 = runHandlers event1 1 [handler1] -- Yields "Your number is: 1" Regards, Sean

On Tue, Sep 11, 2012 at 9:18 PM, Corentin Dupont wrote:

That's very interesting. 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?

Just a "bit" more complicated... {-# LANGUAGE TypeFamilies, GADTs #-} import Data.Typeable import Unsafe.Coerce data Player = Arrive | Leave deriving Show newtype Message t = Message String deriving (Eq, Show) data Type :: * -> * where MessageT :: Typeable t => Proxy t -> Type (Message t) PlayerT :: Type Player data Proxy t typeOfProxy :: Typeable t => Proxy t -> TypeRep typeOfProxy x = typeOf (unproxy x) where unproxy :: Proxy t -> t unproxy = undefined data TEq :: * -> * -> * where Refl :: TEq a a teq :: Type a -> Type b -> Maybe (TEq a b) teq (MessageT p) (MessageT q) | typeOfProxy p == typeOfProxy q = Just (unsafeCoerce Refl) teq PlayerT PlayerT = Just Refl teq _ _ = Nothing type family Data t :: * type instance Data (Message t) = t type instance Data Player = Int data Event t = Event (Type t) t data Handler where Handler :: Event t -> (Data t -> IO ()) -> Handler runHandler :: Eq t => Event t -> Data t -> Handler -> IO () runHandler (Event t e) d (Handler (Event u e') f) = case teq t u of Just Refl | e == e' -> f d _ -> return () runHandlers :: Eq t => Event t -> Data t -> [Handler] -> IO () runHandlers e d hs = mapM_ (runHandler e d) hs -- Replacement for viewEvent instance Show (Event t) where show (Event ty e) = case ty of MessageT t -> show e ++ " of type " ++ show (typeOfProxy t) PlayerT -> "Player " ++ show e messageEvent :: Typeable t => Proxy t -> String -> Event (Message t) messageEvent t s = Event (MessageT t) (Message s) playerEvent :: Player -> Event Player playerEvent = Event PlayerT -- Tests int :: Proxy Int int = undefined event1 = messageEvent int "give me a number" -- No type signature necessary! handler1 = Handler event1 (\n -> putStrLn $ "Your number is: " ++ show n) test1 = runHandlers event1 1 [handler1] -- Yields "Your number is: 1" 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. Regards, Sean

If I understand, the SomeEvent event acts as a proxy to hide the diversity of the events? That's interesting. This way I don't have to use an heterogeneous list and a lot of casting... On Wed, Sep 12, 2012 at 7:44 AM, wrote:

Let me see if I understand. You have events of different sorts: events about players, events about timeouts, events about various messages. Associated with each sort of event is a (potentially open) set of data types: messages can carry payload of various types. A handler specifies behavior of a system upon the reception of an event. A game entity (player, monster, etc) is a collection of behaviors. The typing problem is building the heterogeneous collection of behaviors and routing an event to the appropriate handler. Is this right?

There seem to be two main implementations, with explicit types and latent (dynamic) types. The explicit-type representation is essentially HList (a Type-indexed Record, TIR, to be precise). Let's start with the latent-type representation. Now I understand your problem better, I think your original approach was the right one. GADT was a distraction, sorry. Hopefully you find the code below better reflects your intentions.

{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-} {-# LANGUAGE StandaloneDeriving #-}

import Data.Typeable

-- Events sorts

data Player = Player PlayerN PlayerStatus deriving (Eq, Show, Typeable)

type PlayerN = Int data PlayerStatus = Enetering | Leaving deriving (Eq, Show)

newtype Message m = Message m deriving (Eq, Show)

deriving instance Typeable1 Message

newtype Time = Time Int deriving (Eq, Show, Typeable)

data SomeEvent = forall e. Typeable e => SomeEvent e deriving (Typeable)

-- They are all events

class Typeable e => Event e where -- the Event predicate what_event :: SomeEvent -> Maybe e what_event (SomeEvent e) = cast e

instance Event Player instance Event Time instance Typeable m => Event (Message m)

instance Event SomeEvent where what_event = Just

-- A handler is a reaction on an event -- Given an event, a handler may decline to handle it type Handler e = e -> Maybe (IO ())

inj_handler :: Event e => Handler e -> Handler SomeEvent inj_handler h se | Just e <- what_event se = h e inj_handler _ _ = Nothing

type Handlers = [Handler SomeEvent]

trigger :: Event e => e -> Handlers -> IO () trigger e [] = fail "Not handled" trigger e (h:rest) | Just rh <- h (SomeEvent e) = rh | otherwise = trigger e rest

-- Sample behaviors

-- viewing behavior (although viewing is better with Show since all -- particular events implement it anyway)

view_player :: Handler Player view_player (Player x s) = Just . putStrLn . unwords $ ["Player", show x, show s]

-- View a particular message view_msg_str :: Handler (Message String) view_msg_str (Message s) = Just . putStrLn . unwords $ ["Message", s]

-- View any message view_msg_any :: Handler SomeEvent view_msg_any (SomeEvent e) | (tc1,[tr]) <- splitTyConApp (typeOf e), (tc2,_) <- splitTyConApp (typeOf (undefined::Message ())), tc1 == tc2 = Just . putStrLn . unwords $ ["Some message of the type", show tr] view_msg_any _ = Nothing

viewers = [inj_handler view_player, inj_handler view_msg_str, view_msg_any]

test1 = trigger (Player 1 Leaving) viewers -- Player 1 Leaving

test2 = trigger (Message "str1") viewers -- Message str1

test3 = trigger (Message (2::Int)) viewers -- Some message of the type Int