Just wondering, could type families be of any help here?
I don't know type families, but can it be a mean to regroup together the
event types, that are now completely separated :
*data NewPlayer deriving Typeable
data NewRule deriving Typeable*
On Fri, Jun 15, 2012 at 10:59 PM, Corentin Dupont wrote: 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 On Fri, Jun 15, 2012 at 6:38 AM, Corentin Dupont <
corentin.dupont@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 On Thu, Jun 14, 2012 at 2:04 PM, Corentin Dupont <
corentin.dupont@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 ()
*