equal
deleted
inserted
replaced
1 {-# LANGUAGE OverloadedStrings #-} |
1 {-# LANGUAGE OverloadedStrings #-} |
2 module Votes where |
2 module Votes where |
3 |
3 |
4 import Data.Unique |
|
5 import Control.Monad.Reader |
4 import Control.Monad.Reader |
6 import Control.Monad.State |
5 import Control.Monad.State |
7 import ServerState |
6 import ServerState |
8 import qualified Data.ByteString.Char8 as B |
7 import qualified Data.ByteString.Char8 as B |
|
8 import qualified Data.List as L |
9 import Data.Maybe |
9 import Data.Maybe |
10 ------------------- |
10 ------------------- |
11 import Utils |
11 import Utils |
12 import CoreTypes |
12 import CoreTypes |
13 import HandlerUtils |
13 import HandlerUtils |
14 |
14 |
15 voted :: Unique -> Bool -> Reader (ClientIndex, IRnC) [Action] |
15 |
16 voted _ _ = do |
16 voted :: Bool -> Reader (ClientIndex, IRnC) [Action] |
17 return [] |
17 voted vote = do |
|
18 cl <- thisClient |
|
19 rm <- thisRoom |
|
20 uid <- liftM clUID thisClient |
|
21 |
|
22 if isNothing $ voting rm then |
|
23 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "There's no voting going on"]] |
|
24 else if uid `L.notElem` entitledToVote (fromJust $ voting rm) then |
|
25 return [] |
|
26 else if uid `L.elem` map fst (votes . fromJust $ voting rm) then |
|
27 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted"]] |
|
28 else |
|
29 return [ModifyRoom $ \r -> r{voting = liftM (\v -> v{votes = (uid, vote):votes v}) $ voting rm}] |
|
30 |
18 |
31 |
19 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action] |
32 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action] |
20 startVote vt = do |
33 startVote vt = do |
21 (ci, rnc) <- ask |
34 (ci, rnc) <- ask |
22 cl <- thisClient |
35 cl <- thisClient |
28 if isJust $ voting rm then |
41 if isJust $ voting rm then |
29 return [] |
42 return [] |
30 else |
43 else |
31 liftM ([ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}}) |
44 liftM ([ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}}) |
32 , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]] |
45 , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]] |
33 ] ++ ) $ voted (clUID cl) True |
46 ] ++ ) $ voted True |
|
47 |
34 |
48 |
35 checkVotes :: StateT ServerState IO () |
49 checkVotes :: StateT ServerState IO () |
36 checkVotes = undefined |
50 checkVotes = undefined |
37 |
51 |
|
52 |
38 voteInfo :: VoteType -> B.ByteString |
53 voteInfo :: VoteType -> B.ByteString |
39 voteInfo (VoteKick n) = B.concat [loc "kick", " ", n] |
54 voteInfo (VoteKick n) = B.concat [loc "kick", " ", n] |
40 |
55 |