[Haskell-cafe] type variable in class instance

[Corentin Dupont]

Yes.
That's fantastic! This GADT is the missing piece of my puzzle. I
transformed a bit your solution, polluting it with some classes instances
and fleshing the functions:

*data Player = Arrive | Leave deriving (Show, Typeable, Eq)
data Message m = Message String deriving (Show, Typeable, Eq)

data Data a where
  PlayerData  :: Int -> Data Player
  MessageData :: m -> Data (Message m)

data Handler where
  Handler :: (Typeable e) => e -> (Data e -> IO ()) -> Handler

instance forall e. (Typeable e) => Typeable (Data e) where
    typeOf _  = mkTyConApp (mkTyCon( ("Expression.EventData (" ++ (show $
typeOf (undefined::e))) ++ ")" )) []

addEvent :: (Typeable e) => e -> (Data e -> IO ()) -> [Handler] -> [Handler]
addEvent e h hs = (Handler e h) : hs

triggerEvent :: (Eq e, Typeable e) => e -> Data e -> [Handler] -> IO ()
triggerEvent e d hs = do
    let filtered = filter (\(Handler e1 _) -> e1 === e) hs
    mapM_ f filtered where
        f (Handler _ h) = case cast h of
            Just castedH -> do
                castedH d
            Nothing -> return ()

viewEvent :: (Typeable e) => e -> IO()
viewEvent event = do
    case cast event of
        Just (a :: Player) -> putStrLn $ "Player" ++ show a
        Nothing -> return ()
    case cast event of
        (Just (Message s)) -> putStrLn $ "Player" ++ s
        Nothing -> return ()*


Unfortunately, I still cannot pattern match on the events to view them
(*viewEvent
won't compile)*...

Best,
Corentin


On Tue, Sep 11, 2012 at 4:10 PM, Sean Leather <leather at cs.uu.nl> wrote:

> On Tue, Sep 11, 2012 at 3:39 PM, Corentin Dupontwrote:
>
> @Oleg: Yes the set of events is closed and I would be much happier with a
>> GADT! But no matter how hard I tried I couldn't manage.
>> Here is the full problem:
>>
>> *{-# LANGUAGE ExistentialQuantification, TypeFamilies,
>> DeriveDataTypeable #-}
>>
>> import Data.Typeable
>>
>> -- | Define the events and their related data
>> class (Eq e, Typeable e, Show e) => Event e where
>>     data EventData e
>>
>> -- | Groups of events
>> data PlayerEvent = Arrive | Leave deriving (Typeable, Show, Eq)
>>
>> -- | events types
>> data Player          = Player PlayerEvent deriving (Typeable, Show, Eq)
>> data Message m  = Message String     deriving (Typeable, Show, Eq)
>>
>> -- | event instances
>> instance Event Player                                      where data
>> EventData Player             = PlayerData {playerData :: Int}
>> instance (Typeable m) => Event (Message m)   where data EventData
>> (Message m)   = MessageData {messageData :: m}
>>
>> -- | structure to store an event
>> data EventHandler = forall e . (Event e) =>
>>      EH {eventNumber :: Int,
>>          event :: e,
>>          handler :: (EventData e) -> IO ()} deriving Typeable
>>
>> -- store a new event with its handler in the list
>> addEvent :: (Event e) => e -> (EventData e -> IO ()) -> [EventHandler] ->
>> [EventHandler]
>> addEvent event handler ehs = undefined
>>
>> -- trigger all the corresponding events in the list, passing the **data
>> to the handlers
>> triggerEvent :: (Event e) => e -> (EventData e) -> [EventHandler] -> IO ()
>> triggerEvent event edata ehs = undefined
>>
>> --Examples:
>> msg :: Message Int
>> msg = Message "give me a number"
>> myList = addEvent msg (\(MessageData n) -> putStrLn $ "Your number is: "
>> ++ show n) []
>> trigger = triggerEvent msg (MessageData 1) **myList --Yelds "Your number
>> is: 1"*
>>
>> Has you can see this allows me to associate an arbitrary data type to
>> each event with the type family "EventData". Furthermore some events like
>> "Message" let the user choose the data type using the type parameter. This
>> way I have nice signatures for the functions "addEvent" and "triggerEvent".
>> The right types for the handlers and the data passed is enforced at
>> compilation time.
>> But I couldn't find any way to convert this into a GATD and get rid of
>> the "Event" class......
>>
>
> Would this work?
>
> data Player = Arrive | Leave
> data Message m = Message String
>
> data Data a where
>   PlayerData  :: Int -> Data Player
>   MessageData :: m -> Data (Message m)
>
> data Handler where
>   Handler :: Int -> e -> (Data e -> IO ()) -> Handler
>
> addEvent :: e -> (Data e -> IO ()) -> [Handler] -> [Handler]
> addEvent = undefined
>
> triggerEvent :: e -> Data e -> [Handler] -> IO ()
> triggerEvent = undefined
>
> Regards,
> Sean
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120911/2323bcad/attachment.htm>