diff options
Diffstat (limited to 'Plugins')
-rw-r--r-- | Plugins/Core.hs | 49 | ||||
-rw-r--r-- | Plugins/Ping.hs | 29 | ||||
-rw-r--r-- | Plugins/Quote.hs | 49 |
3 files changed, 97 insertions, 30 deletions
diff --git a/Plugins/Core.hs b/Plugins/Core.hs new file mode 100644 index 0000000..a15cc62 --- /dev/null +++ b/Plugins/Core.hs @@ -0,0 +1,49 @@ +module Plugins.Core + ( mainCore + ) where + +import Control.Concurrent.Chan + +import Hsbot.IRCPlugin +import Hsbot.Types +import Hsbot.Utils + +-- | The plugin's main entry point +mainCore :: Chan BotMsg -> Chan BotMsg -> IO () +mainCore serverChan chan = do + let plugin = PluginInstance "Core" serverChan chan + (runStateT run plugin) `catch` (const $ return ((), plugin)) + return () + +-- | The IrcPlugin monad main function +run :: IrcPlugin () +run = do + mapM_ sendRegisterCommand ["load", "unload"] + runPlugin + mapM_ sendUnregisterCommand ["load", "unload"] + +runPlugin :: IrcPlugin () +runPlugin = forever $ do + msg <- readMsg + eval msg + where + eval :: BotMsg -> IrcPlugin () + eval (InternalCmd intCmd) = do + case intCmdCmd intCmd of + "RUN" -> let stuff = words $ intCmdMsg intCmd + in case head stuff of + "load" -> loadPlugin $ tail stuff + "unload" -> unloadPlugin $ tail stuff + _ -> lift $ trace $ show intCmd -- TODO : help message + _ -> lift $ trace $ show intCmd + eval (InputMsg msg) = return () + eval _ = return () + +-- | The load command +loadPlugin :: [String] -> IrcPlugin () +loadPlugin pluginNames = mapM_ (sendCommand "LOAD" "CORE") pluginNames + +-- | The unload command +unloadPlugin :: [String] -> IrcPlugin () +unloadPlugin pluginNames = mapM_ (sendCommand "UNLOAD" "CORE") pluginNames + diff --git a/Plugins/Ping.hs b/Plugins/Ping.hs index 46351aa..6102fe4 100644 --- a/Plugins/Ping.hs +++ b/Plugins/Ping.hs @@ -3,20 +3,27 @@ module Plugins.Ping ) where import Control.Concurrent.Chan +import Control.Monad.State +import Hsbot.IRCPlugin import Hsbot.Types +-- | The plugin's main entry point mainPing :: Chan BotMsg -> Chan BotMsg -> IO () mainPing serverChan chan = do - loop - where - loop = do - input <- readChan chan - eval input - loop - eval :: BotMsg -> IO () - eval (InputMsg msg) - | (command msg) == "PING" = writeChan serverChan $ OutputMsg $ IrcMsg Nothing "PONG" (parameters msg) - | otherwise = return () - eval _ = return () + let plugin = PluginInstance "Ping" serverChan chan + (runStateT run plugin) `catch` (const $ return ((), plugin)) + return () + +-- | The IrcPlugin monad main function +run :: IrcPlugin () +run = forever $ do + msg <- readMsg + eval msg + where + eval :: BotMsg -> IrcPlugin () + eval (InputMsg msg) + | (command msg) == "PING" = writeMsg $ OutputMsg $ IrcMsg Nothing "PONG" (parameters msg) + | otherwise = return () + eval _ = return () diff --git a/Plugins/Quote.hs b/Plugins/Quote.hs index 6547cd1..4c6e22c 100644 --- a/Plugins/Quote.hs +++ b/Plugins/Quote.hs @@ -6,7 +6,7 @@ import Control.Concurrent.Chan import Control.Monad.State import System.Time (ClockTime) -import Hsbot.Core +import Hsbot.IRCPlugin import Hsbot.Types import Hsbot.Utils @@ -24,24 +24,35 @@ type QuoteDB = [Quote] -- | The QuoteBot monad type QuoteBot a = StateT QuoteDB IO a --- | The main function of the Quote module +-- | The plugin's main entry point mainQuote :: Chan BotMsg -> Chan BotMsg -> IO () mainQuote serverChan chan = do - writeChan serverChan $ InternalCmd $ IntCmd "REGISTER COMMAND quote Quote" emptyMsg - loop - where - loop = do - input <- readChan chan - eval input - loop - eval :: BotMsg -> IO () - eval (InternalCmd intCmd) = do - let command' = words $ internalCommand intCmd - case command' !! 0 of - "runCommand" -> case (command' !! 1) of - "quote" -> writeChan serverChan $ OutputMsg $ internalCommandMsg intCmd - _ -> trace $ show command' -- TODO : help message - _ -> trace $ show command' - eval (InputMsg msg) = return () - eval _ = return () + let plugin = PluginInstance "Quote" serverChan chan + (runStateT run plugin) `catch` (const $ return ((), plugin)) + return () + +-- | The IrcPlugin monad main function +run :: IrcPlugin () +run = do + -- TODO : init quote handling (sqlite + structure to handle temporary stuff) + sendRegisterCommand "quote" + runPlugin + sendUnregisterCommand "quote" + -- TODO : send cancel messages for all temporary stuff + +runPlugin :: IrcPlugin () +runPlugin = forever $ do + msg <- readMsg + eval msg + where + eval :: BotMsg -> IrcPlugin () + eval (InternalCmd intCmd) = do + case intCmdCmd intCmd of + "RUN" -> let stuff = words $ intCmdMsg intCmd + in case head stuff of + "quote" -> lift $ trace $ "Quote module has been invoked for: " ++ (show intCmd) + _ -> lift $ trace $ show intCmd -- TODO : help message + _ -> lift $ trace $ show intCmd + eval (InputMsg msg) = return () + eval _ = return () |