From e3a2052522471d39e410f4ea13d51d3d18f52b80 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt
Date: Fri, 31 Jul 2020 17:13:37 +0200
Subject: Multiple \BLANK in black cards

---
 server/lib/Cafp/Game.hs | 25 ++++++++++++++++++-------
 1 file changed, 18 insertions(+), 7 deletions(-)

(limited to 'server/lib/Cafp/Game.hs')

diff --git a/server/lib/Cafp/Game.hs b/server/lib/Cafp/Game.hs
index 9c2d2e4..bb734a1 100644
--- a/server/lib/Cafp/Game.hs
+++ b/server/lib/Cafp/Game.hs
@@ -17,8 +17,9 @@ module Cafp.Game
     ) where
 
 import           Cafp.Messages
+import Debug.Trace
 import           Control.Lens        (at, ix, over, to, (%~), (&), (.~), (^.),
-                                      (^?), _2)
+                                      (^?), _1, _2)
 import           Control.Lens.TH     (makeLenses, makePrisms)
 import           Control.Monad       (guard)
 import qualified Data.HashMap.Strict as HMS
@@ -30,7 +31,7 @@ import qualified Data.Vector         as V
 type PlayerId = Int
 
 data Table
-    = TableProposing BlackCard (HMS.HashMap PlayerId WhiteCard)
+    = TableProposing BlackCard (HMS.HashMap PlayerId [WhiteCard])
     deriving (Show)
 
 data Game = Game
@@ -62,6 +63,10 @@ joinGame game =
 leaveGame :: PlayerId -> Game -> Game
 leaveGame pid = over gamePlayers $ HMS.delete pid
 
+blackCardBlanks :: Cards -> BlackCard -> Int
+blackCardBlanks cards (BlackCard c) =
+    maybe 0 (length . T.breakOnAll "\\BLANK") $ cardsBlack cards V.!? c
+
 validWhiteCard :: Cards -> WhiteCard -> Bool
 validWhiteCard cards (WhiteCard c) =
     let len = V.length $ cardsWhite cards in c >= 0 && c < len
@@ -70,14 +75,20 @@ processClientMessage :: PlayerId -> ClientMessage -> Game -> Game
 processClientMessage pid msg game = case msg of
     ChangeMyName name ->
         game & gamePlayers . ix pid .~ name
-    ProposeWhiteCards c
-        -- Bad card proposed.
-        | not $ validWhiteCard (game ^. gameCards) c -> game
+    ProposeWhiteCards cs
+        -- Bad card(s) proposed.
+        | any (not . validWhiteCard (game ^. gameCards)) cs -> game
         -- Proposal already made.
         | Just _ <- game ^? gameTable . _TableProposing . _2 . ix pid -> game
+        -- Not enough cards submitted.
+        | Just b <- game ^? gameTable . _TableProposing . _1
+        , blackCardBlanks (game ^. gameCards) b /= length cs -> trace
+            ("bad length " ++ show (length cs) ++
+                " expected " ++ show (blackCardBlanks (game ^. gameCards) b))
+            game
         -- TODO: Check that the card is in the hand of the player.
         | otherwise                                  ->
-            game & gameTable . _TableProposing . _2 . at pid .~ Just c
+            game & gameTable . _TableProposing . _2 . at pid .~ Just cs
 
 gameViewForPlayer :: PlayerId -> Game -> GameView
 gameViewForPlayer self game =
@@ -91,7 +102,7 @@ gameViewForPlayer self game =
 
         table = case game ^. gameTable of
             TableProposing black proposals ->
-                Proposing black (HMS.lookup self proposals) in
+                Proposing black . fromMaybe [] $ HMS.lookup self proposals in
     GameView
         { gameViewOpponents = opponents
         , gameViewMyName    = name
-- 
cgit v1.2.3