Cleaned further the bot updates handling.

Hsbot/Core.hs

@@ -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 = mvar }
-                                                    , botResumeData = M.empty }
     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)
+botCore :: Bot (BotStatus)
-botLoop = do
+botCore = do
     chan <- gets botChan
     msg  <- liftIO $ readChan chan
     case msg of
-        InMsg  _      -> botLoop
+        InMsg  _      -> return BotContinue
-        OutMsg _      -> botLoop
+        OutMsg _      -> return BotContinue
-        IntMsg intMsg -> do
+        IntMsg intMsg -> processInternalMessage $ IntMsg intMsg
-            reboot <- processInternalMessage $ IntMsg intMsg
+        UpdMsg updMsg -> processUpdateMessage updMsg
-            reportUpdate
-            if not reboot
-              then botLoop
-              else return (True)
 
--- | Reports an update to the master bot
+-- | Process an update command
-reportUpdate :: Bot ()
+processUpdateMessage :: ResumeMsg -> Bot (BotStatus)
-reportUpdate = do
+processUpdateMessage msg = do
-    bot <- get
+    resumeData <- gets botResumeData
-    let mvar  = botMVar bot
+    let from  = resMsgFrom msg
-        stuff = show $ botResumeData bot
+        stuff = resMsgData msg
-    _ <- liftIO $ swapMVar mvar stuff
+    liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.insert from stuff oldData)
-    return ()
+    return BotContinue
 

Hsbot/Irc/Core.hs

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

Hsbot/Irc/Types.hs

@@ -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

Hsbot/Message.hs

@@ -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
+      return BotContinue
-processInternalMessage _ = return (False)
+processInternalMessage _ = return BotContinue
 
-processCoreMessage :: Msg -> Bot (Bool)
+processCoreMessage :: Msg -> Bot (BotStatus)
 processCoreMessage msg = do
     case msgType msg of
-        "UPDATE" -> processUpdateCommand msg
+        "REBOOT" -> return BotReboot
-        _        -> return ()
+        _        -> return BotContinue
-    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 }
 

Hsbot/Types.hs

@@ -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 :: MVar BotResumeData   -- the necessary data to resume the bot's operations on reboot
-    , botResumeData :: M.Map String String  -- 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)