defining mesage bus further

affection.cabal

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

src/Affection/MessageBus/Class.hs

@@ -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
+class (Message msg) => Participant prt msg where
-  partChannel        :: (Message msg) => prt -> IORef (Channel msg)
+  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 ()

src/Affection/MessageBus/Message.hs

@@ -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

src/Affection/MessageBus/Util.hs

@@ -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