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 <leat...@cs.uu.nl> 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 >
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe