diff options
author | Julien Dessaux | 2010-07-03 21:26:00 +0200 |
---|---|---|
committer | Julien Dessaux | 2010-07-03 22:40:17 +0200 |
commit | 11c2c16835b3e8368be77ccc5b7ddf949021eccd (patch) | |
tree | 7733132ee370335156219ff6eb4f0ef2dbd1c8ff /HsbotIrcBot/Hsbot/Irc/Plugin/Core.hs | |
parent | Wrote most of the resume code for the core and the irc plugin. (diff) | |
download | hsbot-11c2c16835b3e8368be77ccc5b7ddf949021eccd.tar.gz hsbot-11c2c16835b3e8368be77ccc5b7ddf949021eccd.tar.bz2 hsbot-11c2c16835b3e8368be77ccc5b7ddf949021eccd.zip |
Moved files around as a preliminary for architectural changes.
Diffstat (limited to 'HsbotIrcBot/Hsbot/Irc/Plugin/Core.hs')
-rw-r--r-- | HsbotIrcBot/Hsbot/Irc/Plugin/Core.hs | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/HsbotIrcBot/Hsbot/Irc/Plugin/Core.hs b/HsbotIrcBot/Hsbot/Irc/Plugin/Core.hs new file mode 100644 index 0000000..114ced8 --- /dev/null +++ b/HsbotIrcBot/Hsbot/Irc/Plugin/Core.hs @@ -0,0 +1,66 @@ +module Hsbot.Irc.Plugin.Core + ( ircBotPluginCore + ) where + +import Control.Concurrent (Chan) +import Control.Exception +import Control.Monad.State +import Prelude hiding (catch) + +import Hsbot.Irc.Message +import Hsbot.Irc.Plugin.Utils + +-- | The plugin's main entry point +ircBotPluginCore :: Chan IrcBotMsg -> Chan IrcBotMsg -> IO () +ircBotPluginCore myChan masterChan = do + let plugin = IrcPluginState { ircPluginName = "Core" + , ircPluginChan = myChan + , ircPluginMasterChan = masterChan } + evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload", "reboot"]) plugin + plugin' <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin) + evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload", "reboot"]) plugin' + +-- | The IrcPlugin monad main function +run :: IrcPlugin () +run = forever $ do + msg <- readMsg + eval msg + where + eval :: IrcBotMsg -> IrcPlugin () + eval (IntIrcCmd intCmd) = do + let request = ircCmdBotMsg intCmd + case ircCmdCmd intCmd of + "RUN" -> let stuff = words $ ircCmdMsg intCmd + in case head stuff of + "list" -> listPlugins request + "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) + _ -> return () + eval _ = return () + +-- | The list command +listPlugins :: IrcMsg -> IrcPlugin () +listPlugins request = do + sendCommandWithRequest "LIST" "CORE" (unwords []) request + +-- | The load command +loadPlugin :: [String] -> IrcPlugin () +loadPlugin pluginNames = mapM_ (sendCommand "LOAD" "CORE") pluginNames + +-- | The reload command +reloadPlugin :: [String] -> IrcPlugin () +reloadPlugin pluginNames = mapM_ (sendCommand "RELOAD" "CORE") pluginNames + +-- | The unload command +unloadPlugin :: [String] -> IrcPlugin () +unloadPlugin pluginNames = mapM_ (sendCommand "UNLOAD" "CORE") pluginNames + +-- | The reboot command +rebootBot :: [String] -> IrcPlugin () +rebootBot stuff = sendCommand "REBOOT" "CORE" $ unwords stuff + |