Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

expose player ids in game snapshots #46

Merged
merged 2 commits into from Aug 18, 2019
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
30 changes: 20 additions & 10 deletions server/PlanningGame/Api/GameSnapshot.hs
Expand Up @@ -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
]

Expand All @@ -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
Expand All @@ -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
}
9 changes: 8 additions & 1 deletion server/PlanningGame/Data/AutoIncrement.hs
Expand Up @@ -2,6 +2,7 @@ module PlanningGame.Data.AutoIncrement
( Incremental
, WithId(..)
, unwrapValue
, unwrapId
, empty
, insert
, lookup
Expand Down Expand Up @@ -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 =
Expand Down
54 changes: 31 additions & 23 deletions server/PlanningGame/Data/Game.hs
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down