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
63
Hsbot/Irc/Plugin/Core.hs
Normal file
63
Hsbot/Irc/Plugin/Core.hs
Normal file
|
@ -0,0 +1,63 @@
|
|||
module Hsbot.Irc.Plugin.Core
|
||||
( ircBotPluginCore
|
||||
) where
|
||||
|
||||
import Control.Concurrent (Chan, myThreadId)
|
||||
import Control.Exception
|
||||
import Control.Monad.State
|
||||
import Prelude hiding (catch)
|
||||
|
||||
import Hsbot.Irc.Message
|
||||
import Hsbot.Irc.PluginCommons
|
||||
|
||||
-- | The plugin's main entry point
|
||||
ircBotPluginCore :: Chan IrcBotMsg -> Chan IrcBotMsg -> IO ()
|
||||
ircBotPluginCore myChan masterChan = do
|
||||
threadId <- myThreadId
|
||||
let plugin = IrcPluginState { ircPluginName = "Core"
|
||||
, ircPluginThreadId = threadId
|
||||
, ircPluginChan = myChan
|
||||
, ircPluginMasterChan = masterChan }
|
||||
evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload"]) plugin
|
||||
plugin' <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin)
|
||||
evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload"]) plugin'
|
||||
|
||||
-- | The IrcPlugin monad main function
|
||||
run :: IrcPlugin ()
|
||||
run = forever $ do
|
||||
msg <- readMsg
|
||||
eval msg
|
||||
where
|
||||
eval :: IrcBotMsg -> IrcPlugin ()
|
||||
eval (IntIrcCmd intCmd) = do
|
||||
let request = ircCmdBotMsg intCmd
|
||||
case ircCmdCmd intCmd of
|
||||
"RUN" -> let stuff = words $ ircCmdMsg intCmd
|
||||
in case head stuff of
|
||||
"list" -> listPlugins request
|
||||
"load" -> loadPlugin $ tail stuff
|
||||
"reload" -> reloadPlugin $ tail stuff
|
||||
"unload" -> unloadPlugin $ tail stuff
|
||||
_ -> return () -- TODO : help message
|
||||
"ANSWER" -> let stuff = ircCmdMsg intCmd
|
||||
in answerMsg request ("Loaded plugins : " ++ stuff)
|
||||
_ -> return ()
|
||||
eval _ = return ()
|
||||
|
||||
-- | The list command
|
||||
listPlugins :: IrcMsg -> IrcPlugin ()
|
||||
listPlugins request = do
|
||||
sendCommandWithRequest "LIST" "CORE" (unwords []) request
|
||||
|
||||
-- | The load command
|
||||
loadPlugin :: [String] -> IrcPlugin ()
|
||||
loadPlugin pluginNames = mapM_ (sendCommand "LOAD" "CORE") pluginNames
|
||||
|
||||
-- | The reload command
|
||||
reloadPlugin :: [String] -> IrcPlugin ()
|
||||
reloadPlugin pluginNames = mapM_ (sendCommand "RELOAD" "CORE") pluginNames
|
||||
|
||||
-- | The unload command
|
||||
unloadPlugin :: [String] -> IrcPlugin ()
|
||||
unloadPlugin pluginNames = mapM_ (sendCommand "UNLOAD" "CORE") pluginNames
|
||||
|
Reference in a new issue