Added retrying with new nick if nick is already taken. Other minor fixes.

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

@@ -54,7 +54,7 @@ readMessageLoop = go []
       case botStatus of
         Disconnected -> closeMessageChannel inChan
         _            -> do
-          mLine     <- try $ timeout timeoutDelay readLine'
+          mLine     <- try $ timeout timeoutDelay readLine
           msgParts' <- case mLine of
             Left (e :: SomeException)     -> do
               errorM $ "Error while reading from connection: " ++ show e
@@ -67,12 +67,12 @@ readMessageLoop = go []
             Right (Just EOS)              -> sendMessage inChan EOD >> return msgParts
 
           limit <- map (addUTCTime (- msgPartTimeout)) getCurrentTime
-          let msgParts'' = concat
+          let validMsgParts = concat
                              . filter ((> limit) . msgPartTime . headEx . sortBy (flip $ comparing msgPartTime))
                              . groupAllOn (msgPartParserId &&& msgPartTarget) $ msgParts'
-          go msgParts'' mvBotStatus inChan bot timeoutDelay
+          go validMsgParts mvBotStatus inChan bot timeoutDelay
       where
-        readLine' = do
+        readLine = do
           eof <- hIsEOF botSocket
           if eof
             then return EOS
@@ -98,14 +98,15 @@ messageProcessLoop = go 0
             when (status == Kicked) $
               threadDelay (5 * oneSec) >> newMessage JoinCmd >>= sendMessage messageChan
 
-            mIn <- receiveMessage inChan
+            mIn <- receiveMessageEither inChan messageChan
             case mIn of
-              Timeout -> newMessage IdleMsg >>= sendMessage messageChan >> return Idle
-              EOD     -> infoM "Connection closed" >> return Disconnected
-              Msg (msg@Message { .. }) -> do
+              Left Timeout -> newMessage IdleMsg >>= sendMessage messageChan >> return Idle
+              Left EOD     -> infoM "Connection closed" >> return Disconnected
+              Left (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

@@ -116,14 +116,18 @@ runBotIntenal botConfig' = withSocketsDo $ do
     Disconnected     -> debugM "Restarting .."   >> runBotIntenal botConfigWithCore
     Errored          -> debugM "Restarting .."   >> runBotIntenal botConfigWithCore
     Interrupted      -> return ()
-    NickNotAvailable -> return ()
+    NickNotAvailable -> debugM "Trying new nick" >> runBotIntenal botConfigWithNewNick
     _                -> error "Unsupported status"
   where
     botConfigWithCore = botConfig' {
       msgHandlerInfo =
         foldl' (\m name -> insertMap name mempty m) mempty
-          (hashNub $ mapKeys (msgHandlerInfo botConfig') ++ mapKeys coreMsgHandlerMakers),
-      msgHandlerMakers = coreMsgHandlerMakers <> msgHandlerMakers botConfig'
+          (hashNub $ mapKeys (msgHandlerInfo botConfig') ++ mapKeys coreMsgHandlerMakers)
+    , msgHandlerMakers = coreMsgHandlerMakers <> msgHandlerMakers botConfig'
+    }
+
+    botConfigWithNewNick = botConfigWithCore {
+      botNick = Nick $ nickToText (botNick botConfigWithCore) ++ "_"
     }
 
     handleErrors :: SomeException -> IO BotStatus

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

@@ -10,6 +10,7 @@ module Network.IRC.MessageBus
   , newMessageChannel
   , sendMessage
   , receiveMessage
+  , receiveMessageEither
   , closeMessageChannel
   , awaitMessageChannel ) where
 
@@ -56,3 +57,7 @@ closeMessageChannel (MessageChannel latch _ _) = doLatch latch
 
 awaitMessageChannel :: MessageChannel a -> IO ()
 awaitMessageChannel (MessageChannel latch _ _) = awaitLatch latch
+
+receiveMessageEither :: MessageChannel a -> MessageChannel b -> IO (Either a b)
+receiveMessageEither chan1 chan2 = atomically $
+  map Left (receiveMessageSTM chan1) `orElseSTM` map Right (receiveMessageSTM chan2)

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

@@ -102,15 +102,14 @@ defaultCommandFormatter BotConfig { .. } Message { .. }
   | Just (PongCmd msg) <- fromMessage message = Just $ "PONG :" ++ msg
   | Just (PingCmd msg) <- fromMessage message = Just $ "PING :" ++ msg
   | Just NickCmd       <- fromMessage message = Just $ "NICK " ++ botNick'
-  | Just UserCmd                          <- fromMessage message =
-      Just $ "USER " ++ botNick' ++ " 0 * :" ++ botNick'
+  | Just UserCmd       <- fromMessage message = Just $ "USER " ++ botNick' ++ " 0 * :" ++ botNick'
   | Just JoinCmd       <- fromMessage message = Just $ "JOIN " ++ botChannel
   | Just QuitCmd       <- fromMessage message = Just "QUIT"
+  | Just NamesCmd      <- fromMessage message = Just $ "NAMES " ++ botChannel
   | Just (ChannelMsgReply msg) <- fromMessage message            =
       Just $ "PRIVMSG " ++ botChannel ++ " :" ++ msg
   | Just (PrivMsgReply (User { .. }) msg) <- fromMessage message =
       Just $ "PRIVMSG " ++ nickToText userNick ++ " :" ++ msg
-  | Just NamesCmd                         <- fromMessage message = Just $ "NAMES " ++ botChannel
   | otherwise                                                    = Nothing
   where
     botNick' = nickToText botNick