--- 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'"]]
--- 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]