aboutsummaryrefslogtreecommitdiff
path: root/server/lib/Cafp/Game.hs
diff options
context:
space:
mode:
authorJasper Van der Jeugt2020-07-31 13:35:17 +0200
committerJasper Van der Jeugt2020-07-31 13:35:17 +0200
commit323ca81c96e4186747f06b6178d71d49e98c6066 (patch)
tree3d52febe85476fe31d64371e8335539c06ec83b3 /server/lib/Cafp/Game.hs
parent88e5fd7b4701fcfc9dd355208435a37bf129a92f (diff)
Sync opponent proposals
Diffstat (limited to '')
-rw-r--r--server/lib/Cafp/Game.hs10
1 files changed, 8 insertions, 2 deletions
diff --git a/server/lib/Cafp/Game.hs b/server/lib/Cafp/Game.hs
index 336b85c..9c2d2e4 100644
--- a/server/lib/Cafp/Game.hs
+++ b/server/lib/Cafp/Game.hs
@@ -20,6 +20,7 @@ import Cafp.Messages
import Control.Lens (at, ix, over, to, (%~), (&), (.~), (^.),
(^?), _2)
import Control.Lens.TH (makeLenses, makePrisms)
+import Control.Monad (guard)
import qualified Data.HashMap.Strict as HMS
import Data.Maybe (fromMaybe)
import Data.Text (Text)
@@ -73,14 +74,19 @@ processClientMessage pid msg game = case msg of
-- Bad card proposed.
| not $ validWhiteCard (game ^. gameCards) c -> game
-- Proposal already made.
- | Just _ <- game ^? gameTable . _TableProposing . _2 . at pid -> game
+ | Just _ <- game ^? gameTable . _TableProposing . _2 . ix pid -> game
-- TODO: Check that the card is in the hand of the player.
| otherwise ->
game & gameTable . _TableProposing . _2 . at pid .~ Just c
gameViewForPlayer :: PlayerId -> Game -> GameView
gameViewForPlayer self game =
- let opponents = map snd . HMS.toList . HMS.delete self $ game ^. gamePlayers
+ let opponents = do
+ (pid, oname) <- HMS.toList $ game ^. gamePlayers
+ guard $ pid /= self
+ pure $ Opponent oname $ case game ^. gameTable of
+ TableProposing _ proposals -> HMS.member pid proposals
+
name = fromMaybe "" $ game ^. gamePlayers . at self
table = case game ^. gameTable of