Cleaned that ugly update message handling and added a reboot command to the ircbot.
This commit is contained in:
Julien Dessaux
parent
8b33600f38
commit
451564ef5b
7 changed files with 75 additions and 58 deletions
|
|
@ -34,7 +34,7 @@ unregisterCommand cmd pluginName' = do
|
|||
put $ ircBot { ircBotCommands = newCmds }
|
||||
|
||||
-- | Processes an internal command
|
||||
processInternalCommand :: IrcBotMsg -> IrcBot ()
|
||||
processInternalCommand :: IrcBotMsg -> IrcBot (Bool)
|
||||
processInternalCommand (IntIrcCmd ircCmd)
|
||||
| ircCmdTo ircCmd == "CORE" = processCoreCommand ircCmd
|
||||
| otherwise = do
|
||||
|
|
@ -42,21 +42,23 @@ processInternalCommand (IntIrcCmd ircCmd)
|
|||
case M.lookup (ircCmdTo ircCmd) plugins of
|
||||
Just (plugin, _) -> sendToPlugin (IntIrcCmd ircCmd) plugin
|
||||
Nothing -> return ()
|
||||
processInternalCommand _ = return ()
|
||||
return False
|
||||
processInternalCommand _ = return (False)
|
||||
|
||||
-- | Processes a core command
|
||||
processCoreCommand :: IrcCmd -> IrcBot ()
|
||||
processCoreCommand :: IrcCmd -> IrcBot (Bool)
|
||||
processCoreCommand ircCmd = do
|
||||
let command' = ircCmdCmd ircCmd
|
||||
originalRequest = ircCmdBotMsg ircCmd
|
||||
case command' of
|
||||
"LIST" -> listPlugins originalRequest (ircCmdFrom ircCmd)
|
||||
"LOAD" -> loadIrcPlugin $ ircCmdMsg ircCmd
|
||||
"UNLOAD" -> unloadIrcPlugin $ ircCmdMsg ircCmd
|
||||
"UPDATE" -> processUpdateCommand ircCmd
|
||||
"REGISTER" -> registerCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd)
|
||||
"UNLOAD" -> unloadIrcPlugin $ ircCmdMsg ircCmd
|
||||
"UNREGISTER" -> unregisterCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd)
|
||||
"UPDATE" -> processUpdateCommand ircCmd
|
||||
_ -> return ()
|
||||
return $ command' == "REBOOT"
|
||||
|
||||
-- | Process an update command
|
||||
processUpdateCommand :: IrcCmd -> IrcBot ()
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@ startIrcbot config masterChan myChan = do
|
|||
putStrLn "[IrcBot] Spawning plugins..."
|
||||
ircBotState'' <- execStateT spawnIrcPlugins ircBotState'
|
||||
putStrLn "[IrcBot] Entering Core loop... "
|
||||
_ <- (execStateT ircBotLoop ircBotState'') `catch` (\(_ :: IOException) -> return (ircBotState''))
|
||||
(evalStateT ircBotLoop ircBotState'') `catch` (\(_ :: IOException) -> return ())
|
||||
return ()
|
||||
|
||||
--resumeIrcBot
|
||||
|
|
@ -103,8 +103,11 @@ ircBotLoop = forever $ do
|
|||
InIrcMsg inIrcMsg -> dispatchMessage $ InIrcMsg inIrcMsg
|
||||
OutIrcMsg outIrcMsg -> sendThisMessage outIrcMsg
|
||||
IntIrcCmd intIrcCmd -> do
|
||||
processInternalCommand $ IntIrcCmd intIrcCmd
|
||||
reboot <- processInternalCommand $ IntIrcCmd intIrcCmd
|
||||
reportUpdate
|
||||
if reboot
|
||||
then processRebootCommand
|
||||
else return ()
|
||||
where
|
||||
sendThisMessage :: IrcMsg -> IrcBot ()
|
||||
sendThisMessage outputMsg = do
|
||||
|
|
@ -142,10 +145,22 @@ reportUpdate :: IrcBot ()
|
|||
reportUpdate = do
|
||||
ircbot <- get
|
||||
let masterChan = ircBotMasterChan ircbot
|
||||
msg = IntMsg $ Msg { msgType = "UPDATE"
|
||||
, msgFrom = ircConfigName $ ircBotConfig ircbot
|
||||
, msgTo = "CORE"
|
||||
, msgCmd = show $ ircBotResumeData ircbot
|
||||
}
|
||||
msg = IntMsg $ Msg { msgType = "UPDATE"
|
||||
, msgFrom = ircConfigName $ ircBotConfig ircbot
|
||||
, msgTo = "CORE"
|
||||
, msgStuff = show $ ircBotResumeData ircbot
|
||||
}
|
||||
liftIO $ writeChan masterChan msg
|
||||
|
||||
-- | Process a reboot command
|
||||
processRebootCommand :: IrcBot ()
|
||||
processRebootCommand = do
|
||||
ircbot <- get
|
||||
let masterChan = ircBotMasterChan ircbot
|
||||
msg = IntMsg $ Msg { msgType = "REBOOT"
|
||||
, msgFrom = ircConfigName $ ircBotConfig ircbot
|
||||
, msgTo = "CORE"
|
||||
, msgStuff = show $ ircBotResumeData ircbot
|
||||
}
|
||||
liftIO $ writeChan masterChan msg
|
||||
|
||||
|
|
|
|||
|
|
@ -16,9 +16,9 @@ ircBotPluginCore myChan masterChan = do
|
|||
let plugin = IrcPluginState { ircPluginName = "Core"
|
||||
, ircPluginChan = myChan
|
||||
, ircPluginMasterChan = masterChan }
|
||||
evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload"]) plugin
|
||||
evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload", "reboot"]) plugin
|
||||
plugin' <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin)
|
||||
evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload"]) plugin'
|
||||
evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload", "reboot"]) plugin'
|
||||
|
||||
-- | The IrcPlugin monad main function
|
||||
run :: IrcPlugin ()
|
||||
|
|
@ -36,6 +36,7 @@ run = forever $ do
|
|||
"load" -> loadPlugin $ tail stuff
|
||||
"reload" -> reloadPlugin $ tail stuff
|
||||
"unload" -> unloadPlugin $ tail stuff
|
||||
"reboot" -> rebootBot $ tail stuff
|
||||
_ -> return () -- TODO : help message
|
||||
"ANSWER" -> let stuff = ircCmdMsg intCmd
|
||||
in answerMsg request ("Loaded plugins : " ++ stuff)
|
||||
|
|
@ -59,3 +60,7 @@ reloadPlugin pluginNames = mapM_ (sendCommand "RELOAD" "CORE") pluginNames
|
|||
unloadPlugin :: [String] -> IrcPlugin ()
|
||||
unloadPlugin pluginNames = mapM_ (sendCommand "UNLOAD" "CORE") pluginNames
|
||||
|
||||
-- | The reboot command
|
||||
rebootBot :: [String] -> IrcPlugin ()
|
||||
rebootBot stuff = sendCommand "REBOOT" "CORE" $ unwords stuff
|
||||
|
||||
|
|
|
|||
Reference in a new issue