From 451564ef5b13302912080d58a9aee6ff0968f70e Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Tue, 25 May 2010 21:54:33 +0200
Subject: Cleaned that ugly update message handling and added a reboot command
 to the ircbot.

---
 Hsbot/Irc/Command.hs     | 12 +++++++-----
 Hsbot/Irc/Core.hs        | 29 ++++++++++++++++++++++-------
 Hsbot/Irc/Plugin/Core.hs |  9 +++++++--
 3 files changed, 36 insertions(+), 14 deletions(-)

(limited to 'Hsbot/Irc')

diff --git a/Hsbot/Irc/Command.hs b/Hsbot/Irc/Command.hs
index ef1ef27..242e12d 100644
--- a/Hsbot/Irc/Command.hs
+++ b/Hsbot/Irc/Command.hs
@@ -34,7 +34,7 @@ unregisterCommand cmd pluginName' = do
     put $ ircBot { ircBotCommands = newCmds }
 
 -- | Processes an internal command
-processInternalCommand :: IrcBotMsg -> IrcBot ()
+processInternalCommand :: IrcBotMsg -> IrcBot (Bool)
 processInternalCommand (IntIrcCmd ircCmd)
   | ircCmdTo ircCmd == "CORE"   = processCoreCommand ircCmd
   | otherwise = do
@@ -42,21 +42,23 @@ processInternalCommand (IntIrcCmd ircCmd)
       case M.lookup (ircCmdTo ircCmd) plugins of
           Just (plugin, _) -> sendToPlugin (IntIrcCmd ircCmd) plugin
           Nothing          -> return ()
-processInternalCommand _ = return ()
+      return False
+processInternalCommand _ = return (False)
 
 -- | Processes a core command
-processCoreCommand :: IrcCmd -> IrcBot ()
+processCoreCommand :: IrcCmd -> IrcBot (Bool)
 processCoreCommand ircCmd = do
     let command' = ircCmdCmd ircCmd
         originalRequest = ircCmdBotMsg ircCmd
     case command' of
         "LIST"       -> listPlugins originalRequest (ircCmdFrom ircCmd)
         "LOAD"       -> loadIrcPlugin $ ircCmdMsg ircCmd
-        "UNLOAD"     -> unloadIrcPlugin $ ircCmdMsg ircCmd
-        "UPDATE"     -> processUpdateCommand ircCmd
         "REGISTER"   -> registerCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd)
+        "UNLOAD"     -> unloadIrcPlugin $ ircCmdMsg ircCmd
         "UNREGISTER" -> unregisterCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd)
+        "UPDATE"     -> processUpdateCommand ircCmd
         _            -> return ()
+    return $ command' == "REBOOT"
 
 -- | Process an update command
 processUpdateCommand :: IrcCmd -> IrcBot ()
diff --git a/Hsbot/Irc/Core.hs b/Hsbot/Irc/Core.hs
index 936ced6..b1aee02 100644
--- a/Hsbot/Irc/Core.hs
+++ b/Hsbot/Irc/Core.hs
@@ -57,7 +57,7 @@ startIrcbot config masterChan myChan = do
     putStrLn "[IrcBot] Spawning plugins..."
     ircBotState'' <- execStateT spawnIrcPlugins ircBotState'
     putStrLn "[IrcBot] Entering Core loop... "
-    _ <- (execStateT ircBotLoop ircBotState'') `catch` (\(_ :: IOException) -> return (ircBotState''))
+    (evalStateT ircBotLoop ircBotState'') `catch` (\(_ :: IOException) -> return ())
     return ()
 
 --resumeIrcBot
@@ -103,8 +103,11 @@ ircBotLoop = forever $ do
         InIrcMsg inIrcMsg   -> dispatchMessage $ InIrcMsg inIrcMsg
         OutIrcMsg outIrcMsg -> sendThisMessage outIrcMsg
         IntIrcCmd intIrcCmd -> do
-            processInternalCommand $ IntIrcCmd intIrcCmd
+            reboot <- processInternalCommand $ IntIrcCmd intIrcCmd
             reportUpdate
+            if reboot
+              then processRebootCommand
+              else return ()
   where
     sendThisMessage :: IrcMsg -> IrcBot ()
     sendThisMessage outputMsg = do
@@ -142,10 +145,22 @@ reportUpdate :: IrcBot ()
 reportUpdate = do
     ircbot <- get
     let masterChan = ircBotMasterChan ircbot
-        msg        = IntMsg $ Msg { msgType = "UPDATE"
-                                  , msgFrom = ircConfigName $ ircBotConfig ircbot
-                                  , msgTo   = "CORE"
-                                  , msgCmd  = show $ ircBotResumeData ircbot
-                                  }
+        msg = IntMsg $ Msg { msgType  = "UPDATE"
+                           , msgFrom  = ircConfigName $ ircBotConfig ircbot
+                           , msgTo    = "CORE"
+                           , msgStuff = show $ ircBotResumeData ircbot
+                           }
+    liftIO $ writeChan masterChan msg
+
+-- | Process a reboot command
+processRebootCommand :: IrcBot ()
+processRebootCommand = do
+    ircbot <- get
+    let masterChan = ircBotMasterChan ircbot
+        msg = IntMsg $ Msg { msgType  = "REBOOT"
+                           , msgFrom  = ircConfigName $ ircBotConfig ircbot
+                           , msgTo    = "CORE"
+                           , msgStuff = show $ ircBotResumeData ircbot
+                           }
     liftIO $ writeChan masterChan msg
 
diff --git a/Hsbot/Irc/Plugin/Core.hs b/Hsbot/Irc/Plugin/Core.hs
index 0297e2c..114ced8 100644
--- a/Hsbot/Irc/Plugin/Core.hs
+++ b/Hsbot/Irc/Plugin/Core.hs
@@ -16,9 +16,9 @@ ircBotPluginCore myChan masterChan = do
     let plugin = IrcPluginState { ircPluginName       = "Core"
                                 , ircPluginChan       = myChan
                                 , ircPluginMasterChan = masterChan }
-    evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload"]) plugin
+    evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload", "reboot"]) plugin
     plugin' <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin)
-    evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload"]) plugin'
+    evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload", "reboot"]) plugin'
 
 -- | The IrcPlugin monad main function
 run :: IrcPlugin ()
@@ -36,6 +36,7 @@ run = forever $ do
                             "load"   -> loadPlugin $ tail stuff
                             "reload" -> reloadPlugin $ tail stuff
                             "unload" -> unloadPlugin $ tail stuff
+                            "reboot" -> rebootBot $ tail stuff
                             _        -> return () -- TODO : help message
             "ANSWER" -> let stuff = ircCmdMsg intCmd
                         in answerMsg request ("Loaded plugins : " ++ stuff)
@@ -59,3 +60,7 @@ reloadPlugin pluginNames = mapM_ (sendCommand "RELOAD" "CORE") pluginNames
 unloadPlugin :: [String] -> IrcPlugin ()
 unloadPlugin pluginNames = mapM_ (sendCommand "UNLOAD" "CORE") pluginNames
 
+-- | The reboot command
+rebootBot :: [String] -> IrcPlugin ()
+rebootBot stuff = sendCommand "REBOOT" "CORE" $ unwords stuff
+
-- 
cgit v1.2.3