Some refactoring + cosmetics.

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