Mercurial Mercurial > hedgewars / changeset
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Also rooms per version stats
authorunc0rr
Mon, 28 Jan 2013 00:50:00 +0400
changeset 8452 170afc3ac39f
parent 8451 8c7da08df048
child 8453 06541556df53
Also rooms per version stats
gameServer/Actions.hs file | annotate | diff | comparison | revisions
gameServer/RoomsAndClients.hs file | annotate | diff | comparison | revisions
gameServer/ServerState.hs file | annotate | diff | comparison | revisions 
--- 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
hedgewars