abhin4v
/
hask-irc
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix for read only message channel in main loop

master
Abhinav Sarkar 2014-10-05 14:48:47 +05:30
parent f99815b3b0
commit 7aea1a9fe8
3 changed files with 12 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
hask-irc-core/Network/IRC/Bot.hs
View File

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

15
hask-irc-core/Network/IRC/Client.hs
View File

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

4
hask-irc-core/Network/IRC/Message/Types.hs
View File

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