diff --git a/Network/IRC/Client.hs b/Network/IRC/Client.hs index 98595a7..d3dab70 100644 --- a/Network/IRC/Client.hs +++ b/Network/IRC/Client.hs @@ -9,6 +9,7 @@ import qualified Data.Text.Format as TF import qualified Data.Text.Format.Params as TF import ClassyPrelude +import Control.Exception.Lifted import Control.Concurrent.Lifted import Control.Monad.Reader hiding (forM_, foldM) import Control.Monad.State hiding (forM_, foldM) @@ -74,6 +75,7 @@ readLineLoop mvBotStatus (lineChan, latch) bot@Bot { .. } timeoutDelay = do then return EOF else do line <- map initEx $ hGetLine socket + debug $ "< " ++ line now <- getCurrentTime return . Line $ msgFromLine botConfig now line @@ -101,7 +103,6 @@ listenerLoop lineChan commandChan idleFor = do Timeout -> dispatchHandlers bot IdleMsg >> return Idle EOF -> return Disconnected Line message -> do - debug $ "< " ++ msgLine message nStatus <- case message of JoinMsg { .. } | userNick user == nick -> debug "Joined" >> return Joined KickMsg { .. } | kickedNick == nick -> debug "Kicked" >> return Kicked @@ -190,15 +191,16 @@ run botConfig' = withSocketsDo $ do status <- run_ case status of Disconnected -> debug "Connection timed out" >> run botConfig - Errored -> return () + Interrupted -> return () + Errored -> debug "Errored, restarting" >> run botConfig _ -> error "Unsupported status" where botConfig = addCoreMsgHandlers botConfig' handleErrors :: SomeException -> IO BotStatus - handleErrors e = do - debug $ "Exception! " ++ pack (show e) - return Errored + handleErrors e = case fromException e of + Just UserInterrupt -> debug "User interrupt" >> return Interrupted + _ -> debug ("Exception! " ++ pack (show e)) >> return Errored run_ = bracket (connect botConfig) disconnect $ \(bot, mvBotStatus, (lineChan, readLatch), (commandChan, sendLatch)) -> diff --git a/Network/IRC/Protocol.hs b/Network/IRC/Protocol.hs index db5dd48..ee1ee6d 100644 --- a/Network/IRC/Protocol.hs +++ b/Network/IRC/Protocol.hs @@ -37,7 +37,7 @@ msgFromLine (BotConfig { .. }) time line command = splits !! 1 message = drop 1 . unwords . drop 3 $ splits quitMessage = drop 1 . unwords . drop 2 $ splits - user = let u = split (== '!') source in User (u !! 0) (u !! 1) + user = uncurry User . break (== '!') $ source mode = splits !! 3 modeArgs = drop 4 splits kicked = splits !! 3 diff --git a/Network/IRC/Types.hs b/Network/IRC/Types.hs index d731cac..b42582e 100644 --- a/Network/IRC/Types.hs +++ b/Network/IRC/Types.hs @@ -73,7 +73,7 @@ data Bot = Bot { botConfig :: !BotConfig , socket :: !Handle , msgHandlers :: !(Map MsgHandlerName MsgHandler) } -data BotStatus = Connected | Disconnected | Joined | Kicked | Errored | Idle +data BotStatus = Connected | Disconnected | Joined | Kicked | Errored | Idle | Interrupted deriving (Show, Eq) newtype IRC a = IRC { _runIRC :: StateT BotStatus (ReaderT Bot IO) a }