From fd8d5faf5f4ab085b01316e15403779ca30cf3f9 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Thu, 4 Feb 2010 21:05:37 +0100
Subject: Began a complete rewrite of command and plugin management.

Wrote a command routing statement, added an IrcPlugin monad.
---
 Plugins/Core.hs  | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 Plugins/Ping.hs  | 29 ++++++++++++++++++-----------
 Plugins/Quote.hs | 49 ++++++++++++++++++++++++++++++-------------------
 3 files changed, 97 insertions(+), 30 deletions(-)
 create mode 100644 Plugins/Core.hs

(limited to 'Plugins')

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 ()
 
-- 
cgit v1.2.3