summaryrefslogtreecommitdiff
path: root/Hsbot
diff options
context:
space:
mode:
authorJulien Dessaux2010-04-21 20:57:22 +0200
committerJulien Dessaux2010-04-21 20:57:22 +0200
commit4c76d3d40bbfea365283c13256b3e7cf2d2deb5e (patch)
treeb5f4e70d225ba0247ad0691e37b45b8cb4142f6c /Hsbot
parentFixed the clean killing of plugin's threads, fixed exception management and c... (diff)
downloadhsbot-4c76d3d40bbfea365283c13256b3e7cf2d2deb5e.tar.gz
hsbot-4c76d3d40bbfea365283c13256b3e7cf2d2deb5e.tar.bz2
hsbot-4c76d3d40bbfea365283c13256b3e7cf2d2deb5e.zip
Fixed several stuff.
Diffstat (limited to 'Hsbot')
-rw-r--r--Hsbot/Command.hs2
-rw-r--r--Hsbot/Core.hs6
-rw-r--r--Hsbot/IRC.hs3
-rw-r--r--Hsbot/IRCParser.hs4
-rw-r--r--Hsbot/Main.hs6
-rw-r--r--Hsbot/Types.hs4
6 files changed, 12 insertions, 13 deletions
diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs
index 76f1d04..3977a57 100644
--- a/Hsbot/Command.hs
+++ b/Hsbot/Command.hs
@@ -58,7 +58,7 @@ dispatchMessage (InputMsg inputMsg) = do
sendRunCommand cmd plugin = do
sendToPlugin (InternalCmd $ IntCmd "RUN" "CORE" (pluginName plugin) cmd) plugin
getMsgContent :: String
- getMsgContent = (parameters inputMsg) !! 1
+ getMsgContent = unwords . tail $ parameters inputMsg
dispatchMessage _ = return ()
-- | Processes an internal command
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index a8f29ec..e3ce3eb 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -4,9 +4,9 @@ module Hsbot.Core
) where
import Control.Concurrent
-import Control.Concurrent.Chan
+import Control.Concurrent.Chan()
import Control.Monad.State
-import Data.List
+import Data.List()
import qualified Data.Map as M
import Network
import System.IO
@@ -36,8 +36,8 @@ connectServer server = do
disconnectServer :: IrcBot ()
disconnectServer = do
bot <- get
- liftIO $ killThread $ readerThreadId bot
mapM_ unloadPlugin (M.keys $ botPlugins bot)
+ liftIO $ killThread $ readerThreadId bot
liftIO $ hClose $ botHandle bot
return ()
diff --git a/Hsbot/IRC.hs b/Hsbot/IRC.hs
index c837a4f..1eac2d8 100644
--- a/Hsbot/IRC.hs
+++ b/Hsbot/IRC.hs
@@ -23,7 +23,7 @@ initServer = do
-- | Run a server
runServer :: IrcBot ()
-runServer = do
+runServer = forever $ do
chan <- gets botChannel
let input = readChan chan
msg <- liftIO input
@@ -31,7 +31,6 @@ runServer = do
InputMsg inputMsg -> dispatchMessage $ InputMsg inputMsg
OutputMsg outputMsg -> sendstr (serializeIrcMsg outputMsg)
InternalCmd internalCmd -> processInternalCommand $ InternalCmd internalCmd
- runServer
-- | Joins a chan
joinChan :: String -> IrcBot ()
diff --git a/Hsbot/IRCParser.hs b/Hsbot/IRCParser.hs
index ebf8f71..a5f2e41 100644
--- a/Hsbot/IRCParser.hs
+++ b/Hsbot/IRCParser.hs
@@ -24,9 +24,9 @@ pMsg = do
pPrefix :: ParsecT String u Identity [Char]
pPrefix = do
- char ':'
+ _ <- char ':'
pfx <- many1 (noneOf " ")
- space
+ _ <- space
return pfx
pCommand :: ParsecT String u Identity [Char]
diff --git a/Hsbot/Main.hs b/Hsbot/Main.hs
index 592fefa..5bf03bf 100644
--- a/Hsbot/Main.hs
+++ b/Hsbot/Main.hs
@@ -5,7 +5,7 @@ module Hsbot.Main
import Control.Exception
import Control.Monad.State
import Prelude hiding (catch)
-import System.IO
+import System.IO()
import Config
import Hsbot.Core
@@ -17,8 +17,8 @@ import Hsbot.Types
imain :: IO ()
imain = do
bot <- connectServer $ ircServer config
- (execStateT run bot) `catch` (\(ex :: IOException) -> return bot)
- evalStateT disconnectServer bot
+ bot' <- (execStateT run bot) `catch` (\(_ :: IOException) -> return bot)
+ evalStateT disconnectServer bot'
-- | The Bot monad main function
run :: IrcBot ()
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
index 99619ee..acca137 100644
--- a/Hsbot/Types.hs
+++ b/Hsbot/Types.hs
@@ -13,7 +13,7 @@ module Hsbot.Types
) where
import Control.Concurrent
-import Control.Concurrent.Chan
+import Control.Concurrent.Chan()
import Control.Monad.State
import qualified Data.Map as M
import Network
@@ -97,7 +97,7 @@ data IntCmd = IntCmd
, intCmdMsg :: String -- the IrcMsg associated with the command
} deriving (Show)
-data BotMsg = InputMsg IrcMsg | OutputMsg IrcMsg | InternalCmd IntCmd
+data BotMsg = InputMsg IrcMsg | OutputMsg IrcMsg | InternalCmd IntCmd deriving (Show)
-- | A plugin (core side)
data Plugin = Plugin