gameServer/Votes.hs
changeset 10081 0af84e5cbd4d
parent 10058 4ed428389c4e
child 10087 5ba891578621
--- 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]