summaryrefslogtreecommitdiff
path: root/Plugins
diff options
context:
space:
mode:
authorJulien Dessaux2010-02-04 21:05:37 +0100
committerJulien Dessaux2010-02-04 21:05:37 +0100
commitfd8d5faf5f4ab085b01316e15403779ca30cf3f9 (patch)
tree83dfae790dcb184d651567f06929fc69338733a9 /Plugins
parentFixed some types' functions. (diff)
downloadhsbot-fd8d5faf5f4ab085b01316e15403779ca30cf3f9.tar.gz
hsbot-fd8d5faf5f4ab085b01316e15403779ca30cf3f9.tar.bz2
hsbot-fd8d5faf5f4ab085b01316e15403779ca30cf3f9.zip
Began a complete rewrite of command and plugin management.
Wrote a command routing statement, added an IrcPlugin monad.
Diffstat (limited to 'Plugins')
-rw-r--r--Plugins/Core.hs49
-rw-r--r--Plugins/Ping.hs29
-rw-r--r--Plugins/Quote.hs49
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 ()