defining mesage bus further

This commit is contained in:
nek0 2017-11-27 01:43:43 +01:00
parent da2ba52aae
commit 1bb1af935b
4 changed files with 24 additions and 8 deletions

View File

@ -68,6 +68,7 @@ library
, sdl2
, text
, mtl
, time
-- , gegl
-- , babl
, monad-loops

View File

@ -1,3 +1,4 @@
{-# LANGUAGE MultiParamTypeClasses #-}
module Affection.MessageBus.Class where
import Control.Concurrent.STM as STM
@ -6,13 +7,13 @@ import Data.IORef
import Affection.MessageBus.Message
type Channel msg = TChan msg
newtype (Message msg) => Channel msg = Channel (TChan msg)
class Participant prt where
partChannel :: (Message msg) => prt -> IORef (Channel msg)
class (Message msg) => Participant prt msg where
partChannel :: prt -> IORef (Channel msg)
partConnectChannel :: (Message msg) => prt -> Channel msg -> IO ()
partConnectChannel :: prt -> Channel msg -> IO ()
partListen :: (Message msg) => prt -> IO msg
partListen :: prt -> IO msg
partBroadcast :: (Message msg) => prt -> msg -> IO ()
partBroadcast :: prt -> msg -> IO ()

View File

@ -1,4 +1,18 @@
{-# LANGUAGE RankNTypes #-}
module Affection.MessageBus.Message where
import Data.Time.Clock (UTCTime(..))
class Message msg where
msgPayload :: msg -> a
msgTime :: msg -> UTCTime
data EngineMessage m
= MsgUserMessage
{ msgPayload :: m
, msgWhen :: UTCTime
} -- ^ Generic user defined message with custom payload
| MsgEngineReady UTCTime
instance Message (EngineMessage m) where
msgTime (MsgUserMessage _ t) = t
msgTime (MsgEngineReady t) = t

View File

@ -5,4 +5,4 @@ import Affection.MessageBus.Message
import Control.Concurrent.STM as STM
newBroadcastChannel :: (Message msg) => IO (Channel msg)
newBroadcastChannel = atomically $ newBroadcastTChan
newBroadcastChannel = atomically $ Channel <$> newBroadcastTChan