Fix for read only message channel in main loop

hask-irc-core/Network/IRC/Bot.hs

@@ -98,15 +98,14 @@ messageProcessLoop = go 0
             when (status == Kicked) $
               threadDelay (5 * oneSec) >> newMessage JoinCmd >>= sendMessage messageChan
 
-            mIn <- receiveMessageEither inChan messageChan
+            mIn <- receiveMessage inChan
             case mIn of
-              Left Timeout -> newMessage IdleMsg >>= sendMessage messageChan >> return Idle
-              Left EOD     -> infoM "Connection closed" >> return Disconnected
-              Left (Msg (msg@Message { .. })) -> do
+              Timeout -> newMessage IdleMsg >>= sendMessage messageChan >> return Idle
+              EOD     -> infoM "Connection closed" >> return Disconnected
+              Msg (msg@Message { .. }) -> do
                 nStatus <- handleMsg nick message mpass
                 sendMessage messageChan msg
                 return nStatus
-              Right _      -> return status
 
       put nStatus
       case nStatus of

hask-irc-core/Network/IRC/Client.hs

@@ -41,7 +41,6 @@ data ConnectionResource = ConnectionResource
   , botStatus          :: MVar BotStatus
   , inChannel          :: MessageChannel In
   , mainMsgChannel     :: MessageChannel Message
-  , cmdMsgChannel      :: MessageChannel Message
   , handlerMsgChannels :: [MessageChannel Message]
   }
 
@@ -58,7 +57,6 @@ connect botConfig@BotConfig { .. } = do
 
   inChannel        <- newMessageChannel inBus
   mainMsgChannel   <- newMessageChannel messageBus
-  cmdMsgChannel    <- newMessageChannel messageBus
 
   msgHandlersChans <- loadMsgHandlers messageBus
   msgHandlerInfo'  <- foldM (\m (hn, (h, _)) -> getHelp h botConfig >>= \hm -> return $ insertMap hn hm m)
@@ -69,8 +67,7 @@ connect botConfig@BotConfig { .. } = do
   let msgHandlers        = map fst msgHandlersChans
 
   return $ ConnectionResource
-            (Bot botConfig' socket msgHandlers) mvBotStatus
-            inChannel mainMsgChannel cmdMsgChannel msgHandlerChannels
+            (Bot botConfig' socket msgHandlers) mvBotStatus inChannel mainMsgChannel msgHandlerChannels
   where
     connectToWithRetry = connectTo (unpack botServer) (PortNumber (fromIntegral botPort))
                            `catch` (\(e :: SomeException) -> do
@@ -99,8 +96,8 @@ connect botConfig@BotConfig { .. } = do
 disconnect :: ConnectionResource -> IO ()
 disconnect ConnectionResource { bot = Bot { .. }, .. } = do
   debugM "Disconnecting ..."
-  sendMessage cmdMsgChannel =<< newMessage QuitCmd
-  awaitMessageChannel cmdMsgChannel
+  sendMessage mainMsgChannel =<< newMessage QuitCmd
+  awaitMessageChannel mainMsgChannel
 
   swapMVar botStatus Disconnected
   awaitMessageChannel inChannel
@@ -154,10 +151,10 @@ runBotIntenal botConfig' = withSocketsDo $ do
           let Bot { .. } = bot
           debugM $ "Running with config:\n" ++ show botConfig
 
-          sendMessage cmdMsgChannel =<< newMessage NickCmd
-          sendMessage cmdMsgChannel =<< newMessage UserCmd
+          sendMessage mainMsgChannel =<< newMessage NickCmd
+          sendMessage mainMsgChannel =<< newMessage UserCmd
 
-          fork $ sendCommandLoop cmdMsgChannel bot
+          fork $ sendCommandLoop mainMsgChannel bot
           fork $ readMessageLoop botStatus inChannel bot oneSec
           forM_ (zip (mapToList msgHandlers) handlerMsgChannels) $
             void . fork . runHandler botConfig

hask-irc-core/Network/IRC/Message/Types.hs

@@ -28,7 +28,7 @@ data User
   = Self
   -- | An user other than the bot.
   | User
-  { userNick   :: !Nick         -- ^ The user's nick.
+  { userNick   :: !Nick       -- ^ The user's nick.
   , userServer :: !Text       -- ^ The user's server.
   } deriving (Show, Eq, Ord)
 
@@ -36,7 +36,7 @@ data User
 data Message = Message
   { msgTime :: !UTCTime  -- ^ The time when the message was received.
   , msgLine :: !Text     -- ^ The raw message line.
-  , message :: MessageW   -- ^ The details of the parsed message.
+  , message :: MessageW  -- ^ The details of the parsed message.
   } deriving (Show, Eq)
 
 -- | The typeclass for different types of IRC messages.