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 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 PlayernewRule :: Event Rule(hide the New constructor)In any case, my thinking was that your originaldata Event = NewPlayer | NewRulewas 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?
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 wheredata Handler d = H (d -> IO ())data EventHandler = forall d . (Handled d) => EH (Event d) (Handler d)
addEvent e h ehs = (EH e h):ehs
instance Handled Player
instance Handled Rule
addEvent :: (Handled d) => Event d -> Handler d -> [EventHandler] -> [EventHandler]
triggerEvent e d ehs = do
triggerEvent :: (Handled d) => Event d -> d -> [EventHandler] -> IO ()
let r = find (\(EH myEvent _) -> cast e == Just myEvent) ehsJust (EH _ (H h)) -> case cast h of
case r of
Nothing -> return ()
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,
CorentinOn Fri, Jun 15, 2012 at 12:40 AM, Alexander Solla <alex.solla@gmail.com> wrote:
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 ()))) test1Right, 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 = Intclass Handled data where -- Together with EventHandler, corresponds to your "Data" typetype Rule = Intdata Event d = New d
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.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.
instance Handled Player
instance Handled Rule
triggerEvent :: (Handled d) => Event d -> d -> [EventHandler] -> IO ()