From 11c2c16835b3e8368be77ccc5b7ddf949021eccd Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Sat, 3 Jul 2010 21:26:00 +0200 Subject: Moved files around as a preliminary for architectural changes. --- HsbotIrcBot/Hsbot/Irc/Plugin/Core.hs | 66 ++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100644 HsbotIrcBot/Hsbot/Irc/Plugin/Core.hs (limited to 'HsbotIrcBot/Hsbot/Irc/Plugin/Core.hs') 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 + -- cgit v1.2.3