expose player ids in game snapshots (#46)

turboMaCk · Aug 18, 2019 · 031daaf · 031daaf
1 parent 9377025
commit 031daaf
Show file tree

Hide file tree

Showing 3 changed files with 59 additions and 34 deletions.
diff --git a/server/PlanningGame/Api/GameSnapshot.hs b/server/PlanningGame/Api/GameSnapshot.hs
@@ -31,23 +31,33 @@ data GameSnapshot
     }
   | LockedGameSnapshot
     { snapshotName :: Text
-    , playerVotes  :: [ ( Text, Vote ) ]
+    , playerVotes  :: [ ( Int, Text, Vote ) ]
     , totalPoints  :: Int
     }
   | FinishedGameSnapshot
     { totalPoints       :: Int
     , snapshotGameVotes :: [ ( Text, Vote ) ]
-    , playerGameVotes   :: [ ( Text, [ ( Text, Vote ) ] ) ]
+    , playerGameVotes   :: [ ( Text, [ ( Int, Text, Vote ) ] ) ]
     }
 
 
 -- @TODO: possible to generalize
-pointsPair :: [ ( Text, Vote ) ] -> [ Value ]
-pointsPair = fmap toVal
+taskPointsPair :: [ ( Text, Vote ) ] -> [ Value ]
+taskPointsPair = fmap toVal
   where
     toVal ( name, points ) =
       object
-        [ "name" .= name
+        [ "name"  .= name
+        , "value" .= points
+        ]
+
+userPointsPair :: [ ( Int, Text, Vote ) ] -> [ Value ]
+userPointsPair = fmap toVal
+  where
+    toVal ( id', name, points ) =
+      object
+        [ "id"    .= id'
+        , "name"  .= name
         , "value" .= points
         ]
 
@@ -63,18 +73,18 @@ instance ToJSON GameSnapshot where
   toJSON (LockedGameSnapshot name votes points) =
     object
       [ "name"         .= name
-      , "playerVotes"  .= pointsPair votes
+      , "playerVotes"  .= userPointsPair votes
       , "points"       .= points
       , "status"       .= String "Locked"
       ]
   toJSON (FinishedGameSnapshot points votes pVotes) =
     object
-      [ "roundVotes"  .= pointsPair votes
+      [ "roundVotes"  .= taskPointsPair votes
       , "playerVotes" .=
         fmap
           (\(task, xs) ->
              object [ "name" .= task
-                    , "playerVotes" .= pointsPair xs
+                    , "playerVotes" .= userPointsPair xs
                     ])
           pVotes
       , "points" .= points
@@ -94,12 +104,12 @@ snapshot banker players games@(RunningGames _ (RunningGame name _ isLocked)) =
   if isLocked then
     LockedGameSnapshot
         { snapshotName = name
-        , playerVotes  = Game.playersVotes banker players games
+        , playerVotes  = Game.currentPlayerVotes banker players games
         , totalPoints  = Game.sumPoints games
         }
   else
     RunningGameSnapshot
         { snapshotName  = name
-        , snapshotVotes = fst <$> Game.playersVotes banker players games
+        , snapshotVotes = (\(_, name', _) -> name') <$> Game.currentPlayerVotes banker players games
         , totalPoints   = Game.sumPoints games
         }
diff --git a/server/PlanningGame/Data/AutoIncrement.hs b/server/PlanningGame/Data/AutoIncrement.hs
@@ -2,6 +2,7 @@ module PlanningGame.Data.AutoIncrement
   ( Incremental
   , WithId(..)
   , unwrapValue
+  , unwrapId
   , empty
   , insert
   , lookup
@@ -38,7 +39,13 @@ instance ToJSON (IncId a) where
 
 
 unwrapValue :: WithId i a -> a
-unwrapValue (WithId _ a) = a
+unwrapValue (WithId _ a) =
+  a
+
+
+unwrapId :: WithId i a -> Int
+unwrapId (WithId id' _) =
+  unIncId id'
 
 
 data Incremental i k v =

diff --git a/server/PlanningGame/Data/Game.hs b/server/PlanningGame/Data/Game.hs
@@ -16,31 +16,32 @@ module PlanningGame.Data.Game
   , complete
   , sumPoints
   , allVotes
-  , playersVotes
+  , currentPlayerVotes
   , isFinished
   , finishCurrent
   , allVoted
   , restartCurrent
   , removePlayerVotes
   ) where
 
-import           Control.Monad             (mzero)
-import           Data.Aeson.Types          (FromJSON (..), ToJSON (..),
-                                            Value (..))
-import           Data.Map.Strict           (Map)
-import           Data.Maybe                (mapMaybe)
-import           Data.Text                 (Text)
+import           Control.Monad                   (mzero)
+import           Data.Aeson.Types                (FromJSON (..), ToJSON (..),
+                                                  Value (..))
+import           Data.Map.Strict                 (Map)
+import           Data.Maybe                      (mapMaybe)
+import           Data.Text                       (Text)
 
-import qualified Data.Map.Strict           as Map
-import qualified Data.Set                  as Set
-import qualified Data.Text                 as Text
+import qualified Data.Map.Strict                 as Map
+import qualified Data.Set                        as Set
+import qualified Data.Text                       as Text
 
-import           PlanningGame.Api.Error    (Error (..), ErrorType (..))
+import           PlanningGame.Api.Error          (Error (..), ErrorType (..))
 import           PlanningGame.Data.Id
-import           PlanningGame.Data.Player  (Player, Players)
-import           PlanningGame.Data.Session (SessionId)
+import           PlanningGame.Data.Player        (Player, Players)
+import           PlanningGame.Data.Session       (SessionId)
 
-import qualified PlanningGame.Data.Player  as Player
+import qualified PlanningGame.Data.AutoIncrement as Inc
+import qualified PlanningGame.Data.Player        as Player
 
 
 data Vote
@@ -251,25 +252,32 @@ allVotes games =
   <$> finishedGames games
 
 
-playerVotes :: ( Id SessionId, Player ) -> Players -> Games -> [ ( Text, [ ( Text, Vote ) ] ) ]
+playerVotes :: ( Id SessionId, Player ) -> Players -> Games -> [ ( Text, [ ( Int, Text, Vote ) ] ) ]
 playerVotes ( bankerId, bankerName ) players' games =
   reverse $ (\game@(FinishedGame { name }) -> ( name, playerVotes' game ))
   <$> finishedGames games
 
   where
-    playerVotes' :: FinishedGame -> [ ( Text, Vote ) ]
+    playerVotes' :: FinishedGame -> [ ( Int, Text, Vote ) ]
     playerVotes' game =
-      -- @TODO: Better errr handling
-      fmap (\(sId, vote) -> (maybe "" Player.getName $ Player.lookup sId players, vote)) $ Map.toList $ votes game
+      fmap (\(sId, vote) ->
+              let player = Player.lookup sId players
+              in
+              -- @TODO: Better errr handling
+              ( maybe 0 Inc.unwrapId player
+              , maybe "" Player.getName player
+              , vote
+              )
+           ) $ Map.toList $ votes game
 
     players =
       Player.insert bankerId bankerName players'
 
-
-playersVotes :: ( Id SessionId, Player ) -> Players -> Games -> [ ( Text, Vote ) ]
-playersVotes _ _ (FinishedGames _) = []
-playersVotes ( bankerId, banker ) players (RunningGames _ (RunningGame _ votes _)) =
-  mapMaybe (\(id', vote) -> (\p -> ( Player.getName p, vote )) <$> Player.lookup id' allPlayers)
+-- @TODO: refactor `playerVotes` vs `playersVotes`
+currentPlayerVotes :: ( Id SessionId, Player ) -> Players -> Games -> [ ( Int, Text, Vote ) ]
+currentPlayerVotes _ _ (FinishedGames _) = []
+currentPlayerVotes ( bankerId, banker ) players (RunningGames _ (RunningGame _ votes _)) =
+  mapMaybe (\(id', vote) -> (\p -> ( Inc.unwrapId p, Player.getName p, vote )) <$> Player.lookup id' allPlayers)
     $ Map.toList votes
 
   where