equal
deleted
inserted
replaced
1 {-# LANGUAGE CPP, OverloadedStrings #-} |
1 {-# LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables #-} |
2 {-# OPTIONS_GHC -fno-warn-orphans #-} |
2 {-# OPTIONS_GHC -fno-warn-orphans #-} |
3 module Actions where |
3 module Actions where |
4 |
4 |
5 import Control.Concurrent |
5 import Control.Concurrent |
6 import qualified Data.Set as Set |
6 import qualified Data.Set as Set |
|
7 import qualified Data.Map as Map |
7 import qualified Data.List as L |
8 import qualified Data.List as L |
8 import qualified Control.Exception as Exception |
9 import qualified Control.Exception as Exception |
9 import System.Log.Logger |
10 import System.Log.Logger |
10 import Control.Monad |
11 import Control.Monad |
11 import Data.Time |
12 import Data.Time |
73 | RestartServer |
74 | RestartServer |
74 | AddNick2Bans B.ByteString B.ByteString UTCTime |
75 | AddNick2Bans B.ByteString B.ByteString UTCTime |
75 | AddIP2Bans B.ByteString B.ByteString UTCTime |
76 | AddIP2Bans B.ByteString B.ByteString UTCTime |
76 | CheckBanned Bool |
77 | CheckBanned Bool |
77 | SaveReplay |
78 | SaveReplay |
|
79 | Stats |
78 |
80 |
79 |
81 |
80 type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] |
82 type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] |
81 |
83 |
82 instance NFData Action where |
84 instance NFData Action where |
638 noticeM "Core" "Spawning new server" |
640 noticeM "Core" "Spawning new server" |
639 _ <- createProcess (proc "./hedgewars-server" args) |
641 _ <- createProcess (proc "./hedgewars-server" args) |
640 return () |
642 return () |
641 processAction $ ModifyServerInfo (\s -> s{shutdownPending = True}) |
643 processAction $ ModifyServerInfo (\s -> s{shutdownPending = True}) |
642 |
644 |
|
645 processAction Stats = do |
|
646 cls <- allClientsS |
|
647 let stats = versions cls |
|
648 processAction $ Warning stats |
|
649 where |
|
650 versions = B.concat . ((:) "<table border=1>") . (flip (++) ["</table>"]) |
|
651 . concatMap (\(p, n :: Int) -> ["<tr><td>", protoNumber2ver p, "</td><td>", showB n, "</td></tr>"]) |
|
652 . Map.toList . Map.fromListWith (+) . map (\c -> (clientProto c, 1)) |
|
653 |
643 #if defined(OFFICIAL_SERVER) |
654 #if defined(OFFICIAL_SERVER) |
644 processAction SaveReplay = do |
655 processAction SaveReplay = do |
645 ri <- clientRoomA |
656 ri <- clientRoomA |
646 rnc <- gets roomsClients |
657 rnc <- gets roomsClients |
647 |
658 |