adyxax/hsbot
Archived
1
0
Fork 0
Code Issues Activity

Cleaned further the bot updates handling.

Browse source
This commit is contained in:
Julien Dessaux 2010-05-28 22:39:45 +02:00
parent 451564ef5b
commit c506c58e92
5 changed files with 53 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
Hsbot/Core.hs
View file

@ -22,46 +22,48 @@ hsbot config = do
startTime <- getCurrentTime
putStrLn "[Hsbot] Opening communication channel... "
chan <- newChan :: IO (Chan BotMsg)
mvar <- newMVar "" :: IO (MVar String)
mvar <- newMVar M.empty :: IO (MVar BotResumeData)
putStrLn "[Hsbot] Spawning IrcBot plugins... "
botState <- execStateT spawnIrcPlugins BotState { botStartTime = startTime
, botPlugins = M.empty
, botChan = chan
, botConfig = config
, botMVar = mvar
, botResumeData = M.empty }
, botResumeData = mvar }
putStrLn "[Hsbot] Entering main loop... "
(reboot, botState') <- (runStateT botLoop botState) `catch` (\(_ :: IOException) -> return (False, botState))
(status, botState') <- runLoop botState
resumeData <- takeMVar mvar
if reboot
if status == BotReboot
then resumeHsbot botState' resumeData
else return ()
where
runLoop :: BotState -> IO (BotStatus, BotState)
runLoop botState = do
(status, botState') <- (runStateT botCore botState) `catch` (\(_ :: IOException) -> return (BotExit, botState))
case status of
BotContinue -> runLoop botState'
_ -> return (status, botState')
resumeHsbot :: BotState -> String -> IO ()
resumeHsbot :: BotState -> BotResumeData -> IO ()
resumeHsbot botState resumeData = do
print resumeData
-- | Run the bot main loop
botLoop :: Bot (Bool)
botLoop = do
botCore :: Bot (BotStatus)
botCore = do
chan <- gets botChan
msg <- liftIO $ readChan chan
case msg of
InMsg _ -> botLoop
OutMsg _ -> botLoop
IntMsg intMsg -> do
reboot <- processInternalMessage $ IntMsg intMsg
reportUpdate
if not reboot
then botLoop
else return (True)
InMsg _ -> return BotContinue
OutMsg _ -> return BotContinue
IntMsg intMsg -> processInternalMessage $ IntMsg intMsg
UpdMsg updMsg -> processUpdateMessage updMsg
-- | Reports an update to the master bot
reportUpdate :: Bot ()
reportUpdate = do
bot <- get
let mvar = botMVar bot
stuff = show $ botResumeData bot
_ <- liftIO $ swapMVar mvar stuff
return ()
-- | Process an update command
processUpdateMessage :: ResumeMsg -> Bot (BotStatus)
processUpdateMessage msg = do
resumeData <- gets botResumeData
let from = resMsgFrom msg
stuff = resMsgData msg
liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.insert from stuff oldData)
return BotContinue

7
Hsbot/Irc/Core.hs
View file

@ -145,11 +145,8 @@ reportUpdate :: IrcBot ()
reportUpdate = do
ircbot <- get
let masterChan = ircBotMasterChan ircbot
msg = IntMsg $ Msg { msgType = "UPDATE"
, msgFrom = ircConfigName $ ircBotConfig ircbot
, msgTo = "CORE"
, msgStuff = show $ ircBotResumeData ircbot
}
msg = UpdMsg $ ResMsg { resMsgFrom = ircConfigName $ ircBotConfig ircbot
, resMsgData = ircBotResumeData ircbot }
liftIO $ writeChan masterChan msg
-- | Process a reboot command

2
Hsbot/Irc/Types.hs
View file

@ -32,7 +32,7 @@ data IrcBotState = IrcBotState
, ircBotConfig :: IrcConfig -- The starting configuration
, ircBotReaderThreadId :: ThreadId -- the thread that process inputs from the socket
, ircBotMasterReaderThreadId :: ThreadId -- the thread that process inputs from the master bot
, ircBotResumeData :: M.Map String String -- the necessary data to resume the bot's operations on reboot
, ircBotResumeData :: ResumeData -- the necessary data to resume the bot's operations on reboot
}
-- | The IrcServer monad

22
Hsbot/Message.hs
View file

@ -9,7 +9,7 @@ import Hsbot.PluginUtils
import Hsbot.Types
-- | Processes an internal message
processInternalMessage :: BotMsg -> Bot (Bool)
processInternalMessage :: BotMsg -> Bot (BotStatus)
processInternalMessage (IntMsg msg)
| msgTo msg == "CORE" = processCoreMessage msg
| otherwise = do
@ -17,22 +17,12 @@ processInternalMessage (IntMsg msg)
case M.lookup (msgTo msg) plugins of
Just (plugin, _) -> sendToPlugin (IntMsg msg) plugin
Nothing -> return ()
return False
processInternalMessage _ = return (False)
return BotContinue
processInternalMessage _ = return BotContinue
processCoreMessage :: Msg -> Bot (Bool)
processCoreMessage :: Msg -> Bot (BotStatus)
processCoreMessage msg = do
case msgType msg of
"UPDATE" -> processUpdateCommand msg
_ -> return ()
return $ (msgType msg) == "REBOOT"
-- | Process an update command
processUpdateCommand :: Msg -> Bot ()
processUpdateCommand msg = do
bot <- get
let oldData = botResumeData bot
from = msgFrom msg
stuff = msgStuff msg
put $ bot { botResumeData = M.insert from stuff oldData }
"REBOOT" -> return BotReboot
_ -> return BotContinue

21
Hsbot/Types.hs
View file

@ -1,10 +1,14 @@
module Hsbot.Types
( Bot
, BotMsg (..)
, BotResumeData
, BotState (..)
, BotStatus (..)
, Msg (..)
, Plugin
, PluginState (..)
, ResumeData
, ResumeMsg (..)
) where
import Control.Concurrent
@ -24,10 +28,16 @@ data BotState = BotState
, botPlugins :: M.Map String (PluginState, ThreadId) -- Loaded plugins
, botChan :: Chan BotMsg -- the bot's communication channel
, botConfig :: Config -- the bot's starting config
, botMVar :: MVar String -- the place where to put resume data
, botResumeData :: M.Map String String -- the necessary data to resume the bot's operations on reboot
, botResumeData :: MVar BotResumeData -- the necessary data to resume the bot's operations on reboot
}
-- | how we exit from the botLoop
data BotStatus = BotExit | BotReboot | BotContinue deriving (Eq)
-- | Types to factorise resume data
type ResumeData = M.Map String String
type BotResumeData = M.Map String ResumeData
-- | The Plugin monad
type Plugin = StateT PluginState IO
@ -46,5 +56,10 @@ data Msg = Msg
, msgStuff :: String -- the message to be transfered
} deriving (Show)
data BotMsg = InMsg Msg | OutMsg Msg | IntMsg Msg deriving (Show)
data ResumeMsg = ResMsg
{ resMsgFrom :: String
, resMsgData :: ResumeData
} deriving (Show)
data BotMsg = InMsg Msg | OutMsg Msg | IntMsg Msg | UpdMsg ResumeMsg deriving (Show)