summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Config.hs2
-rw-r--r--Hsbot/Command.hs4
-rw-r--r--Hsbot/Core.hs8
-rw-r--r--Hsbot/IRC.hs8
-rw-r--r--Hsbot/IRCParser.hs2
-rw-r--r--Hsbot/IRCPlugin.hs33
-rw-r--r--Hsbot/Plugin.hs2
-rw-r--r--Hsbot/Types.hs41
-rw-r--r--Hsbot/Utils.hs2
-rw-r--r--Plugins/Core.hs9
-rw-r--r--Plugins/Ping.hs2
-rw-r--r--Plugins/Quote.hs4
-rw-r--r--TODO15
13 files changed, 70 insertions, 62 deletions
diff --git a/Config.hs b/Config.hs
index a483232..fbf98b1 100644
--- a/Config.hs
+++ b/Config.hs
@@ -16,7 +16,7 @@ localhost :: IrcServer
localhost = IrcServer
{ serverAddress = "localhost"
, serverPort = PortNumber 6667
- , joinChannels = ["#shbot"]
+ , joinChannels = ["#shbot", "#geek"]
, nickname = "hsbot"
, password = ""
, realname = "The One True bot, with it's haskell soul."
diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs
index 711aa32..4653618 100644
--- a/Hsbot/Command.hs
+++ b/Hsbot/Command.hs
@@ -42,7 +42,7 @@ dispatchMessage (InputMsg inputMsg)
| isPluginCommand = do
plugins <- gets botPlugins
cmds <- gets botCommands
- let key = tail $ head $ words getMsgContent
+ let key = tail . head $ words getMsgContent
pluginNames = fromMaybe [] $ M.lookup key cmds
plugins' = fromMaybe [] $ mapM (flip M.lookup plugins) pluginNames
mapM_ (sendRunCommand $ tail getMsgContent) plugins'
@@ -56,7 +56,7 @@ dispatchMessage (InputMsg inputMsg)
, (head getMsgContent) == (commandPrefix config) ]
sendRunCommand :: String -> Plugin -> IrcBot ()
sendRunCommand cmd plugin = do
- sendToPlugin (InternalCmd $ IntCmd "RUN" "CORE" (pluginName plugin) cmd (Just inputMsg)) plugin
+ sendToPlugin (InternalCmd $ IntCmd "RUN" "CORE" (pluginName plugin) cmd inputMsg) plugin
getMsgContent :: String
getMsgContent = unwords . tail $ parameters inputMsg
dispatchMessage _ = return ()
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index 2195525..ab2989a 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -5,7 +5,7 @@ module Hsbot.Core
import Control.Concurrent
import Control.Concurrent.Chan()
-import Control.Exception
+import Control.Exception(IOException, catch)
import Control.Monad.State
import Data.List()
import qualified Data.Map as M
@@ -44,10 +44,10 @@ disconnectServer = do
mapM_ unloadPlugin (M.keys $ botPlugins bot)
liftIO $ putStrLn"done."
liftIO $ putStr "Closing server communication channel... "
- liftIO $ killThread $ readerThreadId bot
+ liftIO . killThread $ readerThreadId bot
liftIO $ putStrLn "done."
- liftIO $ putStr $ "Disconnecting from " ++ name ++ "... "
- liftIO $ hClose $ botHandle bot
+ liftIO . putStr $ "Disconnecting from " ++ name ++ "... "
+ liftIO . hClose $ botHandle bot
liftIO $ putStrLn "done."
-- | Socket reading loop
diff --git a/Hsbot/IRC.hs b/Hsbot/IRC.hs
index 1eac2d8..4a0e5f8 100644
--- a/Hsbot/IRC.hs
+++ b/Hsbot/IRC.hs
@@ -15,10 +15,10 @@ import Hsbot.Utils
initServer :: IrcBot ()
initServer = do
server <- gets serverConfig
- sendstr $ serializeIrcMsg $ IrcMsg Nothing "NICK" [(nickname server)]
- sendstr $ serializeIrcMsg $ IrcMsg Nothing "USER" [(nickname server), "0", "*", (realname server)]
+ sendstr . serializeIrcMsg $ IrcMsg Nothing "NICK" [(nickname server)]
+ sendstr . serializeIrcMsg $ IrcMsg Nothing "USER" [(nickname server), "0", "*", (realname server)]
when (not . null $ password server) $ do
- sendstr $ serializeIrcMsg $ IrcMsg Nothing "PRIVMSG" ["nickserv", "identify", (password server)]
+ sendstr . serializeIrcMsg $ IrcMsg Nothing "PRIVMSG" ["nickserv", "identify", (password server)]
mapM_ joinChan (joinChannels server)
-- | Run a server
@@ -40,6 +40,6 @@ joinChan name = do
newChannel = Channel name
(nickname $ serverConfig bot)
(administrators $ serverConfig bot)
- sendstr $ serializeIrcMsg $ IrcMsg Nothing "JOIN" [name]
+ sendstr . serializeIrcMsg $ IrcMsg Nothing "JOIN" [name]
put $ bot { chans = newChannel : oldChannels }
diff --git a/Hsbot/IRCParser.hs b/Hsbot/IRCParser.hs
index 263ac1f..d284377 100644
--- a/Hsbot/IRCParser.hs
+++ b/Hsbot/IRCParser.hs
@@ -18,7 +18,7 @@ pMsg = do
pfx <- optionMaybe pPrefix
cmd <- pCommand
params <- many (char ' ' >> (pLongParam <|> pShortParam))
- char '\r'
+ _ <- char '\r'
--eof
return $ IrcMsg pfx cmd params
diff --git a/Hsbot/IRCPlugin.hs b/Hsbot/IRCPlugin.hs
index 4707ce1..e0299fc 100644
--- a/Hsbot/IRCPlugin.hs
+++ b/Hsbot/IRCPlugin.hs
@@ -1,5 +1,7 @@
module Hsbot.IRCPlugin
- ( answerMsg
+ ( IrcPlugin
+ , PluginState(..)
+ , answerMsg
, readMsg
, sendCommand
, sendCommandWithRequest
@@ -14,6 +16,16 @@ import Data.Maybe(fromMaybe)
import Hsbot.Types
+-- | The IrcPlugin monad
+type IrcPlugin a = StateT PluginState IO a
+
+-- | An IRCPlugin state
+data PluginState = PluginState
+ { instanceName :: String -- The plugin's name
+ , instanceServerChan :: Chan BotMsg -- The server channel
+ , instanceChan :: Chan BotMsg -- The plugin channel
+ }
+
-- | Basic input output for IrcPlugins
readMsg :: IrcPlugin (BotMsg)
readMsg = do
@@ -24,26 +36,25 @@ readMsg = do
writeMsg :: BotMsg -> IrcPlugin ()
writeMsg botMsg = do
serverChan <- gets instanceServerChan
- liftIO $ writeChan serverChan $ botMsg
+ liftIO . writeChan serverChan $ botMsg
-answerMsg :: Maybe IrcMsg -> String -> IrcPlugin ()
+answerMsg :: IrcMsg -> String -> IrcPlugin ()
answerMsg request msg = do
- let incoming = fromMaybe (IrcMsg Nothing "ARGH" []) request
- chanOrigin = head $ parameters (incoming)
- sender = takeWhile (/= '!') $ fromMaybe "ARGH" (prefix incoming)
+ let chanOrigin = head $ parameters request
+ sender = takeWhile (/= '!') $ fromMaybe "" (prefix request)
case head chanOrigin of
- '#' -> writeMsg $ OutputMsg $ IrcMsg Nothing "PRIVMSG" [chanOrigin, msg]
- _ -> writeMsg $ OutputMsg $ IrcMsg Nothing "PRIVMSG" [sender, msg]
+ '#' -> writeMsg . OutputMsg $ IrcMsg Nothing "PRIVMSG" [chanOrigin, msg]
+ _ -> writeMsg . OutputMsg $ IrcMsg Nothing "PRIVMSG" [sender, msg]
-- | Commands management
sendCommand :: String -> String -> String -> IrcPlugin ()
-sendCommand cmd to params = sendCommandWithRequest cmd to params Nothing
+sendCommand cmd to params = sendCommandWithRequest cmd to params emptyIrcMsg
-sendCommandWithRequest :: String -> String -> String -> Maybe IrcMsg -> IrcPlugin ()
+sendCommandWithRequest :: String -> String -> String -> IrcMsg -> IrcPlugin ()
sendCommandWithRequest cmd to params originalRequest = do
serverChan <- gets instanceServerChan
from <- gets instanceName
- liftIO $ writeChan serverChan $ InternalCmd $ IntCmd cmd from to params originalRequest
+ liftIO . writeChan serverChan . InternalCmd $ IntCmd cmd from to params originalRequest
sendRegisterCommand :: String -> IrcPlugin ()
sendRegisterCommand cmd = sendCommand "REGISTER" "CORE" cmd
diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
index 43ce0fb..13d0efc 100644
--- a/Hsbot/Plugin.hs
+++ b/Hsbot/Plugin.hs
@@ -33,7 +33,7 @@ effectivelyLoadPlugin name entryPoint serverChan = do
return $ Plugin name threadId chan
-- | Sends a list of loaded plugins
-listPlugins :: Maybe IrcMsg -> String -> IrcBot ()
+listPlugins :: IrcMsg -> String -> IrcBot ()
listPlugins originalRequest dest = do
plugins <- gets botPlugins
let listing = unwords $ M.keys plugins
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
index 436bbdf..aa45f8b 100644
--- a/Hsbot/Types.hs
+++ b/Hsbot/Types.hs
@@ -7,9 +7,8 @@ module Hsbot.Types
, IrcServer(..)
, IrcBot
, IrcMsg(..)
- , IrcPlugin
, Plugin(..)
- , PluginInstance(..)
+ , emptyIrcMsg
) where
import Control.Concurrent
@@ -47,11 +46,6 @@ instance Show IrcServer where
UnixSocket u -> show u)
++ (show c) ++ (show n) ++ (show pa) ++ (show r) ++ (show ad)
--- instance Show PortID where
--- show (PortNumber n) = show n
--- show (Service s) = show s
--- show (UnixSocket g) = show g
-
-- | The IrcBot monad
type IrcBot a = StateT Bot IO a
@@ -68,11 +62,11 @@ data Bot = Bot
}
instance Show Bot where
- show (Bot _ s h c p _ _ cmds) = "Start time : " ++ (show s) ++ "\n"
- ++ "Handle : " ++ (show h) ++ "\n"
- ++ "Channels : " ++ (show c) ++ "\n"
- ++ "Plugins : " ++ (show p) ++ "\n"
- ++ "Commands : " ++ (show cmds) ++ "\n"
+ show (Bot _ s h c p _ _ cmds) = unlines [ "Start time : " ++ (show s)
+ , "Handle : " ++ (show h)
+ , "Channels : " ++ (show c)
+ , "Plugins : " ++ (show p)
+ , "Commands : " ++ (show cmds)]
-- | A channel connection
data Channel = Channel
@@ -88,13 +82,16 @@ data IrcMsg = IrcMsg
, parameters :: [String] -- the message parameters
} deriving (Show)
+emptyIrcMsg :: IrcMsg
+emptyIrcMsg = IrcMsg Nothing "" []
+
-- | An internal command
data IntCmd = IntCmd
- { intCmdCmd :: String -- the internal command
- , intCmdFrom :: String -- who issues it
- , intCmdTo :: String -- who it is destinated to
- , intCmdMsg :: String -- the message to be transfered
- , intCmdBotMsg :: Maybe IrcMsg -- An IrcMsg attached to the command
+ { intCmdCmd :: String -- the internal command
+ , intCmdFrom :: String -- who issues it
+ , intCmdTo :: String -- who it is destinated to
+ , intCmdMsg :: String -- the message to be transfered
+ , intCmdBotMsg :: IrcMsg -- An IrcMsg attached to the command
} deriving (Show)
data BotMsg = InputMsg IrcMsg | OutputMsg IrcMsg | InternalCmd IntCmd deriving (Show)
@@ -109,13 +106,3 @@ data Plugin = Plugin
instance Show Plugin where
show (Plugin name _ _) = show name
--- | A IrcPlugin ("user" side)
-data PluginInstance = PluginInstance
- { instanceName :: String -- The plugin's name
- , instanceServerChan :: Chan BotMsg -- The server channel
- , instanceChan :: Chan BotMsg -- The plugin channel
- }
-
--- | The IrcPlugin monad
-type IrcPlugin a = StateT PluginInstance IO a
-
diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs
index a58fd0c..247a65c 100644
--- a/Hsbot/Utils.hs
+++ b/Hsbot/Utils.hs
@@ -16,7 +16,7 @@ import Hsbot.Types
-- |Wrap a string with ANSI escape sequences.
inColor :: String -> [Int] -> String
inColor str vals = "\ESC[" ++ valstr ++ "m" ++ str ++ "\ESC[0m"
- where valstr = concat $ intersperse ";" $ map show vals
+ where valstr = concat . intersperse ";" $ map show vals
-- | Sends a string over handle
sendstr :: String -> IrcBot ()
diff --git a/Plugins/Core.hs b/Plugins/Core.hs
index f6bd4ef..f81f4bf 100644
--- a/Plugins/Core.hs
+++ b/Plugins/Core.hs
@@ -5,7 +5,6 @@ module Plugins.Core
import Control.Concurrent.Chan(Chan)
import Control.Exception
import Control.Monad.State
-import Data.Maybe(fromMaybe)
import Prelude hiding (catch)
import Hsbot.IRCPlugin
@@ -15,7 +14,7 @@ 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
+ let plugin = PluginState "Core" serverChan chan
evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload"]) plugin
plugin' <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin)
evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload"]) plugin'
@@ -36,15 +35,15 @@ run = forever $ do
"load" -> loadPlugin $ tail stuff
"reload" -> reloadPlugin $ tail stuff
"unload" -> unloadPlugin $ tail stuff
- _ -> lift $ trace $ show intCmd -- TODO : help message
+ _ -> lift . trace $ show intCmd -- TODO : help message
"ANSWER" -> let stuff = intCmdMsg intCmd
in answerMsg request ("Loaded plugins : " ++ stuff)
- _ -> lift $ trace $ show intCmd
+ _ -> lift . trace $ show intCmd
eval (InputMsg _) = return ()
eval _ = return ()
-- | The list command
-listPlugins :: Maybe IrcMsg -> IrcPlugin ()
+listPlugins :: IrcMsg -> IrcPlugin ()
listPlugins request = do
sendCommandWithRequest "LIST" "CORE" (unwords []) request
diff --git a/Plugins/Ping.hs b/Plugins/Ping.hs
index f478582..5da3f2f 100644
--- a/Plugins/Ping.hs
+++ b/Plugins/Ping.hs
@@ -13,7 +13,7 @@ import Hsbot.Types
-- | The plugin's main entry point
mainPing :: Chan BotMsg -> Chan BotMsg -> IO ()
mainPing serverChan chan = do
- let plugin = PluginInstance "Ping" serverChan chan
+ let plugin = PluginState "Ping" serverChan chan
_ <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin)
return ()
diff --git a/Plugins/Quote.hs b/Plugins/Quote.hs
index df16006..db473f9 100644
--- a/Plugins/Quote.hs
+++ b/Plugins/Quote.hs
@@ -29,9 +29,9 @@ type QuoteBot a = StateT QuoteDB IO a
-- | The plugin's main entry point
mainQuote :: Chan BotMsg -> Chan BotMsg -> IO ()
mainQuote serverChan chan = do
- let plugin = PluginInstance "Quote" serverChan chan
+ let plugin = PluginState "Quote" serverChan chan
evalStateT (mapM_ sendRegisterCommand ["quote"]) plugin
- (execStateT run plugin) `catch` (\(ex :: AsyncException) -> return plugin)
+ _ <- (evalStateT (run quoteBot) plugin) `catch` (\(_ :: AsyncException) -> return quoteBot)
evalStateT (mapM_ sendUnregisterCommand ["quote"]) plugin
-- | The IrcPlugin monad main function
diff --git a/TODO b/TODO
index 9ec408e..b7bb080 100644
--- a/TODO
+++ b/TODO
@@ -1,10 +1,21 @@
:julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
* Write the quote module
+* write the vote system for the quote module
+* only the quote reporter should be able to edit it
+* detect too identical quoting in a raw, or implement quote abort
+* handle the case we attempt to quote on an empty database
+* solve the multiquote problem about the quote owner (with a quoteElem data structure)
+* find a better way to track who voted for what?
+
+* write the help module
* clean the plugin module
-* part chan
+* clean cleaning for the quote module
+* write a channel tracking plugin. Write the part chan command
-* add admin checks for cmds
+* add a plugin for admin checks and tracking
+* add the quoteadm command to the quote module
+* add a plugin for timer functionnalities other plugin could subscribe to (the troll plugin).
* add register for casual conversations for plugins?
* add a "I have stuff to save so don't kill me too hard" status for plugins
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 00:38:43 +0000