# HG changeset patch # User unc0rr # Date 1390854169 -14400 # Node ID 0af84e5cbd4de35fcc992be0fa27771653f683ed # Parent ac51bcb534efa5ceb8fac3de0fb2f4035b53655b Implement 'voted' function diff -r ac51bcb534ef -r 0af84e5cbd4d gameServer/HWProtoInRoomState.hs --- a/gameServer/HWProtoInRoomState.hs Mon Jan 27 22:34:06 2014 +0400 +++ b/gameServer/HWProtoInRoomState.hs Tue Jan 28 00:22:49 2014 +0400 @@ -425,7 +425,7 @@ cl <- thisClient let b = if m == "YES" then Just True else if m == "NO" then Just False else Nothing if isJust b then - voted (clUID cl) (fromJust b) + voted (fromJust b) else return [AnswerClients [sendChan cl] ["CHAT", "[server]", "vote: 'yes' or 'no'"]] diff -r ac51bcb534ef -r 0af84e5cbd4d gameServer/Votes.hs --- a/gameServer/Votes.hs Mon Jan 27 22:34:06 2014 +0400 +++ b/gameServer/Votes.hs Tue Jan 28 00:22:49 2014 +0400 @@ -1,20 +1,33 @@ {-# LANGUAGE OverloadedStrings #-} module Votes where -import Data.Unique import Control.Monad.Reader import Control.Monad.State import ServerState import qualified Data.ByteString.Char8 as B +import qualified Data.List as L import Data.Maybe ------------------- import Utils import CoreTypes import HandlerUtils -voted :: Unique -> Bool -> Reader (ClientIndex, IRnC) [Action] -voted _ _ = do - return [] + +voted :: Bool -> Reader (ClientIndex, IRnC) [Action] +voted vote = do + cl <- thisClient + rm <- thisRoom + uid <- liftM clUID thisClient + + if isNothing $ voting rm then + return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "There's no voting going on"]] + else if uid `L.notElem` entitledToVote (fromJust $ voting rm) then + return [] + else if uid `L.elem` map fst (votes . fromJust $ voting rm) then + return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted"]] + else + return [ModifyRoom $ \r -> r{voting = liftM (\v -> v{votes = (uid, vote):votes v}) $ voting rm}] + startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action] startVote vt = do @@ -30,11 +43,13 @@ else liftM ([ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}}) , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]] - ] ++ ) $ voted (clUID cl) True + ] ++ ) $ voted True + checkVotes :: StateT ServerState IO () checkVotes = undefined + voteInfo :: VoteType -> B.ByteString voteInfo (VoteKick n) = B.concat [loc "kick", " ", n]