Added server states, in order to handle rebooting more cleanly (still missing saving the chan)
This commit is contained in:
parent
7a86235906
commit
65646eb07f
2 changed files with 25 additions and 7 deletions
|
@ -2,8 +2,10 @@ module Hsbot.Core
|
||||||
( Bot(..)
|
( Bot(..)
|
||||||
, Config(..)
|
, Config(..)
|
||||||
, IrcServer(..)
|
, IrcServer(..)
|
||||||
|
, isConnected
|
||||||
, newbot
|
, newbot
|
||||||
, sendstr
|
, sendstr
|
||||||
|
, saveServersStates
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
@ -30,7 +32,7 @@ data IrcServer = IrcServer
|
||||||
, password :: String -- the hsbot's password, optional
|
, password :: String -- the hsbot's password, optional
|
||||||
, realname :: String -- the hsbot's real name, optional
|
, realname :: String -- the hsbot's real name, optional
|
||||||
, administrators :: [String] -- bot admins nicknames
|
, administrators :: [String] -- bot admins nicknames
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
-- | Returns a new, empty bot
|
-- | Returns a new, empty bot
|
||||||
newbot :: Bot
|
newbot :: Bot
|
||||||
|
@ -40,3 +42,15 @@ newbot = Bot (M.empty)
|
||||||
sendstr :: Handle -> String -> IO ()
|
sendstr :: Handle -> String -> IO ()
|
||||||
sendstr handle str = hPrintf handle "%s\r\n" str
|
sendstr handle str = hPrintf handle "%s\r\n" str
|
||||||
|
|
||||||
|
-- | Are we already connected to this server?
|
||||||
|
isConnected :: Bot -> IrcServer -> Bool
|
||||||
|
isConnected (Bot bot) ircServer = ircServer `M.member` bot
|
||||||
|
|
||||||
|
saveServerState :: Handle -> IrcServer -> Bot -> Bot
|
||||||
|
saveServerState handle ircServer x@(Bot bot) =
|
||||||
|
if ircServer `M.member` bot then x
|
||||||
|
else (Bot $ M.insert ircServer handle bot)
|
||||||
|
|
||||||
|
saveServersStates :: [(IrcServer,Handle)] -> Bot -> Bot
|
||||||
|
saveServersStates liste bot = foldr (\(ircServer,handle) bot' -> saveServerState handle ircServer bot') bot liste
|
||||||
|
|
||||||
|
|
|
@ -6,6 +6,7 @@ module Hsbot.Main
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Concurrent.Chan
|
import Control.Concurrent.Chan
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import qualified Data.Map as M
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Plugins
|
import System.Plugins
|
||||||
|
|
||||||
|
@ -22,16 +23,19 @@ imain modul' reboot = imain' modul' reboot newbot
|
||||||
-- | Bot's main entry point
|
-- | Bot's main entry point
|
||||||
imain' :: Module -> Reboot -> Bot -> IO ()
|
imain' :: Module -> Reboot -> Bot -> IO ()
|
||||||
imain' modul' reboot bot = do
|
imain' modul' reboot bot = do
|
||||||
putStrLn "yeah"
|
-- The chan passing to reboot (or another way to keep it) is still missing
|
||||||
putStrLn "Connecting servers..."
|
putStrLn "Connecting servers..."
|
||||||
servers' <- mapM connectServer (ircServers C.config)
|
let newServers = filter (not . isConnected bot) (ircServers C.config)
|
||||||
|
newServers' <- mapM connectServer newServers
|
||||||
putStrLn "Joining channels..."
|
putStrLn "Joining channels..."
|
||||||
mapM_ initServer servers'
|
mapM_ initServer newServers'
|
||||||
putStrLn "Spawning threads..."
|
putStrLn "Spawning threads..."
|
||||||
|
let bot' = saveServersStates newServers' bot
|
||||||
|
Bot x = bot'
|
||||||
chan <- newChan :: IO (Chan IrcLine)
|
chan <- newChan :: IO (Chan IrcLine)
|
||||||
mapM_ (forkIO . listener chan) servers'
|
mapM_ (forkIO . listener chan) (M.toList x)
|
||||||
state <- monitor chan bot
|
bot'' <- monitor chan bot'
|
||||||
reboot modul' bot
|
reboot modul' bot''
|
||||||
|
|
||||||
-- | Bot main loop, monitors the threads states and handle reboot
|
-- | Bot main loop, monitors the threads states and handle reboot
|
||||||
monitor :: (Chan IrcLine) -> Bot -> IO Bot
|
monitor :: (Chan IrcLine) -> Bot -> IO Bot
|
||||||
|
|
Reference in a new issue