From 97108b628a74861d7e6e44a4987a39e4cee9114a Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt
Date: Mon, 3 Aug 2020 15:57:44 +0200
Subject: Fix disconnect

---
 server/lib/Cafp/Game.hs | 14 +++++++-------
 1 file changed, 7 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 379b3a5..f0d4d47 100644
--- a/server/lib/Cafp/Game.hs
+++ b/server/lib/Cafp/Game.hs
@@ -20,13 +20,12 @@ module Cafp.Game
     ) where
 
 import           Cafp.Messages
-import           Control.Lens                 (Lens', at, imap, ix, orOf, over,
-                                               to, (%%=), (%=), (&), (+=), (.=),
-                                               (.~), (^.), (^..), (^?), _1, _2,
-                                               _3)
+import           Control.Lens                 (Lens', at, iall, imap, ix, orOf,
+                                               over, to, (%%=), (%=), (&), (+=),
+                                               (.=), (.~), (^.), (^..), (^?),
+                                               _1, _2, _3)
 import           Control.Lens.TH              (makeLenses, makePrisms)
 import           Control.Monad                (guard)
-import Data.Ord (comparing, Down (..))
 import           Control.Monad.State          (State, execState, modify,
                                                runState, state)
 import           Data.Bifunctor               (first)
@@ -34,6 +33,7 @@ import           Data.Foldable                (for_)
 import qualified Data.HashMap.Strict          as HMS
 import           Data.List                    (sort)
 import           Data.Maybe                   (fromMaybe)
+import           Data.Ord                     (Down (..), comparing)
 import           Data.Text                    (Text)
 import qualified Data.Text                    as T
 import qualified Data.Vector                  as V
@@ -178,7 +178,7 @@ stepGame :: Game -> Game
 stepGame game = case game ^. gameTable of
     TableProposing black proposals
         -- Everyone has proposed.
-        | HMS.null ((game ^. gamePlayers) `HMS.difference` proposals) ->
+        | iall (\pid _ -> HMS.member pid proposals) (game ^. gamePlayers) ->
             let proposalsMap = HMS.fromListWith (++) $ do
                     (pid, proposal) <- HMS.toList proposals
                     pure (proposal, [pid])
@@ -189,7 +189,7 @@ stepGame game = case game ^. gameTable of
         | otherwise -> game
     TableVoting black shuffled votes
         -- Everyone has voted.
-        | HMS.null ((game ^. gamePlayers) `HMS.difference` votes) ->
+        | iall (\pid _ -> HMS.member pid votes) (game ^. gamePlayers) ->
             let (voted, wins) = tallyVotes game shuffled votes in
             flip execState game $ do
             for_ wins $ \win -> gamePlayers . ix win . playerPoints += 1
-- 
cgit v1.2.3