# HG changeset patch
# User unc0rr
# Date 1395603333 -14400
# Node ID 5fb3bb2de9d2be9c2b830fa4a52ae3760edbc00e
# Parent  f4c51ab8f46db0f2692dcde265dc5a004e021ca1
Some fixes to voting + small refactoring

diff -r f4c51ab8f46d -r 5fb3bb2de9d2 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/Actions.hs	Sun Mar 23 23:35:33 2014 +0400
@@ -34,9 +34,7 @@
 import ConfigFile
 import EngineInteraction
 import FloodDetection
-
-
-type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
+import HWProtoCore
 
 
 othersChans :: StateT ServerState IO [ClientChan]
@@ -798,3 +796,10 @@
 processAction (RegisterEvent e) = do
     actions <- registerEvent e
     mapM_ processAction actions
+
+
+processAction (ReactCmd cmd) = do
+    (Just ci) <- gets clientIndex
+    rnc <- gets roomsClients
+    actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
+    forM_ (actions `deepseq` actions) processAction
diff -r f4c51ab8f46d -r 5fb3bb2de9d2 gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/CoreTypes.hs	Sun Mar 23 23:35:33 2014 +0400
@@ -81,6 +81,7 @@
     | RegisterEvent Event
     | SaveRoom B.ByteString
     | LoadRoom B.ByteString
+    | ReactCmd [B.ByteString]
 
 
 data Event = LobbyChatMessage
@@ -91,7 +92,7 @@
 
 newEventsInfo :: EventsInfo
 newEventsInfo = []   
-    
+
 type ClientChan = Chan [B.ByteString]
 
 data CheckInfo =
diff -r f4c51ab8f46d -r 5fb3bb2de9d2 gameServer/HWProtoChecker.hs
--- a/gameServer/HWProtoChecker.hs	Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/HWProtoChecker.hs	Sun Mar 23 23:35:33 2014 +0400
@@ -5,7 +5,6 @@
 import Control.Monad.Reader
 --------------------------------------
 import CoreTypes
-import Actions
 import HandlerUtils
 
 
diff -r f4c51ab8f46d -r 5fb3bb2de9d2 gameServer/HWProtoCore.hs
--- a/gameServer/HWProtoCore.hs	Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/HWProtoCore.hs	Sun Mar 23 23:35:33 2014 +0400
@@ -6,7 +6,6 @@
 import qualified Data.ByteString.Char8 as B
 --------------------------------------
 import CoreTypes
-import Actions
 import HWProtoNEState
 import HWProtoLobbyState
 import HWProtoInRoomState
diff -r f4c51ab8f46d -r 5fb3bb2de9d2 gameServer/HWProtoInRoomState.hs
--- a/gameServer/HWProtoInRoomState.hs	Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/HWProtoInRoomState.hs	Sun Mar 23 23:35:33 2014 +0400
@@ -9,7 +9,6 @@
 import Control.Monad.Reader
 --------------------------------------
 import CoreTypes
-import Actions
 import Utils
 import HandlerUtils
 import RoomsAndClients
@@ -398,6 +397,12 @@
             return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote kick: no such user"]]
 
 
+handleCmd_inRoom ["CALLVOTE", "MAP"] = do
+    cl <- thisClient
+    s <- liftM (Map.keys . roomSaves) thisRoom
+    return [AnswerClients [sendChan cl] ["CHAT", "[server]", B.concat ["callvote map: ", B.intercalate ", " s]]]
+
+
 handleCmd_inRoom ["CALLVOTE", "MAP", roomSave] = do
     cl <- thisClient
     rm <- thisRoom
diff -r f4c51ab8f46d -r 5fb3bb2de9d2 gameServer/HWProtoLobbyState.hs
--- a/gameServer/HWProtoLobbyState.hs	Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/HWProtoLobbyState.hs	Sun Mar 23 23:35:33 2014 +0400
@@ -7,7 +7,6 @@
 import qualified Data.ByteString.Char8 as B
 --------------------------------------
 import CoreTypes
-import Actions
 import Utils
 import HandlerUtils
 import RoomsAndClients
diff -r f4c51ab8f46d -r 5fb3bb2de9d2 gameServer/HWProtoNEState.hs
--- a/gameServer/HWProtoNEState.hs	Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/HWProtoNEState.hs	Sun Mar 23 23:35:33 2014 +0400
@@ -7,9 +7,9 @@
 import Data.Digest.Pure.SHA
 --------------------------------------
 import CoreTypes
-import Actions
 import Utils
 import RoomsAndClients
+import HandlerUtils
 
 handleCmd_NotEntered :: CmdHandler
 
diff -r f4c51ab8f46d -r 5fb3bb2de9d2 gameServer/HandlerUtils.hs
--- a/gameServer/HandlerUtils.hs	Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/HandlerUtils.hs	Sun Mar 23 23:35:33 2014 +0400
@@ -8,6 +8,8 @@
 import CoreTypes
 
 
+type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
+
 thisClient :: Reader (ClientIndex, IRnC) ClientInfo
 thisClient = do
     (ci, rnc) <- ask
diff -r f4c51ab8f46d -r 5fb3bb2de9d2 gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/ServerCore.hs	Sun Mar 23 23:35:33 2014 +0400
@@ -6,14 +6,11 @@
 import Control.Monad.Reader
 import Control.Monad.State.Strict
 import Data.Set as Set
-import qualified Data.ByteString.Char8 as B
-import Control.DeepSeq
 import Data.Unique
 import Data.Maybe
 --------------------------------------
 import CoreTypes
 import NetRoutines
-import HWProtoCore
 import Actions
 import OfficialServer.DBInteraction
 import ServerState
@@ -23,13 +20,6 @@
 timerLoop tick messagesChan = threadDelay 30000000 >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
 
 
-reactCmd :: [B.ByteString] -> StateT ServerState IO ()
-reactCmd cmd = do
-    (Just ci) <- gets clientIndex
-    rnc <- gets roomsClients
-    actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
-    forM_ (actions `deepseq` actions) processAction
-
 mainLoop :: StateT ServerState IO ()
 mainLoop = forever $ do
     -- get >>= \s -> put $! s
@@ -46,7 +36,7 @@
             removed <- gets removedClients
             unless (ci `Set.member` removed) $ do
                 modify (\s -> s{clientIndex = Just ci})
-                reactCmd cmd
+                processAction $ ReactCmd cmd
 
         Remove ci ->
             processAction (DeleteClient ci)
diff -r f4c51ab8f46d -r 5fb3bb2de9d2 gameServer/Votes.hs
--- a/gameServer/Votes.hs	Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/Votes.hs	Sun Mar 23 23:35:33 2014 +0400
@@ -31,7 +31,7 @@
     where
     actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action]
     actOnVoting vt = do
-        let (contra, pro) = L.partition snd $ votes vt
+        let (pro, contra) = L.partition snd $ votes vt
         let v = (length $ entitledToVote vt) `div` 2 + 1
 
         if length contra >= v then
@@ -67,7 +67,7 @@
         let rs = Map.lookup roomSave (roomSaves rm)
         case rs of
              Nothing -> return []
-             Just (mp, p) -> return [ModifyRoom $ \r -> r{params = p, mapParams = mp}]
+             Just (mp, p) -> return [Warning "ye!", ModifyRoom $ \r -> r{params = p, mapParams = mp}]
 
 
 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
@@ -82,9 +82,11 @@
     if isJust $ voting rm then
         return []
     else
-        liftM ([ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}})
-        , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]]
-        ] ++ ) $ voted True
+        return [
+            ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}})
+            , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]]
+            , ReactCmd ["VOTE", "YES"]
+        ] 
 
 
 checkVotes :: StateT ServerState IO ()