From 8c2f85be94ed769412eee39445ac2b734e5c6eb5 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 26 Nov 2017 13:59:59 +0100 Subject: [PATCH] preparing some classes --- affection.cabal | 2 ++ src/Affection.hs | 1 + src/Affection/MessageBus.hs | 22 ++++++++++++++++++++-- 3 files changed, 23 insertions(+), 2 deletions(-) diff --git a/affection.cabal b/affection.cabal index 698a187..84e6563 100644 --- a/affection.cabal +++ b/affection.cabal @@ -45,6 +45,7 @@ library -- , Affection.Actor -- , Affection.Animation , Affection.Util + , Affection.MessageBus default-extensions: OverloadedStrings -- Modules included in this library but not exported. @@ -73,6 +74,7 @@ library , glib , bytestring , OpenGL + , stm -- , sdl2-image -- executable example00 diff --git a/src/Affection.hs b/src/Affection.hs index 60191d3..5c22a32 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -41,6 +41,7 @@ import Affection.MouseInteractable as A -- import Affection.Actor as A -- import Affection.Animation as A import Affection.Util as A +import Affection.MessageBus as A import Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..)) diff --git a/src/Affection/MessageBus.hs b/src/Affection/MessageBus.hs index 1966643..2fcbaf8 100644 --- a/src/Affection/MessageBus.hs +++ b/src/Affection/MessageBus.hs @@ -1,4 +1,22 @@ module Affection.MessageBus where -class MessageBus a where - +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