[Haskell-cafe] event handler

Corentin Dupont corentin.dupont at gmail.com
Sun Jun 17 15:22:25 CEST 2012


OK, so here's my last attempt. What do you think?
The Event class is optional (it works without because of EventData is
enforcing the use of the right types) however, I find it more clear because
it clearly specifies which types are events.
*
data NewPlayer = NewPlayer deriving (Typeable, Eq)
data NewRule = NewRule deriving (Typeable, Eq)

class (Eq e, Typeable e) => Event e
instance Event NewPlayer
instance Event NewRule

data family EventData e
data instance EventData NewPlayer = P Int
data instance EventData NewRule = R Int
instance Typeable1 EventData where
    typeOf1 _ = mkTyConApp (mkTyCon "EventData") []

data EventHandler = forall e . (Event e) => EH e (EventData e -> IO ())

addEvent :: (Event e) => e -> (EventData e -> IO ()) -> [EventHandler] ->
[EventHandler]
addEvent e h ehs = (EH e h):ehs


triggerEvent :: (Event e) => e -> (EventData e) -> [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 :: EventData NewPlayer -> IO ()
h1 (P a) = putStrLn $ "Welcome Player " ++ (show a) ++ "!"
h2 :: EventData NewRule -> 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" *


Thanks again!!
Corentin

On Sun, Jun 17, 2012 at 12:46 AM, Alexander Solla <alex.solla at gmail.com>wrote:

>
>
> On Sat, Jun 16, 2012 at 3:31 PM, Corentin Dupont <
> corentin.dupont at gmail.com> wrote:
>
>> Hi Alexander,
>> sorry my initial example was maybe misleading. What I really what to do
>> is to associate each event with an arbitrary data type. For example,
>> consider the following events:
>> NewPlayer
>> NewRule
>> Message
>> User
>>
>> I want to associate the following data types with each, to pass to there
>> respective handlers:
>> NewPlayer ---> Player
>> NewRule ---> Rule
>> Message ---> String
>> User ---> String
>>
>> Message and User have the same data type associated, that's why we can't
>> use this type as a key to index the event...
>>
>>
> In that case, you definitely want FunctionalDependencies or TypeFamilies,
> and will probably want to drop the constraint (Handler e d) on Event e (if
> it doesn't work), and maybe enforce it with explicit exports.
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120617/2ef0821f/attachment.htm>


More information about the Haskell-Cafe mailing list