Re: [Haskell-cafe] type variable in class instance

I finally come up with this version, which allows to do pattern matching against the events. I'm sure it could be cleaned a bit, but it think the idea is there. I would like to thank again everybody on this list, that's very friendly and helpful! Corentin *{-# LANGUAGE ExistentialQuantification, TypeFamilies, DeriveDataTypeable, GADTs, ScopedTypeVariables, StandaloneDeriving #-} import Data.Typeable data Player = Arrive | Leave deriving (Show, Typeable, Eq) data Message m = Message String deriving (Show, Typeable, Eq) data Event a where PlayerEvent :: Player -> Event Player MessageEvent :: Message m -> Event (Message m) data Data a where PlayerData :: Int -> Data (Event Player) MessageData :: m -> Data (Event (Message m)) data Handler where Handler :: (Typeable e) => Event e -> (Data (Event e) -> IO ()) -> Handler deriving instance Eq (Event a) deriving instance Typeable1 Data deriving instance Typeable1 Event addEvent :: (Typeable e) => Event e -> (Data (Event e) -> IO ()) -> [Handler] -> [Handler] addEvent e h hs = (Handler e h) : hs triggerEvent :: (Eq e, Typeable e) => Event e -> (Data (Event 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) => (Event e) -> IO() viewEvent (PlayerEvent p) = putStrLn $ "Player " ++ show p viewEvent m@(MessageEvent s) = putStrLn $ "Message " ++ show s ++ " of type " ++ (show $ typeOf m) -- | an equality that tests also the types. (===) :: (Typeable a, Typeable b, Eq b) => a -> b -> Bool (===) x y = cast x == Just y --TEST testPlayer = addEvent (PlayerEvent Arrive) (\(PlayerData d) -> putStrLn $ show d) [] msg :: Message Int msg = Message "give me a number" myList = addEvent (MessageEvent msg) (\(MessageData n) -> putStrLn $ "Your number is: " ++ show n) [] trigger = triggerEvent (MessageEvent msg) (MessageData 1) myList --Yelds "Your number is: 1"* On Tue, Sep 11, 2012 at 5:06 PM, 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)*...

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