[Haskell-cafe] event handler

[Corentin Dupont]

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

>
>
> On Fri, Jun 15, 2012 at 6:38 AM, Corentin Dupont <
> corentin.dupont at 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.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/ad62710e/attachment.htm>