diff options
| -rw-r--r-- | Config.hs | 4 | ||||
| -rw-r--r-- | Hsbot.hs | 2 | ||||
| -rw-r--r-- | Hsbot/Command.hs | 52 | ||||
| -rw-r--r-- | Hsbot/IRC.hs | 8 | ||||
| -rw-r--r-- | Hsbot/Types.hs | 22 | ||||
| -rw-r--r-- | TODO | 7 |
6 files changed, 79 insertions, 16 deletions
@@ -26,7 +26,7 @@ kro = IrcServer -- | User configuration config :: Config config = Config - { commandPrefixes = ['@'] - , ircServer = kro + { commandPrefix = '@' + , ircServer = kro } @@ -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 @@ -0,0 +1,7 @@ +* implement InternalCommands "register command" +* unregister command, add it to internal commands +* kill threads +* unload plugin + +* restore \r in IRCParser + |