From 5b8cffbf6809b378aab9c6e1f7601112d810b709 Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Tue, 18 May 2010 00:46:36 +0200 Subject: Cleaned the definition of irc plugins' data structure. --- Hsbot/Irc/Plugin.hs | 2 +- Hsbot/Irc/Plugin/Core.hs | 2 +- Hsbot/Irc/Plugin/Dummy.hs | 2 +- Hsbot/Irc/Plugin/Ping.hs | 2 +- Hsbot/Irc/Plugin/Quote.hs | 2 +- Hsbot/Irc/Plugin/Utils.hs | 66 ++++++++++++++++++++++++++++++++++++++++++++++ Hsbot/Irc/PluginCommons.hs | 66 ---------------------------------------------- Hsbot/Irc/Types.hs | 2 +- 8 files changed, 72 insertions(+), 72 deletions(-) create mode 100644 Hsbot/Irc/Plugin/Utils.hs delete mode 100644 Hsbot/Irc/PluginCommons.hs (limited to 'Hsbot') diff --git a/Hsbot/Irc/Plugin.hs b/Hsbot/Irc/Plugin.hs index 525ab8f..3e6bef0 100644 --- a/Hsbot/Irc/Plugin.hs +++ b/Hsbot/Irc/Plugin.hs @@ -16,11 +16,11 @@ import qualified Data.Map as M import Hsbot.Irc.Config import Hsbot.Irc.Message -import Hsbot.Irc.PluginCommons import Hsbot.Irc.Plugin.Core import Hsbot.Irc.Plugin.Dummy import Hsbot.Irc.Plugin.Ping import Hsbot.Irc.Plugin.Quote +import Hsbot.Irc.Plugin.Utils import Hsbot.Irc.Types -- | Sends a msg to a plugin diff --git a/Hsbot/Irc/Plugin/Core.hs b/Hsbot/Irc/Plugin/Core.hs index 9987a89..0297e2c 100644 --- a/Hsbot/Irc/Plugin/Core.hs +++ b/Hsbot/Irc/Plugin/Core.hs @@ -8,7 +8,7 @@ import Control.Monad.State import Prelude hiding (catch) import Hsbot.Irc.Message -import Hsbot.Irc.PluginCommons +import Hsbot.Irc.Plugin.Utils -- | The plugin's main entry point ircBotPluginCore :: Chan IrcBotMsg -> Chan IrcBotMsg -> IO () diff --git a/Hsbot/Irc/Plugin/Dummy.hs b/Hsbot/Irc/Plugin/Dummy.hs index c543b90..4e10644 100644 --- a/Hsbot/Irc/Plugin/Dummy.hs +++ b/Hsbot/Irc/Plugin/Dummy.hs @@ -8,7 +8,7 @@ import Control.Monad.State import Prelude hiding (catch) import Hsbot.Irc.Message -import Hsbot.Irc.PluginCommons +import Hsbot.Irc.Plugin.Utils -- | The plugin's main entry point ircBotPluginDummy :: Chan IrcBotMsg -> Chan IrcBotMsg -> IO () diff --git a/Hsbot/Irc/Plugin/Ping.hs b/Hsbot/Irc/Plugin/Ping.hs index 90579c4..57418b3 100644 --- a/Hsbot/Irc/Plugin/Ping.hs +++ b/Hsbot/Irc/Plugin/Ping.hs @@ -8,7 +8,7 @@ import Control.Monad.State import Prelude hiding (catch) import Hsbot.Irc.Message -import Hsbot.Irc.PluginCommons +import Hsbot.Irc.Plugin.Utils -- | The plugin's main entry point ircBotPluginPing :: Chan IrcBotMsg -> Chan IrcBotMsg -> IO () diff --git a/Hsbot/Irc/Plugin/Quote.hs b/Hsbot/Irc/Plugin/Quote.hs index 31eaeaf..0335d8b 100644 --- a/Hsbot/Irc/Plugin/Quote.hs +++ b/Hsbot/Irc/Plugin/Quote.hs @@ -18,7 +18,7 @@ import System.Posix.Files import System.Random(randomRIO) import Hsbot.Irc.Message -import Hsbot.Irc.PluginCommons +import Hsbot.Irc.Plugin.Utils -- | A quote element data QuoteElt = QuoteElt diff --git a/Hsbot/Irc/Plugin/Utils.hs b/Hsbot/Irc/Plugin/Utils.hs new file mode 100644 index 0000000..1e54d3a --- /dev/null +++ b/Hsbot/Irc/Plugin/Utils.hs @@ -0,0 +1,66 @@ +module Hsbot.Irc.Plugin.Utils + ( IrcPlugin + , IrcPluginState (..) + , answerMsg + , readMsg + , sendCommand + , sendCommandWithRequest + , sendRegisterCommand + , sendUnregisterCommand + , writeMsg + ) where + +import Control.Concurrent +import Control.Concurrent.Chan () +import Control.Monad.State +import Data.Maybe (fromMaybe) + +import Hsbot.Irc.Message + +-- | The IrcPlugin monad +type IrcPlugin = StateT IrcPluginState IO + +-- | A plugin state +data IrcPluginState = IrcPluginState + { ircPluginName :: String -- The plugin's name + , ircPluginChan :: Chan IrcBotMsg -- The plugin chan + , ircPluginMasterChan :: Chan IrcBotMsg -- The master's chan + } + +--- | Basic input output for IrcPlugins +readMsg :: IrcPlugin (IrcBotMsg) +readMsg = do + chan <- gets ircPluginChan + input <- liftIO $ readChan chan + return input + +writeMsg :: IrcBotMsg -> IrcPlugin () +writeMsg (OutIrcMsg msg) = do + chan <- gets ircPluginMasterChan + liftIO $ writeChan chan (OutIrcMsg msg) +writeMsg _ = return () + +answerMsg :: IrcMsg -> String -> IrcPlugin () +answerMsg request msg = do + let chanOrigin = head $ ircMsgParameters request + sender = takeWhile (/= '!') $ fromMaybe "" (ircMsgPrefix request) + case head chanOrigin of + '#' -> writeMsg . OutIrcMsg $ IrcMsg Nothing "PRIVMSG" [chanOrigin, msg] + _ -> writeMsg . OutIrcMsg $ IrcMsg Nothing "PRIVMSG" [sender, msg] + +-- | Command management +sendCommand :: String -> String -> String -> IrcPlugin () +sendCommand cmd to params = sendCommandWithRequest cmd to params emptyIrcMsg + +sendCommandWithRequest :: String -> String -> String -> IrcMsg -> IrcPlugin () +sendCommandWithRequest cmd to params originalRequest = do + masterChan <- gets ircPluginMasterChan + from <- gets ircPluginName + liftIO . writeChan masterChan . IntIrcCmd $ IrcCmd cmd from to params originalRequest + +sendRegisterCommand :: String -> IrcPlugin () +sendRegisterCommand cmd = sendCommand "REGISTER" "CORE" cmd + +sendUnregisterCommand :: String -> IrcPlugin () +sendUnregisterCommand cmd = sendCommand "UNREGISTER" "CORE" cmd + diff --git a/Hsbot/Irc/PluginCommons.hs b/Hsbot/Irc/PluginCommons.hs deleted file mode 100644 index 51f9473..0000000 --- a/Hsbot/Irc/PluginCommons.hs +++ /dev/null @@ -1,66 +0,0 @@ -module Hsbot.Irc.PluginCommons - ( IrcPlugin - , IrcPluginState (..) - , answerMsg - , readMsg - , sendCommand - , sendCommandWithRequest - , sendRegisterCommand - , sendUnregisterCommand - , writeMsg - ) where - -import Control.Concurrent -import Control.Concurrent.Chan () -import Control.Monad.State -import Data.Maybe (fromMaybe) - -import Hsbot.Irc.Message - --- | The IrcPlugin monad -type IrcPlugin = StateT IrcPluginState IO - --- | A plugin state -data IrcPluginState = IrcPluginState - { ircPluginName :: String -- The plugin's name - , ircPluginChan :: Chan IrcBotMsg -- The plugin chan - , ircPluginMasterChan :: Chan IrcBotMsg -- The master's chan - } - ---- | Basic input output for IrcPlugins -readMsg :: IrcPlugin (IrcBotMsg) -readMsg = do - chan <- gets ircPluginChan - input <- liftIO $ readChan chan - return input - -writeMsg :: IrcBotMsg -> IrcPlugin () -writeMsg (OutIrcMsg msg) = do - chan <- gets ircPluginMasterChan - liftIO $ writeChan chan (OutIrcMsg msg) -writeMsg _ = return () - -answerMsg :: IrcMsg -> String -> IrcPlugin () -answerMsg request msg = do - let chanOrigin = head $ ircMsgParameters request - sender = takeWhile (/= '!') $ fromMaybe "" (ircMsgPrefix request) - case head chanOrigin of - '#' -> writeMsg . OutIrcMsg $ IrcMsg Nothing "PRIVMSG" [chanOrigin, msg] - _ -> writeMsg . OutIrcMsg $ IrcMsg Nothing "PRIVMSG" [sender, msg] - --- | Command management -sendCommand :: String -> String -> String -> IrcPlugin () -sendCommand cmd to params = sendCommandWithRequest cmd to params emptyIrcMsg - -sendCommandWithRequest :: String -> String -> String -> IrcMsg -> IrcPlugin () -sendCommandWithRequest cmd to params originalRequest = do - masterChan <- gets ircPluginMasterChan - from <- gets ircPluginName - liftIO . writeChan masterChan . IntIrcCmd $ IrcCmd cmd from to params originalRequest - -sendRegisterCommand :: String -> IrcPlugin () -sendRegisterCommand cmd = sendCommand "REGISTER" "CORE" cmd - -sendUnregisterCommand :: String -> IrcPlugin () -sendUnregisterCommand cmd = sendCommand "UNREGISTER" "CORE" cmd - diff --git a/Hsbot/Irc/Types.hs b/Hsbot/Irc/Types.hs index 7ee716f..78e663b 100644 --- a/Hsbot/Irc/Types.hs +++ b/Hsbot/Irc/Types.hs @@ -13,7 +13,7 @@ import System.IO import Hsbot.Irc.Config import Hsbot.Irc.Message -import Hsbot.Irc.PluginCommons +import Hsbot.Irc.Plugin.Utils import Hsbot.Message -- | The Ircbot monad -- cgit v1.2.3