diff -r 41e06b74c991 -r 709fdb89f76c gameServer/Actions.hs --- a/gameServer/Actions.hs Sun Oct 10 12:53:16 2010 -0400 +++ b/gameServer/Actions.hs Sun Oct 10 21:32:18 2010 +0400 @@ -98,30 +98,35 @@ (Just ci) <- gets clientIndex rnc <- gets roomsClients ri <- clientRoomA - when (ri /= lobbyId) $ do - processAction $ MoveToLobby ("quit: " `B.append` msg) - return () chan <- client's sendChan ready <- client's isReady + when (ri /= lobbyId) $ do + processAction $ MoveToLobby ("quit: " `B.append` msg) + liftIO $ modifyRoom rnc (\r -> r{ + --playersIDs = IntSet.delete ci (playersIDs r) + playersIn = (playersIn r) - 1, + readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r + }) ri + return () + liftIO $ do infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg)) --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom - modifyRoom rnc (\r -> r{ - --playersIDs = IntSet.delete ci (playersIDs r) - playersIn = (playersIn r) - 1, - readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r - }) ri processAction $ AnswerClients [chan] ["BYE", msg] - modify (\s -> s{removedClients = ci `Set.insert` removedClients s}) + + s <- get + put $! s{removedClients = ci `Set.insert` removedClients s} processAction (DeleteClient ci) = do rnc <- gets roomsClients liftIO $ removeClient rnc ci - modify (\s -> s{removedClients = ci `Set.delete` removedClients s}) + + s <- get + put $! s{removedClients = ci `Set.delete` removedClients s} {- where @@ -256,7 +261,7 @@ processAction $ MoveToRoom rId - chans <- liftM (map sendChan) $ roomClientsS lobbyId + chans <- liftM (map sendChan) $! roomClientsS lobbyId mapM_ processAction [ AnswerClients chans ["ROOM", "ADD", roomName] @@ -399,7 +404,7 @@ liftIO $ do ci <- addClient rnc client forkIO $ clientRecvLoop (clientSocket client) (coreChan si) ci - forkIO $ clientSendLoop (clientSocket client) (coreChan si) (sendChan client) ci + forkIO $ clientSendLoop (clientSocket client) (sendChan client) ci infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))