summaryrefslogtreecommitdiff
path: root/Hsbot/Irc
diff options
context:
space:
mode:
authorJulien Dessaux2010-05-25 21:54:33 +0200
committerJulien Dessaux2010-05-25 22:07:58 +0200
commit451564ef5b13302912080d58a9aee6ff0968f70e (patch)
tree482d14d297d90c2696f98af39cc0cf1712d90bdd /Hsbot/Irc
parentImplemented update message handling in the bot's core. (diff)
downloadhsbot-451564ef5b13302912080d58a9aee6ff0968f70e.tar.gz
hsbot-451564ef5b13302912080d58a9aee6ff0968f70e.tar.bz2
hsbot-451564ef5b13302912080d58a9aee6ff0968f70e.zip
Cleaned that ugly update message handling and added a reboot command to the ircbot.
Diffstat (limited to '')
-rw-r--r--Hsbot/Irc/Command.hs12
-rw-r--r--Hsbot/Irc/Core.hs29
-rw-r--r--Hsbot/Irc/Plugin/Core.hs9
3 files changed, 36 insertions, 14 deletions
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
+