Properly handle QUIT command. Now, we can concentrate on protocol implementation
--- a/netserver/HWProto.hs Wed Apr 30 19:44:54 2008 +0000
+++ b/netserver/HWProto.hs Wed Apr 30 20:14:09 2008 +0000
@@ -3,5 +3,12 @@
import IO
import Miscutils
-handleCmd :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> String -> (Bool, Bool, [String])
-handleCmd _ _ _ ('Q':'U':'I':'T':xs) = (True, False, [])
+handleCmd :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (Bool, [ClientInfo], [String])
+
+handleCmd client clients _ ("QUIT":xs) =
+ if null (room client) then
+ (True, [client], ["QUIT"])
+ else
+ (True, clients, ["QUIT " ++ nick client])
+
+handleCmd client _ _ _ = (False, [client], ["Bad command"])
--- a/netserver/newhwserv.hs Wed Apr 30 19:44:54 2008 +0000
+++ b/netserver/newhwserv.hs Wed Apr 30 20:14:09 2008 +0000
@@ -39,20 +39,21 @@
Left ci -> do
mainLoop servSock acceptChan (ci:clients) rooms
Right (line, client) -> do
- let (doQuit, toMe, strs) = handleCmd client sameRoom rooms line
+ let (doQuit, recipients, strs) = handleCmd client sameRoom rooms $ words line
- clients' <- forM sameRoom $
+ clients' <- forM recipients $
\ci -> do
- if (handle ci /= handle client) || toMe then do
forM_ strs (\str -> hPutStrLn (handle ci) str)
hFlush (handle ci)
return []
- else if doQuit then return [ci] else return []
`catch` const (hClose (handle ci) >> return [ci])
- mainLoop servSock acceptChan (deleteFirstsBy (\ a b -> handle a == handle b) clients (concat clients')) rooms
+ client' <- if doQuit then hClose (handle client) >> return [client] else return []
+
+ mainLoop servSock acceptChan (remove (remove clients (concat clients')) client') rooms
where
sameRoom = filter (\cl -> room cl == room client) clients
+ remove list rmClients = deleteFirstsBy (\ a b -> handle a == handle b) list rmClients
startServer serverSocket = do
acceptChan <- atomically newTChan