Merge pull request #7 from nek0/mesg

better messages with type families
This commit is contained in:
rys ostrovid 2017-12-27 17:34:47 +01:00 committed by GitHub
commit ea9c406640
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
7 changed files with 26 additions and 14 deletions

View file

@ -7,7 +7,7 @@ module Affection.MessageBus.Class
( Participant(..)
, genUUID
, UUID
, MsgId(..)
-- , MsgId(..)
) where
import Affection.MessageBus.Message
@ -20,30 +20,31 @@ import Data.UUID.V4
import Affection.Logging
class (Message msg, Show msg) => Participant prt msg us where
class (Message (Mesg prt us), Show (Mesg prt us)) => Participant prt us where
type Mesg prt us :: *
-- | Function to get the list of subscribers from the participant
partSubscribers
:: prt
-- ^ the 'Participant''s subscriber storage
-> Affection us [msg -> Affection us ()]
-> Affection us [Mesg prt us -> Affection us ()]
-- ^ List of Subscriber functions
-- | Subscribe to the 'Participant''s events
partSubscribe
:: prt
-- ^ The 'Participant''s subscriber storage
-> (msg -> Affection us ())
-> (Mesg prt us -> Affection us ())
-- ^ What to do in case of a 'Message'
-- (Subscriber function)
-> Affection us (MsgId msg)
-> Affection us UUID
-- ^ 'UUID' of the registered subscriber Function
-- | Unsubscribe a Subscriber function from Participant
partUnSubscribe
:: prt
-- ^ The 'Participant''s subscriber storage to unsubscribe from
-> (MsgId msg)
-> UUID
-- ^ The subscriber function's 'UUID'
-> Affection us ()
@ -51,7 +52,7 @@ class (Message msg, Show msg) => Participant prt msg us where
partEmit
:: prt
-- ^ The 'Participant''s subscriber storage
-> msg
-> Mesg prt us
-- ^ The 'Message' to emit
-> Affection us ()
partEmit p m = do
@ -63,4 +64,4 @@ class (Message msg, Show msg) => Participant prt msg us where
genUUID :: Affection us UUID
genUUID = liftIO nextRandom
data MsgId msg = (Message msg, Show msg) => MsgId UUID msg
-- data MsgId msg = (Message msg, Show msg) => MsgId UUID msg

View file

@ -12,7 +12,6 @@ data KeyboardMessage
, msgKbdKeyRepeat :: Bool
, msgKbdKeysym :: SDL.Keysym
}
| MsgKeyboardEmptyEvent
deriving (Show)
instance Message KeyboardMessage where

View file

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

View file

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

View file

@ -1,5 +1,7 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Affection.Subsystems.AffectionKeyboard where
import Affection.Types
@ -13,7 +15,7 @@ import Control.Monad.IO.Class (liftIO)
import qualified SDL
consumeSDLKeyboardEvents
:: (Participant ak KeyboardMessage us)
:: forall ak us. (Participant ak us, Mesg ak us ~ KeyboardMessage)
=> ak
-> [SDL.EventPayload]
-> Affection us [SDL.EventPayload]

View file

@ -1,5 +1,7 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Affection.Subsystems.AffectionMouse where
import Affection.MessageBus
@ -15,12 +17,15 @@ import Linear.Affine (unP)
import qualified SDL
consumeSDLMouseEvents
:: (Participant am MouseMessage us)
:: forall am us. (Participant am us, Mesg am us ~ MouseMessage)
=> am
-> [SDL.EventPayload]
-> Affection us [SDL.EventPayload]
consumeSDLMouseEvents am = doConsume
where
doConsume
:: [SDL.EventPayload]
-> Affection us [SDL.EventPayload]
doConsume [] = return []
doConsume (e:es) = do
ts <- getElapsedTime

View file

@ -1,6 +1,9 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module Affection.Subsystems.AffectionWindow where
import Affection.Types
@ -14,12 +17,16 @@ import Control.Monad.IO.Class (liftIO)
import qualified SDL
consumeSDLWindowEvents
:: (Participant aw WindowMessage us)
:: forall aw us. (Participant aw us, Mesg aw us ~ WindowMessage)
=> aw
-> [SDL.EventPayload]
-> Affection us [SDL.EventPayload]
consumeSDLWindowEvents aw = doConsume
where
doConsume
:: (Mesg aw us ~ WindowMessage)
=> [SDL.EventPayload]
-> Affection us [SDL.EventPayload]
doConsume [] = return []
doConsume (e:es) = do
ts <- getElapsedTime