Fix for read only message channel in main loop

master
Abhinav Sarkar 8 years ago
parent f99815b3b0
commit 7aea1a9fe8
  1. 9
      hask-irc-core/Network/IRC/Bot.hs
  2. 15
      hask-irc-core/Network/IRC/Client.hs
  3. 4
      hask-irc-core/Network/IRC/Message/Types.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

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

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

Loading…
Cancel
Save