Implemented update message handling in the bot's core.

7 files changed, 159 insertions, 63 deletions

diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index 772a31a..0ae337b 100644
--- a/Hsbot/Core.hs
+++ b/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
-
--- | 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
-    }
+import Hsbot.Types
 
 -- | Bot's main entry point
 hsbot :: Config -> IO ()
@@ -34,38 +22,54 @@ 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 }
+    botState <- execStateT spawnIrcPlugins BotState { botStartTime  = startTime
+                                                    , botPlugins    = M.empty
+                                                    , botChan       = chan
+                                                    , 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
 botLoop :: Bot ()
 botLoop = forever $ do
     chan <- gets botChan
-    msg <- liftIO $ readChan chan
-    -- process messages
-    return ()
+    msg  <- liftIO $ readChan chan
+    case msg of
+        InMsg  _      -> return ()
+        OutMsg _      -> return ()
+        IntMsg intMsg -> do
+            processInternalMessage $ IntMsg intMsg
+            reportUpdate
+
+-- | Reports an update to the master bot
+reportUpdate :: Bot ()
+reportUpdate = do
+    bot <- get
+    let updateChan = botUpdateChan bot
+        stuff      = show $ botResumeData bot
+    liftIO $ writeChan updateChan stuff
 
--- | spawns IrcPlugins
-spawnIrcPlugins :: Bot ()
-spawnIrcPlugins = do
-    config <- gets botConfig
-    mapM_ (spawnIrcPlugin) (ircConfigs config)
+-- | Runs bot updates' manager thread
+readUpdates :: Chan String -> Chan String -> String -> IO ()
+readUpdates processChan reportChan resumeData = do
+    resumeData' <- (readChan processChan) `catch` handleException
+    readUpdates processChan reportChan resumeData'
   where
-    spawnIrcPlugin :: IrcConfig -> Bot ()
-    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 }
+    handleException :: AsyncException -> IO (String)
+    handleException _ = do
+        writeChan reportChan resumeData
+        myId <- myThreadId
+        killThread myId
+        return ""
 
diff --git a/Hsbot/Irc/Core.hs b/Hsbot/Irc/Core.hs
index 1a51a5c..936ced6 100644
--- a/Hsbot/Irc/Core.hs
+++ b/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 ()
diff --git a/Hsbot/Irc/Types.hs b/Hsbot/Irc/Types.hs
index 90bd728..440de64 100644
--- a/Hsbot/Irc/Types.hs
+++ b/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
diff --git a/Hsbot/Message.hs b/Hsbot/Message.hs
index 83d4c08..d2cb085 100644
--- a/Hsbot/Message.hs
+++ b/Hsbot/Message.hs
@@ -1,18 +1,36 @@
 module Hsbot.Message
-    ( BotMsg (..)
-    , Msg (..)
-    , processInternalMessage
+    ( processInternalMessage
     ) where
 
+import Control.Monad.State
+import qualified Data.Map as M
+
 import Hsbot.PluginUtils
+import Hsbot.Types
+
+-- | Processes an internal message
+processInternalMessage :: BotMsg -> Bot ()
+processInternalMessage (IntMsg msg)
+  | msgTo msg == "CORE" = processCoreMessage msg
+  | otherwise = do
+      plugins <- gets botPlugins
+      case M.lookup (msgTo msg) plugins of
+          Just (plugin, _) -> sendToPlugin (IntMsg msg) plugin
+          Nothing          -> return ()
+processInternalMessage _ = return ()
 
--- | 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)
+processCoreMessage :: Msg -> Bot ()
+processCoreMessage msg = do
+    case msgCmd msg of
+        "UPDATE"     -> processUpdateCommand msg
+        _            -> return ()
 
-data BotMsg = InMsg Msg | OutMsg Msg | IntMsg Msg deriving (Show)
+-- | 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 }
 
diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
index 47dd0f5..aafa495 100644
--- a/Hsbot/Plugin.hs
+++ b/Hsbot/Plugin.hs
@@ -1,23 +1,32 @@
 module Hsbot.Plugin
-    ( Plugin
-    , PluginState (..)
+    ( spawnIrcPlugins
     ) 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
-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
-    }
+-- | spawns IrcPlugins
+spawnIrcPlugins :: Bot ()
+spawnIrcPlugins = do
+    config <- gets botConfig
+    mapM_ (spawnIrcPlugin) (ircConfigs config)
+  where
+    spawnIrcPlugin :: IrcConfig -> Bot ()
+    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 }
 
diff --git a/Hsbot/PluginUtils.hs b/Hsbot/PluginUtils.hs
new file mode 100644
index 0000000..d09b3b4
--- /dev/null
+++ b/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
+
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
new file mode 100644
index 0000000..3afbff5
--- /dev/null
+++ b/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)
+