|
1 {-# LANGUAGE OverloadedStrings #-} |
1 module Votes where |
2 module Votes where |
2 |
3 |
3 import Data.Unique |
4 import Data.Unique |
4 import CoreTypes |
|
5 import RoomsAndClients |
|
6 import Control.Monad.Reader |
5 import Control.Monad.Reader |
7 import Control.Monad.State |
6 import Control.Monad.State |
8 import ServerState |
7 import ServerState |
|
8 import qualified Data.ByteString.Char8 as B |
|
9 import Data.Maybe |
|
10 ------------------- |
|
11 import Utils |
|
12 import CoreTypes |
|
13 import HandlerUtils |
9 |
14 |
10 voted :: Unique -> Bool -> Reader (ClientIndex, IRnC) [Action] |
15 voted :: Unique -> Bool -> Reader (ClientIndex, IRnC) [Action] |
11 voted = undefined |
16 voted _ _ = do |
|
17 return [] |
12 |
18 |
13 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action] |
19 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action] |
14 startVote = undefined |
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 |
15 |
34 |
16 checkVotes :: StateT ServerState IO () |
35 checkVotes :: StateT ServerState IO () |
17 checkVotes = undefined |
36 checkVotes = undefined |
|
37 |
|
38 voteInfo :: VoteType -> B.ByteString |
|
39 voteInfo (VoteKick n) = B.concat [loc "kick", " ", n] |
|
40 |