blob: 21955250ac5d8eda0b5dbeaa854d87e9a9407723 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
module Hsbot.Core
( connectServer
, disconnectServer
) where
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)
import Hsbot.IRCParser
import Hsbot.Plugin
import Hsbot.Types
import Hsbot.Utils
-- Connect to the server and return the initial bot state
connectServer :: IrcServer -> IO Bot
connectServer server = do
let name = serverAddress server
starttime <- getClockTime
putStr $ "Connecting to " ++ name ++ "... "
handle <- connectTo name $ serverPort server
hSetBuffering handle NoBuffering
putStrLn "done."
putStr "Opening server communication channel... "
chan <- newChan :: IO (Chan BotMsg)
myFatherThreadId <- myThreadId
threadId <- forkIO $ botReader handle chan myFatherThreadId
putStrLn "done."
return $ Bot server starttime handle [] M.empty chan threadId M.empty
-- | Disconnect from the server
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
liftIO $ putStrLn "done."
-- | Socket reading loop
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
trace $ inColor ("<-- " ++ (show msg')) [33]
writeChan chan (InputMsg msg')
_ -> do
return ()
where
handleIOException :: IOException -> IO (String)
handleIOException ioException = do
throwTo fatherThreadId ioException
myId <- myThreadId
killThread myId
return ""
|
