diff options
author | Jasper Van der Jeugt | 2020-08-02 20:08:12 +0200 |
---|---|---|
committer | Jasper Van der Jeugt | 2020-08-02 20:08:12 +0200 |
commit | fce7342703e8d6353f65cf28914948366f54ef81 (patch) | |
tree | 0869bd1fbebbc57585311a736ee7446f1d87061c | |
parent | fd2ef8609852058ddb7dc7450fb16da0e95cd40a (diff) |
WIP
-rw-r--r-- | server/lib/Cafp/Game.hs | 12 |
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 |