[Haskell-cafe] event handler

[Corentin Dupont]

Hi,
it works very well!
I tried to implement it. Here is my test code. Apparently I need some casts
to search the list.
The syntax looks good. Only addEvent will be on the interface, so that
should be fine. If I understand well, that's this function that enforces
the right types to be used. The events are referenced via the type of data
they use.
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.

I also have several unrelated events that use the same type of data, so
this would be a problem. 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...

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.solla at gmail.com>wrote:

>
>
> On Thu, Jun 14, 2012 at 2:04 PM, Corentin Dupont <
> corentin.dupont at 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 ()*
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120615/cac67345/attachment.htm>