Added better error handling
parent
e054e51cf8
commit
8a83053dee
|
@ -9,6 +9,7 @@ import qualified Data.Text.Format as TF
|
||||||
import qualified Data.Text.Format.Params as TF
|
import qualified Data.Text.Format.Params as TF
|
||||||
|
|
||||||
import ClassyPrelude
|
import ClassyPrelude
|
||||||
|
import Control.Exception.Lifted
|
||||||
import Control.Concurrent.Lifted
|
import Control.Concurrent.Lifted
|
||||||
import Control.Monad.Reader hiding (forM_, foldM)
|
import Control.Monad.Reader hiding (forM_, foldM)
|
||||||
import Control.Monad.State 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
|
then return EOF
|
||||||
else do
|
else do
|
||||||
line <- map initEx $ hGetLine socket
|
line <- map initEx $ hGetLine socket
|
||||||
|
debug $ "< " ++ line
|
||||||
now <- getCurrentTime
|
now <- getCurrentTime
|
||||||
return . Line $ msgFromLine botConfig now line
|
return . Line $ msgFromLine botConfig now line
|
||||||
|
|
||||||
|
@ -101,7 +103,6 @@ listenerLoop lineChan commandChan idleFor = do
|
||||||
Timeout -> dispatchHandlers bot IdleMsg >> return Idle
|
Timeout -> dispatchHandlers bot IdleMsg >> return Idle
|
||||||
EOF -> return Disconnected
|
EOF -> return Disconnected
|
||||||
Line message -> do
|
Line message -> do
|
||||||
debug $ "< " ++ msgLine message
|
|
||||||
nStatus <- case message of
|
nStatus <- case message of
|
||||||
JoinMsg { .. } | userNick user == nick -> debug "Joined" >> return Joined
|
JoinMsg { .. } | userNick user == nick -> debug "Joined" >> return Joined
|
||||||
KickMsg { .. } | kickedNick == nick -> debug "Kicked" >> return Kicked
|
KickMsg { .. } | kickedNick == nick -> debug "Kicked" >> return Kicked
|
||||||
|
@ -190,15 +191,16 @@ run botConfig' = withSocketsDo $ do
|
||||||
status <- run_
|
status <- run_
|
||||||
case status of
|
case status of
|
||||||
Disconnected -> debug "Connection timed out" >> run botConfig
|
Disconnected -> debug "Connection timed out" >> run botConfig
|
||||||
Errored -> return ()
|
Interrupted -> return ()
|
||||||
|
Errored -> debug "Errored, restarting" >> run botConfig
|
||||||
_ -> error "Unsupported status"
|
_ -> error "Unsupported status"
|
||||||
where
|
where
|
||||||
botConfig = addCoreMsgHandlers botConfig'
|
botConfig = addCoreMsgHandlers botConfig'
|
||||||
|
|
||||||
handleErrors :: SomeException -> IO BotStatus
|
handleErrors :: SomeException -> IO BotStatus
|
||||||
handleErrors e = do
|
handleErrors e = case fromException e of
|
||||||
debug $ "Exception! " ++ pack (show e)
|
Just UserInterrupt -> debug "User interrupt" >> return Interrupted
|
||||||
return Errored
|
_ -> debug ("Exception! " ++ pack (show e)) >> return Errored
|
||||||
|
|
||||||
run_ = bracket (connect botConfig) disconnect $
|
run_ = bracket (connect botConfig) disconnect $
|
||||||
\(bot, mvBotStatus, (lineChan, readLatch), (commandChan, sendLatch)) ->
|
\(bot, mvBotStatus, (lineChan, readLatch), (commandChan, sendLatch)) ->
|
||||||
|
|
|
@ -37,7 +37,7 @@ msgFromLine (BotConfig { .. }) time line
|
||||||
command = splits !! 1
|
command = splits !! 1
|
||||||
message = drop 1 . unwords . drop 3 $ splits
|
message = drop 1 . unwords . drop 3 $ splits
|
||||||
quitMessage = drop 1 . unwords . drop 2 $ 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
|
mode = splits !! 3
|
||||||
modeArgs = drop 4 splits
|
modeArgs = drop 4 splits
|
||||||
kicked = splits !! 3
|
kicked = splits !! 3
|
||||||
|
|
|
@ -73,7 +73,7 @@ data Bot = Bot { botConfig :: !BotConfig
|
||||||
, socket :: !Handle
|
, socket :: !Handle
|
||||||
, msgHandlers :: !(Map MsgHandlerName MsgHandler) }
|
, msgHandlers :: !(Map MsgHandlerName MsgHandler) }
|
||||||
|
|
||||||
data BotStatus = Connected | Disconnected | Joined | Kicked | Errored | Idle
|
data BotStatus = Connected | Disconnected | Joined | Kicked | Errored | Idle | Interrupted
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
newtype IRC a = IRC { _runIRC :: StateT BotStatus (ReaderT Bot IO) a }
|
newtype IRC a = IRC { _runIRC :: StateT BotStatus (ReaderT Bot IO) a }
|
||||||
|
|
Loading…
Reference in New Issue