aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasper Van der Jeugt2020-08-02 20:08:12 +0200
committerJasper Van der Jeugt2020-08-02 20:08:12 +0200
commitfce7342703e8d6353f65cf28914948366f54ef81 (patch)
tree0869bd1fbebbc57585311a736ee7446f1d87061c
parentfd2ef8609852058ddb7dc7450fb16da0e95cd40a (diff)
WIP
Diffstat (limited to '')
-rw-r--r--server/lib/Cafp/Game.hs12
1 files changed, 8 insertions, 4 deletions
diff --git a/server/lib/Cafp/Game.hs b/server/lib/Cafp/Game.hs
index 8475a90..0f80857 100644
--- a/server/lib/Cafp/Game.hs
+++ b/server/lib/Cafp/Game.hs
@@ -21,9 +21,10 @@ module Cafp.Game
import Cafp.Messages
import Control.Lens (Lens', at, ix, over, to, traverseOf,
(%%=), (%=), (%~), (&), (.~), (^.),
- (^..), (^?), _1, _2, (.=), _3)
+ (^..), (^?), _1, _2, (.=), _3, use, anyOf)
import Control.Lens.TH (makeLenses, makePrisms)
import Control.Monad (guard, replicateM, (>=>))
+import Data.Monoid (Any (..))
import Control.Monad.State (State, state, execState, runState)
import qualified Data.HashMap.Strict as HMS
import Data.Maybe (fromMaybe)
@@ -49,8 +50,9 @@ data Table
deriving (Show)
data Player = Player
- { _playerName :: !Text
- , _playerHand :: !(V.Vector WhiteCard)
+ { _playerName :: !Text
+ , _playerHand :: !(V.Vector WhiteCard)
+ , _playerAdmin :: !Bool
} deriving (Show)
data Game = Game
@@ -104,9 +106,11 @@ newGame cards gen = flip execState state0 $ do
joinGame :: Game -> (PlayerId, Game)
joinGame = runState $ do
pid <- gameNextPlayerId %%= (\x -> (x, x + 1))
+ hasAdmin <- use (gamePlayers . traverse . playerAdmin . Any)
let name = "Player " <> T.pack (show pid)
+ admin = not (getAny hasAdmin)
hand <- V.replicateM 6 popWhiteCard
- gamePlayers %= HMS.insert pid (Player name hand)
+ gamePlayers %= HMS.insert pid (Player name hand admin)
pure pid
leaveGame :: PlayerId -> Game -> Game