gameServer/Votes.hs
changeset 10215 26fc5502ba22
parent 10212 5fb3bb2de9d2
child 10216 6928a323097f
--- 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