gameServer/Votes.hs
author koda
Fri, 24 Jan 2014 10:56:22 +0100
changeset 10068 cbe06dc07332
parent 10058 4ed428389c4e
child 10081 0af84e5cbd4d
permissions -rw-r--r--
use CMAKE_CURRENT_SOURCE_DIR consistently
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10058
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
     1
{-# LANGUAGE OverloadedStrings #-}
10049
ca11d122f54e Oops, forgot this
unc0rr
parents:
diff changeset
     2
module Votes where
ca11d122f54e Oops, forgot this
unc0rr
parents:
diff changeset
     3
ca11d122f54e Oops, forgot this
unc0rr
parents:
diff changeset
     4
import Data.Unique
ca11d122f54e Oops, forgot this
unc0rr
parents:
diff changeset
     5
import Control.Monad.Reader
ca11d122f54e Oops, forgot this
unc0rr
parents:
diff changeset
     6
import Control.Monad.State
ca11d122f54e Oops, forgot this
unc0rr
parents:
diff changeset
     7
import ServerState
10058
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
     8
import qualified Data.ByteString.Char8 as B
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
     9
import Data.Maybe
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    10
-------------------
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    11
import Utils
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    12
import CoreTypes
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    13
import HandlerUtils
10049
ca11d122f54e Oops, forgot this
unc0rr
parents:
diff changeset
    14
ca11d122f54e Oops, forgot this
unc0rr
parents:
diff changeset
    15
voted :: Unique -> Bool -> Reader (ClientIndex, IRnC) [Action]
10058
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    16
voted _ _ = do
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    17
    return []
10049
ca11d122f54e Oops, forgot this
unc0rr
parents:
diff changeset
    18
ca11d122f54e Oops, forgot this
unc0rr
parents:
diff changeset
    19
startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
10058
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    20
startVote vt = do
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    21
    (ci, rnc) <- ask
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    22
    cl <- thisClient
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    23
    rm <- thisRoom
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    24
    chans <- roomClientsChans
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    25
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    26
    let uids = map (clUID . client rnc) . roomClients rnc $ clientRoom rnc ci
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    27
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    28
    if isJust $ voting rm then
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    29
        return []
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    30
    else
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    31
        liftM ([ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}})
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    32
        , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]]
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    33
        ] ++ ) $ voted (clUID cl) True
10049
ca11d122f54e Oops, forgot this
unc0rr
parents:
diff changeset
    34
ca11d122f54e Oops, forgot this
unc0rr
parents:
diff changeset
    35
checkVotes :: StateT ServerState IO ()
ca11d122f54e Oops, forgot this
unc0rr
parents:
diff changeset
    36
checkVotes = undefined
10058
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    37
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    38
voteInfo :: VoteType -> B.ByteString
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    39
voteInfo (VoteKick n) = B.concat [loc "kick", " ", n]
4ed428389c4e - Implement /callvote
unc0rr
parents: 10049
diff changeset
    40