# HG changeset patch
# User unc0rr
# Date 1395948331 -14400
# Node ID 26fc5502ba229816d428c6e6e313a06759edfc42
# Parent  426aafe1f3ed045951bf779302905b95ab369cd5
 - Fix applying vote result
 - Votes expiring (I'm sure it doesn't even build, but my ghc is broken for now, hoping for the best)

diff -r 426aafe1f3ed -r 26fc5502ba22 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Mon Mar 24 21:32:24 2014 +0400
+++ b/gameServer/Actions.hs	Thu Mar 27 23:25:31 2014 +0400
@@ -803,3 +803,6 @@
     rnc <- gets roomsClients
     actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
     forM_ (actions `deepseq` actions) processAction
+
+processAction CheckVotes =
+    checkVotes >>= mapM_ processAction
\ No newline at end of file
diff -r 426aafe1f3ed -r 26fc5502ba22 gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Mon Mar 24 21:32:24 2014 +0400
+++ b/gameServer/CoreTypes.hs	Thu Mar 27 23:25:31 2014 +0400
@@ -82,6 +82,7 @@
     | SaveRoom B.ByteString
     | LoadRoom B.ByteString
     | ReactCmd [B.ByteString]
+    | CheckVotes
 
 
 data Event = LobbyChatMessage
diff -r 426aafe1f3ed -r 26fc5502ba22 gameServer/HWProtoInRoomState.hs
--- a/gameServer/HWProtoInRoomState.hs	Mon Mar 24 21:32:24 2014 +0400
+++ b/gameServer/HWProtoInRoomState.hs	Thu Mar 27 23:25:31 2014 +0400
@@ -434,7 +434,6 @@
 handleCmd_inRoom ["LOADROOM", fileName] = serverAdminOnly $ do
     return [LoadRoom fileName]
 
-    
 handleCmd_inRoom ["LIST"] = return [] -- for old clients (<= 0.9.17)
 
 handleCmd_inRoom (s:_) = return [ProtocolError $ "Incorrect command '" `B.append` s `B.append` "' (state: in room)"]
diff -r 426aafe1f3ed -r 26fc5502ba22 gameServer/RoomsAndClients.hs
--- a/gameServer/RoomsAndClients.hs	Mon Mar 24 21:32:24 2014 +0400
+++ b/gameServer/RoomsAndClients.hs	Thu Mar 27 23:25:31 2014 +0400
@@ -158,6 +158,9 @@
 allClientsM :: MRoomsAndClients r c -> IO [ClientIndex]
 allClientsM (MRoomsAndClients (_, clients)) = liftM (map ClientIndex) $ indicesM clients
 
+allRoomsM :: MRoomsAndClients r c -> IO [RoomIndex]
+allRoomsM (MRoomsAndClients (rooms, _)) = liftM (map RoomIndex) $ indicesM rooms
+
 clientsM :: MRoomsAndClients r c -> IO [c]
 clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (liftM client' . readElem clients)
 
diff -r 426aafe1f3ed -r 26fc5502ba22 gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Mon Mar 24 21:32:24 2014 +0400
+++ b/gameServer/ServerCore.hs	Thu Mar 27 23:25:31 2014 +0400
@@ -53,6 +53,7 @@
         TimerAction tick ->
                 mapM_ processAction $
                     PingAll
+                    : CheckVotes
                     : [StatsAction | even tick]
                     ++ [Cleanup | tick `mod` 100 == 0]
 
diff -r 426aafe1f3ed -r 26fc5502ba22 gameServer/Votes.hs
--- a/gameServer/Votes.hs	Mon Mar 24 21:32:24 2014 +0400
+++ b/gameServer/Votes.hs	Thu Mar 27 23:25:31 2014 +0400
@@ -37,8 +37,9 @@
         if length contra >= v then
             closeVoting
         else if length pro >= v then do
-            act $ voteType vt
-            closeVoting
+            a <- act $ voteType vt
+            c <- closeVoting
+            return $ c ++ a
         else
             return [ModifyRoom $ \r -> r{voting = Just vt}]
 
@@ -67,7 +68,7 @@
         let rs = Map.lookup roomSave (roomSaves rm)
         case rs of
              Nothing -> return []
-             Just (mp, p) -> return [Warning "ye!", ModifyRoom $ \r -> r{params = p, mapParams = mp}]
+             Just (mp, p) -> return [ModifyRoom $ \r -> r{params = p, mapParams = mp}]
 
 
 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
@@ -86,11 +87,28 @@
             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 ()
-checkVotes = undefined
+checkVotes :: StateT ServerState IO [Action]
+checkVotes = do
+    rnc <- gets roomsClients
+    io $ do
+        ris <- allRoomsM rnc
+        actions <- mapM (check rnc) ris
+        mapM_ processAction actions
+    where
+        check rnc ri = do
+            e <- room'sM rnc voting ri
+            case e of
+                 Just rv -> do
+                     modifyRoom rnc (\r -> r{voting = if voteTTL rv == 0 then Nothing else Just rv{voteTTL = voteTTL rv - 1}}) ri
+                     if voteTTL rv == 0 then do
+                        chans <- liftM sendChan $ roomClientsM rnc ri
+                        return [AnswerClients chans ["CHAT", "[server]", loc "Voting expired"]]
+                        else
+                        return []
+                Nothing -> return []
 
 
 voteInfo :: VoteType -> B.ByteString