From da2ba52aaeb777a23190714d744db141848ff7eb Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 26 Nov 2017 22:26:41 +0100 Subject: [PATCH] adding missing files --- src/Affection/MessageBus/Class.hs | 18 ++++++++++++++++++ src/Affection/MessageBus/Engine.hs | 3 +++ src/Affection/MessageBus/Message.hs | 4 ++++ src/Affection/MessageBus/Util.hs | 8 ++++++++ 4 files changed, 33 insertions(+) create mode 100644 src/Affection/MessageBus/Class.hs create mode 100644 src/Affection/MessageBus/Engine.hs create mode 100644 src/Affection/MessageBus/Message.hs create mode 100644 src/Affection/MessageBus/Util.hs diff --git a/src/Affection/MessageBus/Class.hs b/src/Affection/MessageBus/Class.hs new file mode 100644 index 0000000..fb07942 --- /dev/null +++ b/src/Affection/MessageBus/Class.hs @@ -0,0 +1,18 @@ +module Affection.MessageBus.Class where + +import Control.Concurrent.STM as STM + +import Data.IORef + +import Affection.MessageBus.Message + +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 () diff --git a/src/Affection/MessageBus/Engine.hs b/src/Affection/MessageBus/Engine.hs new file mode 100644 index 0000000..9990a94 --- /dev/null +++ b/src/Affection/MessageBus/Engine.hs @@ -0,0 +1,3 @@ +module Affection.MessageBus.Engine where + +import Affection.MessageBus.Class diff --git a/src/Affection/MessageBus/Message.hs b/src/Affection/MessageBus/Message.hs new file mode 100644 index 0000000..5765aec --- /dev/null +++ b/src/Affection/MessageBus/Message.hs @@ -0,0 +1,4 @@ +module Affection.MessageBus.Message where + +class Message msg where + msgPayload :: msg -> a diff --git a/src/Affection/MessageBus/Util.hs b/src/Affection/MessageBus/Util.hs new file mode 100644 index 0000000..759c582 --- /dev/null +++ b/src/Affection/MessageBus/Util.hs @@ -0,0 +1,8 @@ +module Affection.MessageBus.Util where + +import Affection.MessageBus.Class +import Affection.MessageBus.Message +import Control.Concurrent.STM as STM + +newBroadcastChannel :: (Message msg) => IO (Channel msg) +newBroadcastChannel = atomically $ newBroadcastTChan