summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Config.hs4
-rw-r--r--Hsbot.hs2
-rw-r--r--Hsbot/Command.hs52
-rw-r--r--Hsbot/IRC.hs8
-rw-r--r--Hsbot/Types.hs22
-rw-r--r--TODO7
6 files changed, 79 insertions, 16 deletions
diff --git a/Config.hs b/Config.hs
index 50ddcfc..5bbb992 100644
--- a/Config.hs
+++ b/Config.hs
@@ -26,7 +26,7 @@ kro = IrcServer
-- | User configuration
config :: Config
config = Config
- { commandPrefixes = ['@']
- , ircServer = kro
+ { commandPrefix = '@'
+ , ircServer = kro
}
diff --git a/Hsbot.hs b/Hsbot.hs
index 7275b81..d4c1769 100644
--- a/Hsbot.hs
+++ b/Hsbot.hs
@@ -1,5 +1,6 @@
module Hsbot
( module Config
+ , module Hsbot.Command
, module Hsbot.Core
, module Hsbot.IRC
, module Hsbot.IRCParser
@@ -10,6 +11,7 @@ module Hsbot
) where
import Config
+import Hsbot.Command
import Hsbot.Core
import Hsbot.IRC
import Hsbot.IRCParser
diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs
new file mode 100644
index 0000000..20e5525
--- /dev/null
+++ b/Hsbot/Command.hs
@@ -0,0 +1,52 @@
+module Hsbot.Command
+ ( dispatchCommand
+ , registerCommand
+ ) where
+
+import Control.Monad.State
+import qualified Data.Map as M
+import Data.Maybe
+
+import Config
+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 ()
+
+registerCommand :: String -> String -> IrcBot ()
+registerCommand cmd pluginName' = do
+ bot <- get
+ cmds <- gets botCommands
+ exists <- pluginExists pluginName'
+ if exists
+ then
+ let cmds' = if cmd `M.member` cmds
+ then cmds
+ else M.singleton cmd []
+ 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]
+
diff --git a/Hsbot/IRC.hs b/Hsbot/IRC.hs
index a8f3fcb..c10467e 100644
--- a/Hsbot/IRC.hs
+++ b/Hsbot/IRC.hs
@@ -7,6 +7,7 @@ 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
@@ -30,12 +31,13 @@ runServer = do
let input = readChan chan
msg <- liftIO input
case msg of
- InputMsg inputMsg ->
+ InputMsg inputMsg -> do
+ dispatchCommand $ InputMsg inputMsg
mapM_ (sendToPlugin (InputMsg inputMsg) . snd) (M.toList plugins)
OutputMsg outputMsg ->
sendstr (serializeIrcMsg outputMsg)
- InternalCmd internalCmd ->
- traceM "TODO"
+ InternalCmd _ ->
+ traceM "TODO internal command"
runServer
-- | Joins a chan
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
index 7a37035..5522404 100644
--- a/Hsbot/Types.hs
+++ b/Hsbot/Types.hs
@@ -22,10 +22,10 @@ import System.Time (ClockTime)
-- | TODO : a monad for a channel, and a monad for a server, all together driven by a Bot?
-- | Configuration data type
-data Config = Config {
- commandPrefixes :: String, -- command prefixes, for example @[\'>\',\'@\',\'?\']@
- ircServer :: IrcServer -- list of 'Server's to connect to
-} deriving (Show)
+data Config = Config
+ { commandPrefix :: Char -- command prefixes, for example @[\'>\',\'@\',\'?\']@
+ , ircServer :: IrcServer -- list of 'Server's to connect to
+ } deriving (Show)
-- | An IRC server
data IrcServer = IrcServer
@@ -76,19 +76,19 @@ data Channel = Channel
, channelAdmins :: [String] -- the bot administrators
} deriving (Show)
--- | A Bot command
-data IntCmd = IntCmd
- { intCmd :: String -- the bot's internal command
- , intCmdParams :: [String] -- the parameters
- } deriving (Show)
-
--- |An IRC message.
+-- | An IRC message
data IrcMsg = IrcMsg
{ prefix :: Maybe String -- the message prefix
, command :: String -- the message command
, parameters :: [String] -- the message parameters
} deriving (Show)
+-- | An internal command
+data IntCmd = IntCmd
+ { intCmd :: String -- the internal command
+ , intMsg :: IrcMsg -- the IrcMsg associated with the command
+ }
+
-- | A plugin definition
data Plugin = Plugin
{ pluginName :: String -- The plugin's name
diff --git a/TODO b/TODO
new file mode 100644
index 0000000..6b06f7a
--- /dev/null
+++ b/TODO
@@ -0,0 +1,7 @@
+* implement InternalCommands "register command"
+* unregister command, add it to internal commands
+* kill threads
+* unload plugin
+
+* restore \r in IRCParser
+