32 import CoreTypes |
32 import CoreTypes |
33 import HandlerUtils |
33 import HandlerUtils |
34 import EngineInteraction |
34 import EngineInteraction |
35 |
35 |
36 |
36 |
37 voted :: Bool -> Reader (ClientIndex, IRnC) [Action] |
37 voted :: Bool -> Bool -> Reader (ClientIndex, IRnC) [Action] |
38 voted vote = do |
38 voted forced vote = do |
39 cl <- thisClient |
39 cl <- thisClient |
40 rm <- thisRoom |
40 rm <- thisRoom |
41 uid <- liftM clUID thisClient |
41 uid <- liftM clUID thisClient |
42 |
42 |
43 case voting rm of |
43 case voting rm of |
44 Nothing -> |
44 Nothing -> |
45 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "There's no voting going on"]] |
45 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "There's no voting going on"]] |
46 Just voting -> |
46 Just voting -> |
47 if uid `L.notElem` entitledToVote voting then |
47 if (not forced) && (uid `L.notElem` entitledToVote voting) then |
48 return [] |
48 return [] |
49 else if uid `L.elem` map fst (votes voting) then |
49 else if (not forced) && (uid `L.elem` map fst (votes voting)) then |
50 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted"]] |
50 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted"]] |
|
51 else if forced && (not $ isAdministrator cl) then |
|
52 return [] |
51 else |
53 else |
52 ((:) (AnswerClients [sendChan cl] ["CHAT", "[server]", loc "Your vote counted"])) |
54 ((:) (AnswerClients [sendChan cl] ["CHAT", "[server]", loc "Your vote counted"])) |
53 <$> (actOnVoting $ voting{votes = (uid, vote):votes voting}) |
55 <$> (actOnVoting $ voting{votes = (uid, vote):votes voting}) |
54 |
56 |
55 where |
57 where |
57 actOnVoting vt = do |
59 actOnVoting vt = do |
58 let (pro, contra) = L.partition snd $ votes vt |
60 let (pro, contra) = L.partition snd $ votes vt |
59 let totalV = length $ entitledToVote vt |
61 let totalV = length $ entitledToVote vt |
60 let successV = totalV `div` 2 + 1 |
62 let successV = totalV `div` 2 + 1 |
61 |
63 |
62 if length contra > totalV - successV then |
64 if (forced && not vote) || (length contra > totalV - successV) then |
63 closeVoting |
65 closeVoting |
64 else if length pro >= successV then do |
66 else if (forced && vote) || (length pro >= successV) then do |
65 a <- act $ voteType vt |
67 a <- act $ voteType vt |
66 c <- closeVoting |
68 c <- closeVoting |
67 return $ c ++ a |
69 return $ c ++ a |
68 else |
70 else |
69 return [ModifyRoom $ \r -> r{voting = Just vt}] |
71 return [ModifyRoom $ \r -> r{voting = Just vt}] |