summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Config.hs2
-rw-r--r--Hsbot/Command.hs81
-rw-r--r--Hsbot/Core.hs4
-rw-r--r--Hsbot/IRC.hs13
-rw-r--r--Hsbot/Plugin.hs7
-rw-r--r--Hsbot/Types.hs7
-rw-r--r--Hsbot/Utils.hs5
-rw-r--r--Plugins/Quote.hs47
-rw-r--r--TODO7
9 files changed, 116 insertions, 57 deletions
diff --git a/Config.hs b/Config.hs
index 5bbb992..509b565 100644
--- a/Config.hs
+++ b/Config.hs
@@ -9,7 +9,7 @@ import Hsbot.Types
-- | Imported plugins goes there
defaultPlugins :: [String]
-defaultPlugins = [ "Ping" ]
+defaultPlugins = [ "Ping", "Quote" ]
-- | User server
kro :: IrcServer
diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs
index 92f304c..bab592e 100644
--- a/Hsbot/Command.hs
+++ b/Hsbot/Command.hs
@@ -1,5 +1,6 @@
module Hsbot.Command
- ( dispatchCommand
+ ( dispatchMessage
+ , processInternalCommand
, registerCommand
, unregisterCommand
) where
@@ -14,46 +15,20 @@ import Hsbot.Plugin
import Hsbot.Types
import Hsbot.Utils
--- TODO : unregister command
-
-dispatchCommand :: BotMsg -> IrcBot ()
-dispatchCommand (InputMsg inputMsg) = do
- plugins <- gets botPlugins
- cmds <- gets botCommands
- if command inputMsg == "PRIVMSG"
- then -- The first word matters as the command
- let msg = (parameters inputMsg) !! 1
- pfx = commandPrefix config
- in if (head msg) == pfx
- then
- let key = tail msg -- all but the cmd prefix
- pluginNames = fromMaybe [] $ M.lookup key cmds
- plugins' = fromMaybe [] $ mapM (flip M.lookup plugins) pluginNames
- in mapM_ (sendToPlugin (InputMsg inputMsg)) plugins'
- else
- mapM_ (sendToPlugin (InputMsg inputMsg)) (M.elems plugins)
- else
- return ()
-dispatchCommand _ = return ()
-
+-- | Registers a plugin's command
registerCommand :: String -> String -> IrcBot ()
registerCommand cmd pluginName' = do
bot <- get
cmds <- gets botCommands
- exists <- pluginExists pluginName'
- -- TODO : improve this crap and remove at least one if!
- if exists
- then
- let cmds' = if cmd `M.member` cmds
- then cmds
- else M.singleton cmd []
- -- TODO : remove duplicates ?
- newCmds = M.adjust (++ [pluginName']) cmd cmds'
- in put $ bot { botCommands = newCmds }
- else
- traceM $ inColor ("Couldn't register command \"" ++ cmd ++ "\" for plugin \""
- ++ pluginName' ++ "\" : plugin does not exists") [31]
+ plugins <- gets botPlugins
+ case M.lookup pluginName' plugins of
+ Just _ -> let pluginNames = pluginName' : fromMaybe [] (M.lookup cmd cmds) -- TODO : remove/check for duplicates ?
+ newCmds = M.insert cmd pluginNames cmds
+ in put $ bot { botCommands = newCmds }
+ Nothing -> traceM $ inColor ("Couldn't register command \"" ++ cmd ++ "\" for plugin \""
+ ++ pluginName' ++ "\" : plugin does not exists") [31]
+-- | Unregisters a plugin's command
unregisterCommand :: String -> String -> IrcBot ()
unregisterCommand cmd pluginName' = do
bot <- get
@@ -61,3 +36,37 @@ unregisterCommand cmd pluginName' = do
let newCmds = M.adjust (L.delete pluginName') cmd cmds
put $ bot { botCommands = newCmds }
+--
+-- TODO Clean this crap
+--
+dispatchMessage :: BotMsg -> IrcBot ()
+dispatchMessage (InputMsg inputMsg) = do
+ plugins <- gets botPlugins
+ cmds <- gets botCommands
+ case command inputMsg of
+ "PRIVMSG" -> -- The first word matters as the command
+ let msg = (parameters inputMsg) !! 1
+ pfx = commandPrefix config
+ in if (head msg) == pfx
+ then
+ let msg' = tail msg -- all but the cmd prefix
+ key = head $ words msg'
+ pluginNames = fromMaybe [] $ M.lookup key cmds
+ plugins' = fromMaybe [] $ mapM (flip M.lookup plugins) pluginNames
+ in mapM_ (sendToPlugin $ InternalCmd $ IntCmd ("runCommand " ++ key) inputMsg) plugins'
+ else
+ mapM_ (sendToPlugin (InputMsg inputMsg)) (M.elems plugins)
+ _ -> return ()
+dispatchMessage _ = return ()
+
+-- | Processes an internal command
+processInternalCommand :: BotMsg -> IrcBot ()
+processInternalCommand (InternalCmd intCmd) = do
+ let command' = words $ internalCommand intCmd
+ case command' !! 0 of
+ "REGISTER" -> case command' !! 1 of
+ "COMMAND" -> registerCommand (command' !! 2) (command' !! 3)
+ _ -> traceM $ inColor ("Invalid argument for the REGISTER command : " ++ (command' !! 2)) [31]
+ _ -> traceM $ inColor ("Invalid command : " ++ (command' !! 1)) [31]
+processInternalCommand _ = return ()
+
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index 621e670..546358b 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -1,6 +1,7 @@
module Hsbot.Core
( connectServer
, disconnectServer
+ , emptyMsg
) where
import Control.Concurrent
@@ -52,3 +53,6 @@ botReader handle chan = forever $ do
_ -> do
return ()
+emptyMsg :: IrcMsg
+emptyMsg = IrcMsg Nothing "EMPTY" []
+
diff --git a/Hsbot/IRC.hs b/Hsbot/IRC.hs
index c10467e..a489ee9 100644
--- a/Hsbot/IRC.hs
+++ b/Hsbot/IRC.hs
@@ -5,11 +5,9 @@ module Hsbot.IRC
import Control.Concurrent.Chan
import Control.Monad.State
-import qualified Data.Map as M
import Hsbot.Command
import Hsbot.IRCParser
-import Hsbot.Plugin
import Hsbot.Types
import Hsbot.Utils
@@ -27,17 +25,12 @@ initServer = do
runServer :: IrcBot ()
runServer = do
chan <- gets botChannel
- plugins <- gets botPlugins
let input = readChan chan
msg <- liftIO input
case msg of
- InputMsg inputMsg -> do
- dispatchCommand $ InputMsg inputMsg
- mapM_ (sendToPlugin (InputMsg inputMsg) . snd) (M.toList plugins)
- OutputMsg outputMsg ->
- sendstr (serializeIrcMsg outputMsg)
- InternalCmd _ ->
- traceM "TODO internal command"
+ InputMsg inputMsg -> dispatchMessage $ InputMsg inputMsg
+ OutputMsg outputMsg -> sendstr (serializeIrcMsg outputMsg)
+ InternalCmd internalCmd -> processInternalCommand $ InternalCmd internalCmd
runServer
-- | Joins a chan
diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
index 2121c7d..7d4f0ca 100644
--- a/Hsbot/Plugin.hs
+++ b/Hsbot/Plugin.hs
@@ -1,6 +1,5 @@
module Hsbot.Plugin
( loadPlugin
- , pluginExists
, sendToPlugin
) where
@@ -61,9 +60,3 @@ sendToPlugin msg plugin = do
let chan = pluginChannel plugin
liftIO $ writeChan chan msg
--- | Tells if a plugin is loaded or not
-pluginExists :: String -> IrcBot Bool
-pluginExists name = do
- plugins <- gets botPlugins
- return $ name `M.member` plugins
-
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
index 5522404..25a7732 100644
--- a/Hsbot/Types.hs
+++ b/Hsbot/Types.hs
@@ -84,10 +84,11 @@ data IrcMsg = IrcMsg
} deriving (Show)
-- | An internal command
+-- TODO : make it with a FROM and a TO for plugins handling, and make it usefull threw the helpers.
data IntCmd = IntCmd
- { intCmd :: String -- the internal command
- , intMsg :: IrcMsg -- the IrcMsg associated with the command
- }
+ { internalCommand :: String -- the internal command
+ , internalCommandMsg :: IrcMsg -- the IrcMsg associated with the command
+ } deriving (Show)
-- | A plugin definition
data Plugin = Plugin
diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs
index 640d16f..1c40362 100644
--- a/Hsbot/Utils.hs
+++ b/Hsbot/Utils.hs
@@ -31,3 +31,8 @@ trace msg = putStrLn msg
traceM :: String -> IrcBot ()
traceM msg = liftIO $ putStrLn msg
+-----------------
+-- | Helpers | --
+-----------------
+-- sendRegister
+
diff --git a/Plugins/Quote.hs b/Plugins/Quote.hs
new file mode 100644
index 0000000..6547cd1
--- /dev/null
+++ b/Plugins/Quote.hs
@@ -0,0 +1,47 @@
+module Plugins.Quote
+ ( mainQuote
+ ) where
+
+import Control.Concurrent.Chan
+import Control.Monad.State
+import System.Time (ClockTime)
+
+import Hsbot.Core
+import Hsbot.Types
+import Hsbot.Utils
+
+-- | A quote object
+data Quote = Quote
+ { quoter :: String
+ , quote :: [String]
+ , quoteTime :: ClockTime
+ , votes :: Int
+ } deriving (Show)
+
+-- | A QuoteBot state
+type QuoteDB = [Quote]
+
+-- | The QuoteBot monad
+type QuoteBot a = StateT QuoteDB IO a
+
+-- | The main function of the Quote module
+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 ()
+
diff --git a/TODO b/TODO
index e4f6898..451ee77 100644
--- a/TODO
+++ b/TODO
@@ -1,7 +1,14 @@
* implement InternalCommands "register command" and "unregister command"
+* implement helpers for command parsing in plugins
+ we need a monad "Plugin" in order to manage the from and to message fields.
+* clean command module
+* clean plugin module
* kill threads
* unload plugin
+* plugin reload
+* list modules command
* part chan
+* add admin check for cmds
* restore \r in IRCParser
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 05:23:51 +0000