[Haskell-cafe] event handler

[Corentin Dupont]

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 <corentin.dupont at gmail.com
> 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 <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/20120616/5fe71a06/attachment.htm>