rebuilding participant system

This commit is contained in:
nek0 2017-12-20 02:00:48 +01:00
parent 13991556dc
commit ea90f8f9cd
4 changed files with 23 additions and 13 deletions

View file

@ -1,10 +1,13 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
module Affection.MessageBus.Class
( Participant(..)
, genUUID
, UUID
, MsgId(..)
) where
import Affection.MessageBus.Message
@ -17,30 +20,30 @@ import Data.UUID.V4
import Affection.Logging
class (Show m, Message m) => Participant prt m us where
class (Message msg, Show msg) => Participant prt msg us where
-- | Function to get the list of subscribers from the participant
partSubscribers
:: prt
-- ^ the 'Participant''s subscriber storage
-> Affection us [m -> Affection us ()]
-> Affection us [msg -> Affection us ()]
-- ^ List of Subscriber functions
-- | Subscribe to the 'Participant''s events
partSubscribe
:: prt
-- ^ The 'Participant''s subscriber storage
-> (m -> Affection us ())
-> (msg -> Affection us ())
-- ^ What to do in case of a 'Message'
-- (Subscriber function)
-> Affection us UUID
-> Affection us (MsgId msg)
-- ^ 'UUID' of the registered subscriber Function
-- | Unsubscribe a Subscriber function from Participant
partUnSubscribe
:: prt
-- ^ The 'Participant''s subscriber storage to unsubscribe from
-> UUID
-> (MsgId msg)
-- ^ The subscriber function's 'UUID'
-> Affection us ()
@ -48,7 +51,7 @@ class (Show m, Message m) => Participant prt m us where
partEmit
:: prt
-- ^ The 'Participant''s subscriber storage
-> m
-> msg
-- ^ The 'Message' to emit
-> Affection us ()
partEmit p m = do
@ -59,3 +62,5 @@ class (Show m, Message m) => Participant prt m us where
-- | Helper function to generate new 'UUID's
genUUID :: Affection us UUID
genUUID = liftIO nextRandom
data MsgId msg = (Message msg, Show msg) => MsgId UUID msg

View file

@ -4,13 +4,16 @@ import Affection.MessageBus.Message.Class
import qualified SDL
data KeyboardMessage = MsgKeyboardEvent
{ msgKbdWhen :: Double
, msgKbdWindow :: Maybe SDL.Window
, msgKbdKeyMotion :: SDL.InputMotion
, msgKbdKeyRepeat :: Bool
, msgKbdKeysym :: SDL.Keysym
} deriving (Show)
data KeyboardMessage
= MsgKeyboardEvent
{ msgKbdWhen :: Double
, msgKbdWindow :: Maybe SDL.Window
, msgKbdKeyMotion :: SDL.InputMotion
, msgKbdKeyRepeat :: Bool
, msgKbdKeysym :: SDL.Keysym
}
| MsgKeyboardEmptyEvent
deriving (Show)
instance Message KeyboardMessage where
msgTime (MsgKeyboardEvent t _ _ _ _) = t

View file

@ -33,6 +33,7 @@ data MouseMessage
, msgMWPos :: V2 Int32
, msgMWDIrection :: SDL.MouseScrollDirection
}
| MsgMouseEmptyMessage
deriving (Show)
instance Message MouseMessage where

View file

@ -68,6 +68,7 @@ data WindowMessage
{ msgWCWhen :: Double
, msgWCWindow :: SDL.Window
}
| MsgWindowEmptyEvent
deriving (Show)
instance Message WindowMessage where