diff -r 3bf9dc791f45 -r 1d8c4a5ec622 netserver/newhwserv.hs --- a/netserver/newhwserv.hs Wed Apr 30 16:50:28 2008 +0000 +++ b/netserver/newhwserv.hs Wed Apr 30 19:44:54 2008 +0000 @@ -6,8 +6,10 @@ import Control.Concurrent import Control.Concurrent.STM import Control.Exception (finally) -import Control.Monad (forM, filterM, liftM) +import Control.Monad (forM, forM_, filterM, liftM) +import Data.List import Miscutils +import HWProto acceptLoop :: Socket -> TChan ClientInfo -> IO () acceptLoop servSock acceptChan = do @@ -36,15 +38,21 @@ case r of Left ci -> do mainLoop servSock acceptChan (ci:clients) rooms - Right (line, clhandle) -> do - --handleCmd handle line - clients' <- forM clients $ + Right (line, client) -> do + let (doQuit, toMe, strs) = handleCmd client sameRoom rooms line + + clients' <- forM sameRoom $ \ci -> do - hPutStrLn (handle ci) line - hFlush (handle ci) - return [ci] - `catch` const (hClose (handle ci) >> return []) - mainLoop servSock acceptChan (concat clients') rooms + 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 + where + sameRoom = filter (\cl -> room cl == room client) clients startServer serverSocket = do acceptChan <- atomically newTChan