From 7aea1a9fe829804ecddb4f65a55d5e4a8f55ec31 Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Sun, 5 Oct 2014 14:48:47 +0530 Subject: [PATCH] Fix for read only message channel in main loop --- hask-irc-core/Network/IRC/Bot.hs | 9 ++++----- hask-irc-core/Network/IRC/Client.hs | 15 ++++++--------- hask-irc-core/Network/IRC/Message/Types.hs | 4 ++-- 3 files changed, 12 insertions(+), 16 deletions(-) diff --git a/hask-irc-core/Network/IRC/Bot.hs b/hask-irc-core/Network/IRC/Bot.hs index 99f78ba..fe48a00 100644 --- a/hask-irc-core/Network/IRC/Bot.hs +++ b/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 diff --git a/hask-irc-core/Network/IRC/Client.hs b/hask-irc-core/Network/IRC/Client.hs index ad60de6..b5143cb 100644 --- a/hask-irc-core/Network/IRC/Client.hs +++ b/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 diff --git a/hask-irc-core/Network/IRC/Message/Types.hs b/hask-irc-core/Network/IRC/Message/Types.hs index 1eb8b09..f570746 100644 --- a/hask-irc-core/Network/IRC/Message/Types.hs +++ b/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.