83 |
83 |
84 instance NFData Action where |
84 instance NFData Action where |
85 rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` () |
85 rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` () |
86 rnf a = a `seq` () |
86 rnf a = a `seq` () |
87 |
87 |
88 --instance NFData B.ByteString |
88 instance NFData B.ByteString |
89 instance NFData (Chan a) |
89 instance NFData (Chan a) |
90 |
90 |
91 |
91 |
92 othersChans :: StateT ServerState IO [ClientChan] |
92 othersChans :: StateT ServerState IO [ClientChan] |
93 othersChans = do |
93 othersChans = do |
646 return () |
646 return () |
647 processAction $ ModifyServerInfo (\s -> s{shutdownPending = True}) |
647 processAction $ ModifyServerInfo (\s -> s{shutdownPending = True}) |
648 |
648 |
649 processAction Stats = do |
649 processAction Stats = do |
650 cls <- allClientsS |
650 cls <- allClientsS |
651 let stats = versions cls |
651 rms <- allRoomsS |
652 processAction $ Warning stats |
652 let clientsMap = Map.fromListWith (+) . map (\c -> (clientProto c, 1 :: Int)) $ cls |
653 where |
653 let roomsMap = Map.fromListWith (+) . map (\c -> (roomProto c, 1 :: Int)) . filter ((/=) 0 . roomProto) $ rms |
654 versions = B.concat . ((:) "<table border=1>") . (flip (++) ["</table>"]) |
654 let keys = Map.keysSet clientsMap `Set.union` Map.keysSet roomsMap |
655 . concatMap (\(p, n :: Int) -> ["<tr><td>", protoNumber2ver p, "</td><td>", showB n, "</td></tr>"]) |
655 let versionsStats = B.concat . ((:) "<table border=1>") . (flip (++) ["</table>"]) |
656 . Map.toList . Map.fromListWith (+) . map (\c -> (clientProto c, 1)) |
656 . concatMap (\p -> [ |
|
657 "<tr><td>", protoNumber2ver p |
|
658 , "</td><td>", showB $ Map.findWithDefault 0 p clientsMap |
|
659 , "</td><td>", showB $ Map.findWithDefault 0 p roomsMap |
|
660 , "</td></tr>"]) |
|
661 . Set.toList $ keys |
|
662 processAction $ Warning versionsStats |
|
663 |
657 |
664 |
658 #if defined(OFFICIAL_SERVER) |
665 #if defined(OFFICIAL_SERVER) |
659 processAction SaveReplay = do |
666 processAction SaveReplay = do |
660 ri <- clientRoomA |
667 ri <- clientRoomA |
661 rnc <- gets roomsClients |
668 rnc <- gets roomsClients |