2017-11-25 08:05:04 +00:00
|
|
|
module Affection.MessageBus where
|
|
|
|
|
2017-11-26 12:59:59 +00:00
|
|
|
import Control.Concurrent.STM as STM
|
|
|
|
|
|
|
|
import Data.IORef
|
|
|
|
|
|
|
|
class Message msg where
|
|
|
|
msgPayload :: msg -> Maybe a
|
|
|
|
|
|
|
|
type Channel msg = TChan msg
|
|
|
|
|
|
|
|
class Participant prt where
|
|
|
|
partChannel :: (Message msg) => prt -> IORef (Channel msg)
|
|
|
|
|
|
|
|
partConnectChannel :: (Message msg) => prt -> (Channel msg) -> IO ()
|
|
|
|
|
|
|
|
partListen :: (Message msg) => prt -> IO msg
|
|
|
|
|
|
|
|
partBroadcast :: (Message msg) => prt -> msg -> IO ()
|
|
|
|
|
|
|
|
newBroadcastChannel :: IO (Channel msg)
|
|
|
|
newBroadcastChannel = atomically $ newBroadcastTChan
|