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