summaryrefslogtreecommitdiff
path: root/Hsbot/Core.hs
blob: b0efc03e8db3cc93df6e54b25dac460b8dddacda (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
module Hsbot.Core
    ( connectServer
    , disconnectServer
    ) where

import Control.Concurrent
import Control.Concurrent.Chan
import Control.Monad.State
import Data.List
import Network
import System.IO
import System.Time (getClockTime)

import Hsbot.IRCParser
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  = address server
    starttime <- getClockTime
    putStr $ "Connecting to " ++ name ++ "... "
    handle <- connectTo name $ port server
    hSetBuffering handle NoBuffering
    putStrLn "done."
    putStr $ "Opening server communication channel... "
    chan <- newChan :: IO (Chan BotMsg)
    threadId <- forkIO $ botReader handle chan
    putStrLn "done."
    return (Bot server starttime handle [] [] chan threadId)

-- | Disconnect from the server
disconnectServer :: Bot -> IO ()    -- IO Bot ?
disconnectServer bot = do
    killThread $ readerThreadId bot
    mapM_ (killThread . pluginThreadId) (botPlugins bot)
    hClose $ botHandle bot
    return ()

-- | Socket reading loop
botReader :: Handle -> Chan BotMsg -> IO ()
botReader handle chan = forever $ do
    -- TODO : detect end of connection!
    str <- hGetLine handle
    let msg = parseIrcMsg str
    case msg of
        Right msg' -> do
            trace $ inColor ("<-- " ++ (show msg')) [33]
            writeChan chan (InputMsg msg')
        _ -> do
            return ()