Rewrote nearly everything!
* Rewrote the whole architecture to achieve extreme modularity * Added the ability to build a multiprotocol bot * Added cabal integration * Added configuration handling the XMonad style * Added configuration in ~/.hsbot * Refactored many many named and functions * Refactored data structures * Cleaned a big bunch of stuff
This commit is contained in:
parent
c20cfe88b3
commit
c1662ba7b9
33 changed files with 856 additions and 654 deletions
59
Hsbot/Irc/Command.hs
Normal file
59
Hsbot/Irc/Command.hs
Normal file
|
@ -0,0 +1,59 @@
|
|||
module Hsbot.Irc.Command
|
||||
( processInternalCommand
|
||||
, registerCommand
|
||||
, unregisterCommand
|
||||
) where
|
||||
|
||||
import Control.Monad.State
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
|
||||
import Hsbot.Irc.Message
|
||||
import Hsbot.Irc.Plugin
|
||||
import Hsbot.Irc.Types
|
||||
|
||||
-- | Registers a plugin's command
|
||||
registerCommand :: String -> String -> IrcBot ()
|
||||
registerCommand cmd pluginName' = do
|
||||
ircBot <- get
|
||||
let cmds = ircBotCommands ircBot
|
||||
plugins = ircBotPlugins ircBot
|
||||
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 $ ircBot { ircBotCommands = newCmds }
|
||||
Nothing -> return ()
|
||||
|
||||
-- | Unregisters a plugin's command
|
||||
unregisterCommand :: String -> String -> IrcBot ()
|
||||
unregisterCommand cmd pluginName' = do
|
||||
ircBot <- get
|
||||
let cmds = ircBotCommands ircBot
|
||||
newCmds = M.adjust (L.delete pluginName') cmd cmds
|
||||
put $ ircBot { ircBotCommands = newCmds }
|
||||
|
||||
-- | Processes an internal command
|
||||
processInternalCommand :: IrcBotMsg -> IrcBot ()
|
||||
processInternalCommand (IntIrcCmd ircCmd)
|
||||
| ircCmdTo ircCmd == "CORE" = processCoreCommand ircCmd
|
||||
| otherwise = do
|
||||
plugins <- gets ircBotPlugins
|
||||
case M.lookup (ircCmdTo ircCmd) plugins of
|
||||
Just plugin -> sendToPlugin (IntIrcCmd ircCmd) plugin
|
||||
Nothing -> return ()
|
||||
processInternalCommand _ = return ()
|
||||
|
||||
-- | Processes a core command
|
||||
processCoreCommand :: IrcCmd -> IrcBot ()
|
||||
processCoreCommand ircCmd = do
|
||||
let command' = ircCmdCmd ircCmd
|
||||
originalRequest = ircCmdBotMsg ircCmd
|
||||
case command' of
|
||||
"LIST" -> listPlugins originalRequest (ircCmdFrom ircCmd)
|
||||
"LOAD" -> loadIrcPlugin $ ircCmdMsg ircCmd
|
||||
"UNLOAD" -> unloadPlugin $ ircCmdMsg ircCmd
|
||||
"REGISTER" -> registerCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd)
|
||||
"UNREGISTER" -> unregisterCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd)
|
||||
_ -> return ()
|
||||
|
Reference in a new issue