From c1662ba7b982a8502dc9f32031b7cb518df7f60e Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Sun, 16 May 2010 00:01:00 +0200 Subject: Rewrote nearly everything! * Rewrote the whole architecture to achieve extreme modularity * Added the ability to build a multiprotocol bot * Added cabal integration * Added configuration handling the XMonad style * Added configuration in ~/.hsbot * Refactored many many named and functions * Refactored data structures * Cleaned a big bunch of stuff --- Hsbot/Irc/Plugin/Core.hs | 63 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 Hsbot/Irc/Plugin/Core.hs (limited to 'Hsbot/Irc/Plugin/Core.hs') diff --git a/Hsbot/Irc/Plugin/Core.hs b/Hsbot/Irc/Plugin/Core.hs new file mode 100644 index 0000000..5d69ca3 --- /dev/null +++ b/Hsbot/Irc/Plugin/Core.hs @@ -0,0 +1,63 @@ +module Hsbot.Irc.Plugin.Core + ( ircBotPluginCore + ) where + +import Control.Concurrent (Chan, myThreadId) +import Control.Exception +import Control.Monad.State +import Prelude hiding (catch) + +import Hsbot.Irc.Message +import Hsbot.Irc.PluginCommons + +-- | The plugin's main entry point +ircBotPluginCore :: Chan IrcBotMsg -> Chan IrcBotMsg -> IO () +ircBotPluginCore myChan masterChan = do + threadId <- myThreadId + let plugin = IrcPluginState { ircPluginName = "Core" + , ircPluginThreadId = threadId + , ircPluginChan = myChan + , ircPluginMasterChan = masterChan } + evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload"]) plugin + plugin' <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin) + evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload"]) 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 + _ -> 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 + -- cgit v1.2.3