Some refactoring + cosmetics.

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."

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 ()

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

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 }
 

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
 

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

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

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
-

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 ()

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
 

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 ()
 

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

TODO

@@ -1,10 +1,21 @@
 :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
 
 * Write the quote module
-* clean the plugin module
-* part chan
+* 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?
 
-* add admin checks for cmds
+* write the help module
+* clean the plugin module
+* clean cleaning for the quote module
+* write a channel tracking plugin. Write the part chan command
+
+* 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