it compiles now. messagebus will have multiple channels

src/Affection/MessageBus/Class.hs

@@ -5,11 +5,11 @@ module Affection.MessageBus.Class where
 import Affection.MessageBus.Message
 import Affection.Types
 
-class (Message msg) => Participant prt msg where
-  partChannel        :: prt -> Channel msg
+class Participant prt m where
+  partChannel        :: prt -> Channel m
 
-  partInit           :: Affection sd msg prt
+  partInit           :: Affection sd m prt
 
-  partListen         :: prt -> IO (Maybe msg)
+  partListen         :: prt -> IO (Maybe m)
 
-  partEmit           :: prt -> msg -> IO ()
+  partEmit           :: prt -> m -> IO ()

src/Affection/MessageBus/Message.hs

@@ -11,12 +11,12 @@ import Linear (V2(..))
 class Message msg where
   msgTime :: msg -> Word32
 
-data SystemMessage m
-  = MsgUserMessage
-    { msgUMWhen :: Word32
-    , msgUMPayload :: m
-    }  -- ^ Generic user defined message with custom payload
-  | MsgEngineReady Word32
+data SystemMessage
+  -- = MsgUserMessage
+  --   { msgUMWhen :: Word32
+  --   , msgUMPayload :: m
+  --   }  -- ^ Generic user defined message with custom payload
+  = MsgEngineReady Word32
   | MsgWindowShown
     { msgWSWhen :: Word32
     , msgWSWindow :: SDL.Window
@@ -76,8 +76,8 @@ data SystemMessage m
     , msgWCWindow :: SDL.Window
     }
 
-instance Message (SystemMessage m) where
-  msgTime (MsgUserMessage t _) = t
+instance Message SystemMessage where
+  -- msgTime (MsgUserMessage t _) = t
   msgTime (MsgEngineReady t)   = t
   msgTime (MsgWindowShown t _) = t
   msgTime (MsgWindowHidden t _) = t

src/Affection/Subsystems/AffectionWindow.hs

@@ -7,21 +7,21 @@ import Affection.MessageBus
 import Affection.Subsystems.Class
 import Affection.Types
 
-import Control.Monad.State.Class (get)
+import Control.Monad.State.Class (gets)
 import Control.Monad.IO.Class (liftIO)
 
 import qualified SDL
 
-data AffectionWindow msg = AffectionWindow
-  { windowChannel :: Channel msg
+data AffectionWindow m = AffectionWindow
+  { windowChannel :: Channel m
   }
 
-instance Participant (AffectionWindow (SystemMessage m)) (SystemMessage m) where
+instance (Message m) => Participant (AffectionWindow m) m where
   partChannel = windowChannel
 
   partInit = do
-    ad <- get
-    nchan <- liftIO $ dupChannel $ messageChannel ad
+    chan <- gets messageChannel :: Affection sd m (Channel m)
+    nchan <- liftIO $ dupChannel $ chan
     return $ AffectionWindow
       { windowChannel = nchan
       }
@@ -31,11 +31,11 @@ instance Participant (AffectionWindow (SystemMessage m)) (SystemMessage m) where
     mmsg <- tryPeekChannel chan
     return mmsg
 
-  partEmit p m = do
+  partEmit p message = do
     let chan = partChannel p
-    writeChannel chan m
+    writeChannel chan message
 
-instance Subsystem (AffectionWindow (SystemMessage m)) (SystemMessage m) where
+instance Subsystem (AffectionWindow SystemMessage) SystemMessage where
   consumeEvents aw evs = doConsume evs
     where
       doConsume (e:es) = case SDL.eventPayload e of