Began a complete rewrite of command and plugin management.
Wrote a command routing statement, added an IrcPlugin monad.
This commit is contained in:
parent
047a10bc9b
commit
fd8d5faf5f
12 changed files with 244 additions and 87 deletions
49
Plugins/Core.hs
Normal file
49
Plugins/Core.hs
Normal 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
|
||||
|
|
@ -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 ()
|
||||
|
||||
|
|
|
@ -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 ()
|
||||
|
||||
|
|
Reference in a new issue