--- a/gameServer/Actions.hs Sun Jan 27 21:46:25 2013 +0400
+++ b/gameServer/Actions.hs Mon Jan 28 00:50:00 2013 +0400
@@ -85,7 +85,7 @@
rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
rnf a = a `seq` ()
---instance NFData B.ByteString
+instance NFData B.ByteString
instance NFData (Chan a)
@@ -648,12 +648,19 @@
processAction Stats = do
cls <- allClientsS
- let stats = versions cls
- processAction $ Warning stats
- where
- versions = B.concat . ((:) "<table border=1>") . (flip (++) ["</table>"])
- . concatMap (\(p, n :: Int) -> ["<tr><td>", protoNumber2ver p, "</td><td>", showB n, "</td></tr>"])
- . Map.toList . Map.fromListWith (+) . map (\c -> (clientProto c, 1))
+ rms <- allRoomsS
+ let clientsMap = Map.fromListWith (+) . map (\c -> (clientProto c, 1 :: Int)) $ cls
+ let roomsMap = Map.fromListWith (+) . map (\c -> (roomProto c, 1 :: Int)) . filter ((/=) 0 . roomProto) $ rms
+ let keys = Map.keysSet clientsMap `Set.union` Map.keysSet roomsMap
+ let versionsStats = B.concat . ((:) "<table border=1>") . (flip (++) ["</table>"])
+ . concatMap (\p -> [
+ "<tr><td>", protoNumber2ver p
+ , "</td><td>", showB $ Map.findWithDefault 0 p clientsMap
+ , "</td><td>", showB $ Map.findWithDefault 0 p roomsMap
+ , "</td></tr>"])
+ . Set.toList $ keys
+ processAction $ Warning versionsStats
+
#if defined(OFFICIAL_SERVER)
processAction SaveReplay = do
--- a/gameServer/RoomsAndClients.hs Sun Jan 27 21:46:25 2013 +0400
+++ b/gameServer/RoomsAndClients.hs Mon Jan 28 00:50:00 2013 +0400
@@ -23,6 +23,7 @@
room'sM,
allClientsM,
clientsM,
+ roomsM,
roomClientsM,
roomClientsIndicesM,
withRoomsAndClients,
@@ -160,6 +161,9 @@
clientsM :: MRoomsAndClients r c -> IO [c]
clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (liftM client' . readElem clients)
+roomsM :: MRoomsAndClients r c -> IO [r]
+roomsM (MRoomsAndClients (rooms, _)) = indicesM rooms >>= mapM (liftM room' . readElem rooms)
+
roomClientsIndicesM :: MRoomsAndClients r c -> RoomIndex -> IO [ClientIndex]
roomClientsIndicesM (MRoomsAndClients (rooms, _)) (RoomIndex ri) = liftM roomClients' (rooms `readElem` ri)
--- a/gameServer/ServerState.hs Sun Jan 27 21:46:25 2013 +0400
+++ b/gameServer/ServerState.hs Mon Jan 28 00:50:00 2013 +0400
@@ -5,6 +5,7 @@
ServerState(..),
client's,
allClientsS,
+ allRoomsS,
roomClientsS,
sameProtoClientsS,
io
@@ -40,6 +41,9 @@
allClientsS :: StateT ServerState IO [ClientInfo]
allClientsS = gets roomsClients >>= liftIO . clientsM
+allRoomsS :: StateT ServerState IO [RoomInfo]
+allRoomsS = gets roomsClients >>= liftIO . roomsM
+
roomClientsS :: RoomIndex -> StateT ServerState IO [ClientInfo]
roomClientsS ri = do
rnc <- gets roomsClients