Implemented update message handling in the bot's core.

Hsbot/Core.hs

@@ -12,21 +12,9 @@ import Prelude hiding (catch)
 import System.IO()
 
 import Hsbot.Config
-import Hsbot.Irc.Config
-import Hsbot.Irc.Core
 import Hsbot.Message
 import Hsbot.Plugin
-
+import Hsbot.Types
--- | The Bot monad
-type Bot = StateT BotState IO
-
--- | An Hsbot state
-data BotState = BotState
-    { botStartTime :: UTCTime                              -- the bot's uptime
-    , botPlugins   :: M.Map String (PluginState, ThreadId) -- Loaded plugins
-    , botChan      :: Chan BotMsg                          -- The bot's communication channel
-    , botConfig    :: Config                               -- the bot's starting config
-    }
 
 -- | Bot's main entry point
 hsbot :: Config -> IO ()
@@ -34,13 +22,22 @@ hsbot config = do
     startTime <- getCurrentTime
     putStrLn "[Hsbot] Opening communication channel... "
     chan <- newChan :: IO (Chan BotMsg)
+    putStrLn "[Hsbot] Spawning bot state manager... "
+    processUpdateChan <- newChan :: IO (Chan String)
+    reportUpdateChan  <- newChan :: IO (Chan String)
+    updaterThreadId <- forkIO $ readUpdates processUpdateChan reportUpdateChan ""
     putStrLn "[Hsbot] Spawning IrcBot plugins... "
     botState <- execStateT spawnIrcPlugins BotState { botStartTime  = startTime
                                                     , botPlugins    = M.empty
                                                     , botChan       = chan
-                                                    , botConfig    = config }
+                                                    , botConfig     = config
+                                                    , botUpdateChan = processUpdateChan
+                                                    , botResumeData = M.empty }
     putStrLn "[Hsbot] Entering main loop... "
-    botState' <- (execStateT botLoop botState) `catch` (\(_ :: IOException) -> return botState)
+    _ <- (execStateT botLoop botState) `catch` (\(_ :: IOException) -> return botState)
+    killThread updaterThreadId
+    resumeData <- readChan reportUpdateChan
+    print resumeData
     return ()
 
 -- | Run the bot main loop
@@ -48,24 +45,31 @@ botLoop :: Bot ()
 botLoop = forever $ do
     chan <- gets botChan
     msg  <- liftIO $ readChan chan
-    -- process messages
+    case msg of
-    return ()
+        InMsg  _      -> return ()
+        OutMsg _      -> return ()
+        IntMsg intMsg -> do
+            processInternalMessage $ IntMsg intMsg
+            reportUpdate
 
--- | spawns IrcPlugins
+-- | Reports an update to the master bot
-spawnIrcPlugins :: Bot ()
+reportUpdate :: Bot ()
-spawnIrcPlugins = do
+reportUpdate = do
-    config <- gets botConfig
-    mapM_ (spawnIrcPlugin) (ircConfigs config)
-  where
-    spawnIrcPlugin :: IrcConfig -> Bot ()
-    spawnIrcPlugin config = do
     bot <- get
-        let chan  = botChan bot
+    let updateChan = botUpdateChan bot
-        pchan <- liftIO (newChan :: IO (Chan BotMsg))
+        stuff      = show $ botResumeData bot
-        threadId <- liftIO $ forkIO (startIrcbot config chan pchan)
+    liftIO $ writeChan updateChan stuff
-        let plugin  = PluginState { pluginName    = ircConfigName config
+
-                                  , pluginChan    = pchan
+-- | Runs bot updates' manager thread
-                                  , pluginHandles = M.empty }
+readUpdates :: Chan String -> Chan String -> String -> IO ()
-            plugins = botPlugins bot
+readUpdates processChan reportChan resumeData = do
-        put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, threadId) plugins }
+    resumeData' <- (readChan processChan) `catch` handleException
+    readUpdates processChan reportChan resumeData'
+  where
+    handleException :: AsyncException -> IO (String)
+    handleException _ = do
+        writeChan reportChan resumeData
+        myId <- myThreadId
+        killThread myId
+        return ""
 

Hsbot/Irc/Core.hs

@@ -19,7 +19,7 @@ import Hsbot.Irc.Message
 import Hsbot.Irc.Plugin
 import Hsbot.Irc.Server
 import Hsbot.Irc.Types
-import Hsbot.Message
+import Hsbot.Types
 
 -- | IrcBot's main entry point
 startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> IO ()

Hsbot/Irc/Types.hs

@@ -14,7 +14,7 @@ import System.IO
 import Hsbot.Irc.Config
 import Hsbot.Irc.Message
 import Hsbot.Irc.Plugin.Utils
-import Hsbot.Message
+import Hsbot.Types
 
 -- | The Ircbot monad
 type IrcBot = StateT IrcBotState IO

Hsbot/Message.hs

@@ -1,18 +1,36 @@
 module Hsbot.Message
-    ( BotMsg (..)
+    ( processInternalMessage
-    , Msg (..)
-    , processInternalMessage
     ) where
 
+import Control.Monad.State
+import qualified Data.Map as M
+
 import Hsbot.PluginUtils
+import Hsbot.Types
 
--- | A hsbot message
+-- | Processes an internal message
-data Msg = Msg
+processInternalMessage :: BotMsg -> Bot ()
-    { msgType :: String -- the message type
+processInternalMessage (IntMsg msg)
-    , msgFrom :: String -- who issues it
+  | msgTo msg == "CORE" = processCoreMessage msg
-    , msgTo   :: String -- who it is destinated to
+  | otherwise = do
-    , msgCmd  :: String -- the message to be transfered
+      plugins <- gets botPlugins
-    } deriving (Show)
+      case M.lookup (msgTo msg) plugins of
+          Just (plugin, _) -> sendToPlugin (IntMsg msg) plugin
+          Nothing          -> return ()
+processInternalMessage _ = return ()
 
-data BotMsg = InMsg Msg | OutMsg Msg | IntMsg Msg deriving (Show)
+processCoreMessage :: Msg -> Bot ()
+processCoreMessage msg = do
+    case msgCmd msg of
+        "UPDATE"     -> processUpdateCommand msg
+        _            -> return ()
+
+-- | Process an update command
+processUpdateCommand :: Msg -> Bot ()
+processUpdateCommand msg = do
+    bot <- get
+    let oldData = botResumeData bot
+        from    = msgFrom msg
+        stuff   = msgCmd msg
+    put $ bot { botResumeData = M.insert from stuff oldData }
 

Hsbot/Plugin.hs

@@ -1,23 +1,32 @@
 module Hsbot.Plugin
-    ( Plugin
+    ( spawnIrcPlugins
-    , PluginState (..)
     ) where
 
 import Control.Concurrent
 import Control.Concurrent.Chan ()
 import Control.Monad.State
 import qualified Data.Map as M
-import IO (Handle)
 
-import Hsbot.Message
+import Hsbot.Config
+import Hsbot.Irc.Config
+import Hsbot.Irc.Core
+import Hsbot.Types
 
--- | The Plugin monad
+-- | spawns IrcPlugins
-type Plugin = StateT PluginState IO
+spawnIrcPlugins :: Bot ()
-
+spawnIrcPlugins = do
--- | A plugin state
+    config <- gets botConfig
-data PluginState = PluginState
+    mapM_ (spawnIrcPlugin) (ircConfigs config)
-    { pluginName       :: String              -- The plugin's name
+  where
-    , pluginChan       :: Chan BotMsg         -- The plugin chan
+    spawnIrcPlugin :: IrcConfig -> Bot ()
-    , pluginHandles    :: M.Map String Handle -- the plugins's handles
+    spawnIrcPlugin config = do
-    }
+        bot <- get
+        let chan  = botChan bot
+        pchan <- liftIO (newChan :: IO (Chan BotMsg))
+        threadId <- liftIO $ forkIO (startIrcbot config chan pchan)
+        let plugin  = PluginState { pluginName    = ircConfigName config
+                                  , pluginChan    = pchan
+                                  , pluginHandles = M.empty }
+            plugins = botPlugins bot
+        put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, threadId) plugins }
 

Hsbot/PluginUtils.hs

@@ -0,0 +1,15 @@
+module Hsbot.PluginUtils
+    ( sendToPlugin
+    ) where
+
+import Control.Concurrent
+import Control.Concurrent.Chan ()
+import Control.Monad.State
+
+import Hsbot.Types
+
+-- | Sends a msg to a plugin
+sendToPlugin :: BotMsg -> PluginState -> Bot ()
+sendToPlugin botMsg plugin = do
+    liftIO $ writeChan (pluginChan plugin) botMsg
+

Hsbot/Types.hs

@@ -0,0 +1,50 @@
+module Hsbot.Types
+    ( Bot
+    , BotMsg (..)
+    , BotState (..)
+    , Msg (..)
+    , Plugin
+    , PluginState (..)
+    ) where
+
+import Control.Concurrent
+import Control.Monad.State
+import qualified Data.Map as M
+import Data.Time
+import System.IO
+
+import Hsbot.Config
+
+-- | The Bot monad
+type Bot = StateT BotState IO
+
+-- | An Hsbot state
+data BotState = BotState
+    { botStartTime  :: UTCTime      -- the bot's uptime
+    , botPlugins    :: M.Map String (PluginState, ThreadId) -- Loaded plugins
+    , botChan       :: Chan BotMsg  -- the bot's communication channel
+    , botConfig     :: Config       -- the bot's starting config
+    , botUpdateChan :: Chan String  -- the bot's chan to report updates on
+    , botResumeData :: M.Map String String  -- the necessary data to resume the bot's operations on reboot
+    }
+
+-- | The Plugin monad
+type Plugin = StateT PluginState IO
+
+-- | A plugin state
+data PluginState = PluginState
+    { pluginName       :: String              -- The plugin's name
+    , pluginChan       :: Chan BotMsg         -- The plugin chan
+    , pluginHandles    :: M.Map String Handle -- the plugins's handles
+    }
+
+-- | A hsbot message
+data Msg = Msg
+    { msgType :: String -- the message type
+    , msgFrom :: String -- who issues it
+    , msgTo   :: String -- who it is destinated to
+    , msgCmd  :: String -- the message to be transfered
+    } deriving (Show)
+
+data BotMsg = InMsg Msg | OutMsg Msg | IntMsg Msg deriving (Show)
+

TODO

@@ -1,6 +1,5 @@
 :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
 
-* Handle bot/Plugin state updates threw the masters' Chans
 * Find a way to handle bot reloading threw exec
 * Find a way to cleanly handle termination/reboot requests (signals, IOExceptions, plugins' requests)
 

hsbot.cabal

@@ -54,6 +54,8 @@ Library
                  Hsbot.Irc.Types
                  Hsbot.Message
                  Hsbot.Plugin
+                 Hsbot.PluginUtils
+                 Hsbot.Types
   ghc-options: -Wall
   extensions: DeriveDataTypeable ScopedTypeVariables
   build-depends: base >= 4.1,