[Haskell-cafe] event handler
Alexander Solla
alex.solla at gmail.com
Fri Jun 15 16:53:38 CEST 2012
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?
> 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/f70c8d8a/attachment.htm>
More information about the Haskell-Cafe
mailing list