diff options
Diffstat (limited to '')
-rw-r--r-- | Hsbot/Core.hs | 29 | ||||
-rw-r--r-- | Hsbot/Main.hs | 1 |
2 files changed, 23 insertions, 7 deletions
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs index e3ce3eb..2195525 100644 --- a/Hsbot/Core.hs +++ b/Hsbot/Core.hs @@ -5,10 +5,12 @@ module Hsbot.Core import Control.Concurrent import Control.Concurrent.Chan() +import Control.Exception import Control.Monad.State import Data.List() import qualified Data.Map as M import Network +import Prelude hiding (catch) import System.IO import System.Time (getClockTime) @@ -26,9 +28,10 @@ connectServer server = do handle <- connectTo name $ serverPort server hSetBuffering handle NoBuffering putStrLn "done." - putStr $ "Opening server communication channel... " + putStr "Opening server communication channel... " chan <- newChan :: IO (Chan BotMsg) - threadId <- forkIO $ botReader handle chan + myFatherThreadId <- myThreadId + threadId <- forkIO $ botReader handle chan myFatherThreadId putStrLn "done." return $ Bot server starttime handle [] M.empty chan threadId M.empty @@ -36,16 +39,21 @@ connectServer server = do disconnectServer :: IrcBot () disconnectServer = do bot <- get + let name = serverAddress $ serverConfig bot + liftIO $ putStr "Shutting down plugins..." mapM_ unloadPlugin (M.keys $ botPlugins bot) + liftIO $ putStrLn"done." + liftIO $ putStr "Closing server communication channel... " liftIO $ killThread $ readerThreadId bot + liftIO $ putStrLn "done." + liftIO $ putStr $ "Disconnecting from " ++ name ++ "... " liftIO $ hClose $ botHandle bot - return () + liftIO $ putStrLn "done." -- | Socket reading loop -botReader :: Handle -> Chan BotMsg -> IO () -botReader handle chan = forever $ do - -- TODO : detect end of connection! - str <- hGetLine handle +botReader :: Handle -> Chan BotMsg -> ThreadId -> IO () +botReader handle chan fatherThreadId = forever $ do + str <- (hGetLine handle) `catch` handleIOException let msg = parseIrcMsg str case msg of Right msg' -> do @@ -53,4 +61,11 @@ botReader handle chan = forever $ do writeChan chan (InputMsg msg') _ -> do return () + where + handleIOException :: IOException -> IO (String) + handleIOException ioException = do + throwTo fatherThreadId ioException + myId <- myThreadId + killThread myId + return "" diff --git a/Hsbot/Main.hs b/Hsbot/Main.hs index 82b643f..767722b 100644 --- a/Hsbot/Main.hs +++ b/Hsbot/Main.hs @@ -28,6 +28,7 @@ imain = do run :: IrcBot () run = do initServer + liftIO $ putStrLn "Starting plugins..." loadPlugin "Ping" mainPing loadPlugin "Core" mainCore loadPlugin "Quote" mainQuote |