gameServer/Votes.hs
author nemo
Sat, 01 Mar 2014 14:52:36 -0500
changeset 10171 00f41ff0bf2d
parent 10090 a471a7bbc339
child 10195 d1c23bb73346
permissions -rw-r--r--
Script might well override a static map, but can't risk it not doing it, and preview completely failing. Better to just not try it for static maps. Some script cfg might help. Could also avoid unnnecessary preview regenerations even if the script was doing nothing at all.

{-# LANGUAGE OverloadedStrings #-}
module Votes where

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 :: 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
        actOnVoting . fromJust . liftM (\v -> v{votes = (uid, vote):votes v}) $ voting rm
    where
    actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action]
    actOnVoting vt = do
        let (contra, pro) = L.partition snd $ votes vt
        let v = (length $ entitledToVote vt) `div` 2 + 1

        if length contra >= v then
            closeVoting
        else if length pro >= v then do
            act $ voteType vt
            closeVoting
        else
            return [ModifyRoom $ \r -> r{voting = Just vt}]

    closeVoting = do
        chans <- roomClientsChans
        return [
            AnswerClients chans ["CHAT", "[server]", loc "Voting closed"]
            , ModifyRoom (\r -> r{voting = Nothing})
            ]

    act (VoteKick nickname) = do
        (thisClientId, rnc) <- ask
        maybeClientId <- clientByNick nickname
        rm <- thisRoom
        let kickId = fromJust maybeClientId
        let kickCl = rnc `client` kickId
        let sameRoom = clientRoom rnc thisClientId == clientRoom rnc kickId
        return
            [KickRoomClient kickId |
                isJust maybeClientId
                && sameRoom
                && ((isNothing $ gameInfo rm) || teamsInGame kickCl == 0)
            ]


startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
startVote vt = do
    (ci, rnc) <- ask
    --cl <- thisClient
    rm <- thisRoom
    chans <- roomClientsChans

    let uids = map (clUID . client rnc) . roomClients rnc $ clientRoom rnc ci

    if isJust $ voting rm then
        return []
    else
        liftM ([ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}})
        , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]]
        ] ++ ) $ voted True


checkVotes :: StateT ServerState IO ()
checkVotes = undefined


voteInfo :: VoteType -> B.ByteString
voteInfo (VoteKick n) = B.concat [loc "kick", " ", n]