|
10058
|
1 |
{-# LANGUAGE OverloadedStrings #-}
|
|
10049
|
2 |
module Votes where
|
|
|
3 |
|
|
|
4 |
import Data.Unique
|
|
|
5 |
import Control.Monad.Reader
|
|
|
6 |
import Control.Monad.State
|
|
|
7 |
import ServerState
|
|
10058
|
8 |
import qualified Data.ByteString.Char8 as B
|
|
|
9 |
import Data.Maybe
|
|
|
10 |
-------------------
|
|
|
11 |
import Utils
|
|
|
12 |
import CoreTypes
|
|
|
13 |
import HandlerUtils
|
|
10049
|
14 |
|
|
|
15 |
voted :: Unique -> Bool -> Reader (ClientIndex, IRnC) [Action]
|
|
10058
|
16 |
voted _ _ = do
|
|
|
17 |
return []
|
|
10049
|
18 |
|
|
|
19 |
startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
|
|
10058
|
20 |
startVote vt = do
|
|
|
21 |
(ci, rnc) <- ask
|
|
|
22 |
cl <- thisClient
|
|
|
23 |
rm <- thisRoom
|
|
|
24 |
chans <- roomClientsChans
|
|
|
25 |
|
|
|
26 |
let uids = map (clUID . client rnc) . roomClients rnc $ clientRoom rnc ci
|
|
|
27 |
|
|
|
28 |
if isJust $ voting rm then
|
|
|
29 |
return []
|
|
|
30 |
else
|
|
|
31 |
liftM ([ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}})
|
|
|
32 |
, AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]]
|
|
|
33 |
] ++ ) $ voted (clUID cl) True
|
|
10049
|
34 |
|
|
|
35 |
checkVotes :: StateT ServerState IO ()
|
|
|
36 |
checkVotes = undefined
|
|
10058
|
37 |
|
|
|
38 |
voteInfo :: VoteType -> B.ByteString
|
|
|
39 |
voteInfo (VoteKick n) = B.concat [loc "kick", " ", n]
|
|
|
40 |
|