Archived
1
0
Fork 0

Began a complete rewrite of command and plugin management.

Wrote a command routing statement, added an IrcPlugin monad.
This commit is contained in:
Julien Dessaux 2010-02-04 21:05:37 +01:00
parent 047a10bc9b
commit fd8d5faf5f
12 changed files with 244 additions and 87 deletions

49
Plugins/Core.hs Normal file
View file

@ -0,0 +1,49 @@
module Plugins.Core
( mainCore
) where
import Control.Concurrent.Chan
import Hsbot.IRCPlugin
import Hsbot.Types
import Hsbot.Utils
-- | The plugin's main entry point
mainCore :: Chan BotMsg -> Chan BotMsg -> IO ()
mainCore serverChan chan = do
let plugin = PluginInstance "Core" serverChan chan
(runStateT run plugin) `catch` (const $ return ((), plugin))
return ()
-- | The IrcPlugin monad main function
run :: IrcPlugin ()
run = do
mapM_ sendRegisterCommand ["load", "unload"]
runPlugin
mapM_ sendUnregisterCommand ["load", "unload"]
runPlugin :: IrcPlugin ()
runPlugin = forever $ do
msg <- readMsg
eval msg
where
eval :: BotMsg -> IrcPlugin ()
eval (InternalCmd intCmd) = do
case intCmdCmd intCmd of
"RUN" -> let stuff = words $ intCmdMsg intCmd
in case head stuff of
"load" -> loadPlugin $ tail stuff
"unload" -> unloadPlugin $ tail stuff
_ -> lift $ trace $ show intCmd -- TODO : help message
_ -> lift $ trace $ show intCmd
eval (InputMsg msg) = return ()
eval _ = return ()
-- | The load command
loadPlugin :: [String] -> IrcPlugin ()
loadPlugin pluginNames = mapM_ (sendCommand "LOAD" "CORE") pluginNames
-- | The unload command
unloadPlugin :: [String] -> IrcPlugin ()
unloadPlugin pluginNames = mapM_ (sendCommand "UNLOAD" "CORE") pluginNames

View file

@ -3,20 +3,27 @@ module Plugins.Ping
) where
import Control.Concurrent.Chan
import Control.Monad.State
import Hsbot.IRCPlugin
import Hsbot.Types
-- | The plugin's main entry point
mainPing :: Chan BotMsg -> Chan BotMsg -> IO ()
mainPing serverChan chan = do
loop
where
loop = do
input <- readChan chan
eval input
loop
eval :: BotMsg -> IO ()
eval (InputMsg msg)
| (command msg) == "PING" = writeChan serverChan $ OutputMsg $ IrcMsg Nothing "PONG" (parameters msg)
| otherwise = return ()
eval _ = return ()
let plugin = PluginInstance "Ping" serverChan chan
(runStateT run plugin) `catch` (const $ return ((), plugin))
return ()
-- | The IrcPlugin monad main function
run :: IrcPlugin ()
run = forever $ do
msg <- readMsg
eval msg
where
eval :: BotMsg -> IrcPlugin ()
eval (InputMsg msg)
| (command msg) == "PING" = writeMsg $ OutputMsg $ IrcMsg Nothing "PONG" (parameters msg)
| otherwise = return ()
eval _ = return ()

View file

@ -6,7 +6,7 @@ import Control.Concurrent.Chan
import Control.Monad.State
import System.Time (ClockTime)
import Hsbot.Core
import Hsbot.IRCPlugin
import Hsbot.Types
import Hsbot.Utils
@ -24,24 +24,35 @@ type QuoteDB = [Quote]
-- | The QuoteBot monad
type QuoteBot a = StateT QuoteDB IO a
-- | The main function of the Quote module
-- | The plugin's main entry point
mainQuote :: Chan BotMsg -> Chan BotMsg -> IO ()
mainQuote serverChan chan = do
writeChan serverChan $ InternalCmd $ IntCmd "REGISTER COMMAND quote Quote" emptyMsg
loop
where
loop = do
input <- readChan chan
eval input
loop
eval :: BotMsg -> IO ()
eval (InternalCmd intCmd) = do
let command' = words $ internalCommand intCmd
case command' !! 0 of
"runCommand" -> case (command' !! 1) of
"quote" -> writeChan serverChan $ OutputMsg $ internalCommandMsg intCmd
_ -> trace $ show command' -- TODO : help message
_ -> trace $ show command'
eval (InputMsg msg) = return ()
eval _ = return ()
let plugin = PluginInstance "Quote" serverChan chan
(runStateT run plugin) `catch` (const $ return ((), plugin))
return ()
-- | The IrcPlugin monad main function
run :: IrcPlugin ()
run = do
-- TODO : init quote handling (sqlite + structure to handle temporary stuff)
sendRegisterCommand "quote"
runPlugin
sendUnregisterCommand "quote"
-- TODO : send cancel messages for all temporary stuff
runPlugin :: IrcPlugin ()
runPlugin = forever $ do
msg <- readMsg
eval msg
where
eval :: BotMsg -> IrcPlugin ()
eval (InternalCmd intCmd) = do
case intCmdCmd intCmd of
"RUN" -> let stuff = words $ intCmdMsg intCmd
in case head stuff of
"quote" -> lift $ trace $ "Quote module has been invoked for: " ++ (show intCmd)
_ -> lift $ trace $ show intCmd -- TODO : help message
_ -> lift $ trace $ show intCmd
eval (InputMsg msg) = return ()
eval _ = return ()