I made some modifications based on your suggestions (see below). I made a two parameters class: *class (Typeable e, Typeable d) => Handled e d * Because after all what I want is to associate an event with its type parameters. I don't know why I cannot implement you suggestion to restrict the instances of Event: *data **(Handled e d) => **Event e = Event deriving (Typeable, Eq) *gives me a *Not in scope: type variable `d'*
But apart from that it works very well! It's quite a nice interface! Also just to know, is there a way of getting ride of all these "Typeable"? {-# LANGUAGE ExistentialQuantification, DeriveDataTypeable, MultiParamTypeClasses #-} *module Events (addEvent, newPlayer, newRule) where import Control.Monad import Data.List import Data.Typeable newtype Player = P Int deriving Typeable newtype Rule = R Int deriving Typeable data Event e = Event deriving (Typeable, Eq) data NewPlayer deriving Typeable data NewRule deriving Typeable newPlayer :: Event NewPlayer newPlayer = Event newRule :: Event NewRule newRule = Event class (Typeable e, Typeable d) => Handled e d instance Handled NewPlayer Player instance Handled NewRule Rule data EventHandler = forall e d . (Handled e d) => EH (Event e) (d -> IO ()) addEvent :: (Handled e d) => Event e -> (d -> IO ()) -> [EventHandler] -> [EventHandler] addEvent e h ehs = (EH e h):ehs triggerEvent :: (Handled e d) => Event e -> d -> [EventHandler] -> IO () triggerEvent e d ehs = do let r = find (\(EH myEvent _) -> cast e == Just myEvent) ehs case r of Nothing -> return () Just (EH _ h) -> case cast h of Just castedH -> castedH d Nothing -> return () -- TESTS h1 :: Player -> IO () h1 (P a) = putStrLn $ "Welcome Player " ++ (show a) ++ "!" h2 :: Rule -> IO () h2 (R a) = putStrLn $ "New Rule " ++ (show a) eventList1 = addEvent newPlayer h1 [] eventList2 = addEvent newRule h2 eventList1 trigger1 = triggerEvent newPlayer (P 1) eventList2 --Yelds "Welcome Player 1!" trigger2 = triggerEvent newRule (R 2) eventList2 --Yelds "New Rule 2" * On Fri, Jun 15, 2012 at 4:53 PM, Alexander Solla <alex.so...@gmail.com>wrote: > > > On Fri, Jun 15, 2012 at 6:38 AM, Corentin Dupont < > corentin.dup...@gmail.com> wrote: > >> >> It just bothers me a little that I'm not able to enumerate the events, >> and also that the user is able to create events with wrong types (like New >> :: Event String), even if they won't be able to register them. >> > > This can be solved with an explicit export list/smart constructors. > > newPlayer :: Event Player > newRule :: Event Rule > (hide the New constructor) > > In any case, my thinking was that your original > > data Event = *NewPlayer | NewRule* > * > * > was basically trying to "join" the semantics of "new things" with Player > and Rule. But the original approach ran into the problem you mention below > -- it is difficult to maintain invariants, since the types want to > "multiply". So formally, I factored: > > data Event = NewPlayer | NewRule ==> > data Event = New (Player | Rule) ==> > data Event d = New -- (since the original event didn't want a Player or > Rule value. It witnessed the type relation) > > On the other hand, if you want to make sure that a type must be "Handled" > before you can issue an Event, you can do: > > data (Handled d) => Evend d = New > > I'm pretty sure the compiler will complain if you try to make a (New :: > Event String). I like this idea better than smart constructors for events, > if only because you get to use ScopedTypeVariables. > > >> I also have several unrelated events that use the same type of data, so >> this would be a problem. > > > Can you clarify? > I mean that I have events like: Message String UserEvent String That have a "data" of the same type, but they are not related. > > >> Adding more events like >> *data Event d = NewPlayer | NewRule deriving (Typeable, Eq)* >> is not correct because I can add wrong events like: >> addEvent (NewPlayer :: Event Rule) (H(undefined::(Rule -> IO()))) [] >> ** >> Also one question: I don't understand the "where" clause in your class. >> If I remove it, it works the same... >> > > Yes, unnecessary where clauses are optional. > > Here is my code: >> >> *newtype Player = P Int deriving Typeable >> newtype Rule = R Int deriving Typeable >> data Event d = New deriving (Typeable, Eq) >> >> class (Typeable d) => Handled d where >> data Handler d = H (d -> IO ()) >> >> data EventHandler = forall d . (Handled d) => EH (Event d) (Handler d) >> >> >> instance Handled Player >> instance Handled Rule >> >> addEvent :: (Handled d) => Event d -> Handler d -> [EventHandler] -> >> [EventHandler] >> addEvent e h ehs = (EH e h):ehs >> >> >> triggerEvent :: (Handled d) => Event d -> d -> [EventHandler] -> IO () >> triggerEvent e d ehs = do >> let r = find (\(EH myEvent _) -> cast e == Just myEvent) ehs >> >> case r of >> Nothing -> return () >> Just (EH _ (H h)) -> case cast h of >> Just castedH -> castedH d >> Nothing -> return () >> >> h1 :: Player -> IO () >> h1 (P a) = putStrLn $ "Welcome Player " ++ (show a) ++ "!" >> h2 :: Rule -> IO () >> h2 (R a) = putStrLn $ "New Rule " ++ (show a) >> eventList1 = addEvent (New :: Event Player) (H h1) [] >> eventList2 = addEvent (New :: Event Rule) (H h2) eventList1 >> >> trigger1 = triggerEvent (New :: Event Player) (P 1) eventList2 -- yelds >> "Welcome Player 1!" >> trigger2 = triggerEvent (New :: Event Rule) (R 2) eventList2 --yelds "New >> Rule* 2" >> >> Best, >> Corentin >> >> >> On Fri, Jun 15, 2012 at 12:40 AM, Alexander Solla >> <alex.so...@gmail.com>wrote: >> >>> >>> >>> On Thu, Jun 14, 2012 at 2:04 PM, Corentin Dupont < >>> corentin.dup...@gmail.com> wrote: >>> >>>> That look really nice! >>>> Unfortunately I need to have an heterogeneous list of all events with >>>> their handlers. >>>> With this test code it won't compile: >>>> >>>> test1 = addEvent (New :: Event Player) (H (undefined::(Player -> IO >>>> ()))) [] >>>> test2 = addEvent (New :: Event Rule) (H (undefined::(Rule -> IO ()))) >>>> test1 >>>> >>>> >>> Right, okay. Heterogenous lists are tricky, but I think we can get away >>> with using ExistentialQuantification, since you seem to only want to >>> dispatch over the heterogenous types. The assumption I made is a big deal! >>> It means you can't extract the d value. You can only apply properly typed >>> functions (your handlers) on it. >>> >>> >>> * >>> {-# LANGUAGE ExistentialQuantification #-} >>> * >>> >>> * >>> type Player = Int >>> * >>> >>> * >>> type Rule = Int >>> * >>> >>> * >>> data Event d = New d >>> * >>> * >>> * >>> >>> *class Handled data where -- Together with EventHandler, corresponds to >>> your "Data" type* >>> * >>> * >>> >>> *data EventHandler = forall d . (Handled d) => EH (Event d) (d -> IO >>> ()) -- EventHandler takes the place of your (Event d, Handler d) pairs >>> without referring to d.* >>> >>> * >>> * >>> >>> *instance Handled Player* >>> >>> *instance Handled Rule* >>> >>> >>> *addEvent :: (Handled d) => Event d -> Handler d -> [EventHandler] -> >>> [EventHandler] -- Every [EventHandler] made using addEvent will be of >>> "correct" types (i.e., preserve the typing invariants you want), but YOU >>> must ensure that only [EventHandler]s made in this way are used. This can >>> be done statically with another type and an explicit export list. We can >>> talk about that later, if this works in principle.* >>> >>> >>> >>> >>> *triggerEvent :: (Handled d) => Event d -> d -> [EventHandler] -> IO ()* >>> >>> >>> >> >
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe