Added better error handling
This commit is contained in:
parent
e054e51cf8
commit
8a83053dee
@ -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)) ->
|
||||
|
@ -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
|
||||
|
@ -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 }
|
||||
|
Loading…
Reference in New Issue
Block a user