aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--client/src/Client.elm43
-rw-r--r--client/src/Messages.elm58
-rw-r--r--client/style.css4
-rw-r--r--server/cafp.cabal2
-rw-r--r--server/lib/Cafp/Game.hs151
-rw-r--r--server/lib/Cafp/Main/GenerateElmTypes.hs3
-rw-r--r--server/lib/Cafp/Messages.hs57
7 files changed, 231 insertions, 87 deletions
diff --git a/client/src/Client.elm b/client/src/Client.elm
index e3ecbf6..7cac663 100644
--- a/client/src/Client.elm
+++ b/client/src/Client.elm
@@ -26,6 +26,8 @@ type Msg
-- Voting
| SelectVote Int
| SubmitVote
+ -- Tally
+ | ConfirmTally
type alias Cards = {black : Array String, white : Array String}
@@ -49,12 +51,12 @@ parseRoomId url = case String.split "/" url.path of
_ :: "rooms" :: roomId :: _ -> Ok roomId
_ -> Err <| "Invalid path: " ++ url.path
-viewOpponent : Messages.Opponent -> Html msg
-viewOpponent opponent = Html.div [] <|
- [ Html.text opponent.name
+viewPlayer : Messages.PlayerView -> Html msg
+viewPlayer player = Html.div [] <|
+ [ Html.text player.name
] ++
- (if opponent.admin then [Html.text " 👑"] else []) ++
- (if opponent.ready then [Html.text " ✅"] else [])
+ (if player.admin then [Html.text " 👑"] else []) ++
+ (if player.ready then [Html.text " ✅"] else [])
view : Model -> List (Html Msg)
view model = case model of
@@ -67,10 +69,10 @@ view model = case model of
[Html.text <| "Connecting to room " ++ state.roomId ++ "..."]
]
Game game ->
- [ Html.h1 [] [Html.text "Opponents"]
+ [ Html.h1 [] [Html.text "Players"]
, Html.ul [] <| List.map
- (\o -> Html.li [] [viewOpponent o])
- game.view.opponents
+ (\o -> Html.li [] [viewPlayer o])
+ game.view.players
, Html.h1 [] [Html.text "You"]
, Html.form
[ Html.Attributes.action ""
@@ -84,7 +86,8 @@ view model = case model of
, Html.button
[ Html.Attributes.type_ "submit"
, Html.Attributes.disabled <|
- game.view.myName == game.changeMyName
+ game.view.me.name == game.changeMyName ||
+ String.length game.changeMyName > 32
]
[Html.text "Update name"]
]
@@ -100,6 +103,7 @@ tableBlackCard : GameState -> Maybe BlackCard
tableBlackCard game = case game.view.table of
Messages.Proposing b _ -> Just b
Messages.Voting b _ _ _ -> Just b
+ Messages.Tally b _ -> Just b
selectedWhiteCards : GameState -> List WhiteCard
selectedWhiteCards game = case game.view.table of
@@ -148,6 +152,23 @@ viewTable game = case game.view.table of
[Html.text "Vote"]
]
+ Messages.Tally black results -> Html.div [] <|
+ [Html.h2 [] [Html.text "Vote results"]] ++
+ List.map (\voted ->
+ let attrs =
+ if List.length voted.winners > 0 then
+ [Html.Attributes.class "winner"]
+ else
+ [] in
+ blackCard attrs game.cards black voted.proposal)
+ results ++
+ if not game.view.me.admin then
+ []
+ else
+ [ Html.button
+ [Html.Events.onClick ConfirmTally] [Html.text "Next round"]
+ ]
+
intersperseWith : List a -> a -> List a -> List a
intersperseWith values def list = case list of
[] -> []
@@ -222,7 +243,7 @@ update msg model = case msg of
( Game
{ cards = {black = Array.empty, white = Array.empty}
, view = gameView
- , changeMyName = gameView.myName
+ , changeMyName = gameView.me.name
, selectedWhiteCards = []
, selectedVote = Nothing
}
@@ -280,6 +301,8 @@ update msg model = case msg of
_ -> (model, Cmd.none)
_ -> (model, Cmd.none)
+ ConfirmTally -> (model, send <| Messages.ConfirmTally)
+
main : Program () Model Msg
main = Browser.application
{ init = \() url key -> case parseRoomId url of
diff --git a/client/src/Messages.elm b/client/src/Messages.elm
index 3324886..a100dbf 100644
--- a/client/src/Messages.elm
+++ b/client/src/Messages.elm
@@ -56,25 +56,51 @@ jsonEncCards val =
-type alias Opponent =
+type alias PlayerView =
{ name: String
, admin: Bool
, ready: Bool
+ , points: Int
}
-jsonDecOpponent : Json.Decode.Decoder ( Opponent )
-jsonDecOpponent =
- Json.Decode.succeed (\pname padmin pready -> {name = pname, admin = padmin, ready = pready})
+jsonDecPlayerView : Json.Decode.Decoder ( PlayerView )
+jsonDecPlayerView =
+ Json.Decode.succeed (\pname padmin pready ppoints -> {name = pname, admin = padmin, ready = pready, points = ppoints})
|> required "name" (Json.Decode.string)
|> required "admin" (Json.Decode.bool)
|> required "ready" (Json.Decode.bool)
+ |> required "points" (Json.Decode.int)
-jsonEncOpponent : Opponent -> Value
-jsonEncOpponent val =
+jsonEncPlayerView : PlayerView -> Value
+jsonEncPlayerView val =
Json.Encode.object
[ ("name", Json.Encode.string val.name)
, ("admin", Json.Encode.bool val.admin)
, ("ready", Json.Encode.bool val.ready)
+ , ("points", Json.Encode.int val.points)
+ ]
+
+
+
+type alias VotedView =
+ { proposal: (List WhiteCard)
+ , score: Int
+ , winners: (List String)
+ }
+
+jsonDecVotedView : Json.Decode.Decoder ( VotedView )
+jsonDecVotedView =
+ Json.Decode.succeed (\pproposal pscore pwinners -> {proposal = pproposal, score = pscore, winners = pwinners})
+ |> required "proposal" (Json.Decode.list (jsonDecWhiteCard))
+ |> required "score" (Json.Decode.int)
+ |> required "winners" (Json.Decode.list (Json.Decode.string))
+
+jsonEncVotedView : VotedView -> Value
+jsonEncVotedView val =
+ Json.Encode.object
+ [ ("proposal", (Json.Encode.list jsonEncWhiteCard) val.proposal)
+ , ("score", Json.Encode.int val.score)
+ , ("winners", (Json.Encode.list Json.Encode.string) val.winners)
]
@@ -82,12 +108,14 @@ jsonEncOpponent val =
type TableView =
Proposing BlackCard (List WhiteCard)
| Voting BlackCard (List (List WhiteCard)) Int (Maybe Int)
+ | Tally BlackCard (List VotedView)
jsonDecTableView : Json.Decode.Decoder ( TableView )
jsonDecTableView =
let jsonDecDictTableView = Dict.fromList
[ ("Proposing", Json.Decode.lazy (\_ -> Json.Decode.map2 Proposing (Json.Decode.index 0 (jsonDecBlackCard)) (Json.Decode.index 1 (Json.Decode.list (jsonDecWhiteCard)))))
, ("Voting", Json.Decode.lazy (\_ -> Json.Decode.map4 Voting (Json.Decode.index 0 (jsonDecBlackCard)) (Json.Decode.index 1 (Json.Decode.list (Json.Decode.list (jsonDecWhiteCard)))) (Json.Decode.index 2 (Json.Decode.int)) (Json.Decode.index 3 (Json.Decode.maybe (Json.Decode.int)))))
+ , ("Tally", Json.Decode.lazy (\_ -> Json.Decode.map2 Tally (Json.Decode.index 0 (jsonDecBlackCard)) (Json.Decode.index 1 (Json.Decode.list (jsonDecVotedView)))))
]
in decodeSumObjectWithSingleField "TableView" jsonDecDictTableView
@@ -96,30 +124,31 @@ jsonEncTableView val =
let keyval v = case v of
Proposing v1 v2 -> ("Proposing", encodeValue (Json.Encode.list identity [jsonEncBlackCard v1, (Json.Encode.list jsonEncWhiteCard) v2]))
Voting v1 v2 v3 v4 -> ("Voting", encodeValue (Json.Encode.list identity [jsonEncBlackCard v1, (Json.Encode.list (Json.Encode.list jsonEncWhiteCard)) v2, Json.Encode.int v3, (maybeEncode (Json.Encode.int)) v4]))
+ Tally v1 v2 -> ("Tally", encodeValue (Json.Encode.list identity [jsonEncBlackCard v1, (Json.Encode.list jsonEncVotedView) v2]))
in encodeSumObjectWithSingleField keyval val
type alias GameView =
- { opponents: (List Opponent)
- , myName: String
+ { players: (List PlayerView)
+ , me: PlayerView
, table: TableView
, hand: (List WhiteCard)
}
jsonDecGameView : Json.Decode.Decoder ( GameView )
jsonDecGameView =
- Json.Decode.succeed (\popponents pmyName ptable phand -> {opponents = popponents, myName = pmyName, table = ptable, hand = phand})
- |> required "opponents" (Json.Decode.list (jsonDecOpponent))
- |> required "myName" (Json.Decode.string)
+ Json.Decode.succeed (\pplayers pme ptable phand -> {players = pplayers, me = pme, table = ptable, hand = phand})
+ |> required "players" (Json.Decode.list (jsonDecPlayerView))
+ |> required "me" (jsonDecPlayerView)
|> required "table" (jsonDecTableView)
|> required "hand" (Json.Decode.list (jsonDecWhiteCard))
jsonEncGameView : GameView -> Value
jsonEncGameView val =
Json.Encode.object
- [ ("opponents", (Json.Encode.list jsonEncOpponent) val.opponents)
- , ("myName", Json.Encode.string val.myName)
+ [ ("players", (Json.Encode.list jsonEncPlayerView) val.players)
+ , ("me", jsonEncPlayerView val.me)
, ("table", jsonEncTableView val.table)
, ("hand", (Json.Encode.list jsonEncWhiteCard) val.hand)
]
@@ -157,6 +186,7 @@ type ClientMessage =
ChangeMyName String
| ProposeWhiteCards (List WhiteCard)
| SubmitVote Int
+ | ConfirmTally
jsonDecClientMessage : Json.Decode.Decoder ( ClientMessage )
jsonDecClientMessage =
@@ -164,6 +194,7 @@ jsonDecClientMessage =
[ ("ChangeMyName", Json.Decode.lazy (\_ -> Json.Decode.map ChangeMyName (Json.Decode.string)))
, ("ProposeWhiteCards", Json.Decode.lazy (\_ -> Json.Decode.map ProposeWhiteCards (Json.Decode.list (jsonDecWhiteCard))))
, ("SubmitVote", Json.Decode.lazy (\_ -> Json.Decode.map SubmitVote (Json.Decode.int)))
+ , ("ConfirmTally", Json.Decode.lazy (\_ -> Json.Decode.succeed ConfirmTally))
]
in decodeSumObjectWithSingleField "ClientMessage" jsonDecDictClientMessage
@@ -173,6 +204,7 @@ jsonEncClientMessage val =
ChangeMyName v1 -> ("ChangeMyName", encodeValue (Json.Encode.string v1))
ProposeWhiteCards v1 -> ("ProposeWhiteCards", encodeValue ((Json.Encode.list jsonEncWhiteCard) v1))
SubmitVote v1 -> ("SubmitVote", encodeValue (Json.Encode.int v1))
+ ConfirmTally -> ("ConfirmTally", encodeValue (Json.Encode.list identity []))
in encodeSumObjectWithSingleField keyval val
diff --git a/client/style.css b/client/style.css
index 4a134c6..e3824b6 100644
--- a/client/style.css
+++ b/client/style.css
@@ -25,6 +25,10 @@ html {
background: #003300;
}
+.winner {
+ background: #701e58;
+}
+
.white {
color: black;
background: white;
diff --git a/server/cafp.cabal b/server/cafp.cabal
index 14ef7ad..f80184c 100644
--- a/server/cafp.cabal
+++ b/server/cafp.cabal
@@ -35,6 +35,8 @@ Library
text >= 1.2 && < 1.3,
unordered-containers >= 0.2 && < 0.3,
vector >= 0.12 && < 0.13,
+ vector-algorithms >= 0.8 && < 0.9,
+ vector-instances >= 3.4 && < 3.5,
vector-shuffling >= 1.1 && < 1.2,
wai >= 3.2 && < 3.3,
wai-websockets >= 3.0 && < 3.1,
diff --git a/server/lib/Cafp/Game.hs b/server/lib/Cafp/Game.hs
index 14228fd..379b3a5 100644
--- a/server/lib/Cafp/Game.hs
+++ b/server/lib/Cafp/Game.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
@@ -19,26 +20,31 @@ module Cafp.Game
) where
import Cafp.Messages
-import Control.Lens (Lens', at, ix, orOf, over, to,
- (%%=), (%=), (&), (.=), (.~), (^.),
- (^..), (^?), _1, _2, _3)
-import Control.Lens.TH (makeLenses, makePrisms)
-import Control.Monad (guard)
-import Control.Monad.State (State, execState, modify, runState,
- state)
-import Data.Bifunctor (first)
-import qualified Data.HashMap.Strict as HMS
-import Data.List (sort)
-import Data.Maybe (fromMaybe)
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import System.Random (StdGen)
-import VectorShuffling.Immutable (shuffle)
+import Control.Lens (Lens', at, 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)
+import Data.Foldable (for_)
+import qualified Data.HashMap.Strict as HMS
+import Data.List (sort)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Vector as V
+import qualified Data.Vector.Algorithms.Merge as V
+import Data.Vector.Instances ()
+import System.Random (StdGen)
+import VectorShuffling.Immutable (shuffle)
type PlayerId = Int
-type Proposal = [WhiteCard]
+type Proposal = V.Vector WhiteCard
data Table
= TableProposing
@@ -48,12 +54,16 @@ data Table
!BlackCard
!(V.Vector (Proposal, [PlayerId]))
!(HMS.HashMap PlayerId Int)
+ | TableTally
+ !BlackCard
+ !(V.Vector VotedView)
deriving (Show)
data Player = Player
- { _playerName :: !Text
- , _playerHand :: !(V.Vector WhiteCard)
- , _playerAdmin :: !Bool
+ { _playerName :: !Text
+ , _playerHand :: !(V.Vector WhiteCard)
+ , _playerAdmin :: !Bool
+ , _playerPoints :: !Int
} deriving (Show)
data Game = Game
@@ -119,7 +129,7 @@ joinGame = runState $ do
pid <- gameNextPlayerId %%= (\x -> (x, x + 1))
let name = "Player " <> T.pack (show pid)
hand <- V.replicateM 6 popWhiteCard
- gamePlayers %= HMS.insert pid (Player name hand False)
+ gamePlayers %= HMS.insert pid (Player name hand False 0)
modify assignAdmin
pure pid
@@ -130,9 +140,44 @@ blackCardBlanks :: Cards -> BlackCard -> Int
blackCardBlanks cards (BlackCard c) =
maybe 0 (length . T.breakOnAll "\\BLANK") $ cardsBlack cards V.!? c
+maximaOn :: Ord o => (a -> o) -> [a] -> [a]
+maximaOn f = \case [] -> []; x : xs -> go [x] (f x) xs
+ where
+ go best _ [] = reverse best
+ go best bestScore (x : xs) =
+ let score = f x in
+ case compare score bestScore of
+ LT -> go best bestScore xs
+ EQ -> go (x : best) bestScore xs
+ GT -> go [x] score xs
+
+tallyVotes
+ :: Game
+ -> (V.Vector (Proposal, [PlayerId]))
+ -> (HMS.HashMap PlayerId Int)
+ -> (V.Vector VotedView, [PlayerId])
+tallyVotes game shuffled votes =
+ let counts :: HMS.HashMap Int Int -- Index, votes received.
+ counts = HMS.fromListWith (+) [(idx, 1) | (_, idx) <- HMS.toList votes]
+ best = map fst . maximaOn snd $ HMS.toList counts in
+ ( byScore $ V.imap (\i (proposal, players) -> VotedView
+ { votedProposal = proposal
+ , votedScore = fromMaybe 0 $ HMS.lookup i counts
+ , votedWinners = V.fromList $ do
+ guard $ i `elem` best
+ p <- players
+ game ^.. gamePlayers . ix p . playerName
+ })
+ shuffled
+ , [player | idx <- best, player <- snd $ shuffled V.! idx]
+ )
+ where
+ byScore = V.modify $ V.sortBy . comparing $ Down . votedScore
+
stepGame :: Game -> Game
stepGame game = case game ^. gameTable of
TableProposing black proposals
+ -- Everyone has proposed.
| HMS.null ((game ^. gamePlayers) `HMS.difference` proposals) ->
let proposalsMap = HMS.fromListWith (++) $ do
(pid, proposal) <- HMS.toList proposals
@@ -142,12 +187,22 @@ stepGame game = case game ^. gameTable of
game & gameSeed .~ seed
& gameTable .~ TableVoting black shuffled HMS.empty
| otherwise -> game
- TableVoting _ _ _ -> game
+ TableVoting black shuffled votes
+ -- Everyone has voted.
+ | HMS.null ((game ^. gamePlayers) `HMS.difference` votes) ->
+ let (voted, wins) = tallyVotes game shuffled votes in
+ flip execState game $ do
+ for_ wins $ \win -> gamePlayers . ix win . playerPoints += 1
+ gameTable .= TableTally black voted
+ | otherwise -> game
+ TableTally _ _ -> game
processClientMessage :: PlayerId -> ClientMessage -> Game -> Game
processClientMessage pid msg game = case msg of
- ChangeMyName name ->
- game & gamePlayers . ix pid . playerName .~ name
+ ChangeMyName name
+ | T.length name > 32 -> game
+ | otherwise -> game & gamePlayers . ix pid . playerName .~ name
+
ProposeWhiteCards cs
-- Bad card(s) proposed, i.e. not in hand of player.
| any (not . (`elem` hand)) cs -> game
@@ -162,6 +217,7 @@ processClientMessage pid msg game = case msg of
SubmitVote i -> case game ^. gameTable of
TableProposing _ _ -> game
+ TableTally _ _ -> game
TableVoting _ shuffled votes
-- Vote out of bounds.
| i < 0 || i >= V.length shuffled -> game
@@ -172,32 +228,47 @@ processClientMessage pid msg game = case msg of
-- Ok vote.
| otherwise -> stepGame $ game
& gameTable . _TableVoting . _3 . at pid .~ Just i
+
+ ConfirmTally
+ | TableTally _ _ <- game ^. gameTable
+ , Just True <- game ^? gamePlayers . ix pid . playerAdmin ->
+ flip execState game $ do
+ black <- popBlackCard
+ gameTable .= TableProposing black HMS.empty
+ | otherwise -> game
where
hand = game ^.. gamePlayers . ix pid . playerHand . traverse
gameViewForPlayer :: PlayerId -> Game -> GameView
gameViewForPlayer self game =
- let opponents = do
- (pid, p) <- HMS.toList $ game ^. gamePlayers
- guard $ pid /= self
- let ready = case game ^. gameTable of
- TableProposing _ proposals -> HMS.member pid proposals
- TableVoting _ _ votes -> HMS.member pid votes
- pure $ Opponent (p ^. playerName) (p ^. playerAdmin) ready
-
- player = game ^. gamePlayers . at self
+ let playerView pid player = PlayerView
+ { playerViewName = player ^. playerName
+ , playerViewAdmin = player ^. playerAdmin
+ , playerViewReady = case game ^. gameTable of
+ TableProposing _ proposals -> HMS.member pid proposals
+ TableVoting _ _ votes -> HMS.member pid votes
+ TableTally _ _ -> False
+ , playerViewPoints = player ^. playerPoints
+ }
table = case game ^. gameTable of
TableProposing black proposals ->
- Proposing black . fromMaybe [] $ HMS.lookup self proposals
+ Proposing black . fromMaybe V.empty $ HMS.lookup self proposals
TableVoting black shuffled votes -> Voting
black
- (fst <$> V.toList shuffled)
+ (fst <$> shuffled)
(fromMaybe 0 $ V.findIndex ((self `elem`) . snd) shuffled)
- (HMS.lookup self votes) in
+ (HMS.lookup self votes)
+ TableTally black voted -> Tally black voted in
GameView
- { gameViewOpponents = opponents
- , gameViewMyName = maybe "" (^. playerName) player
- , gameViewTable = table
- , gameViewHand = player ^.. traverse . playerHand . traverse
+ { gameViewPlayers = V.fromList . map snd . HMS.toList
+ . HMS.delete self . imap playerView $ game ^. gamePlayers
+ , gameViewMe = maybe dummy (playerView self) $
+ game ^? gamePlayers . ix self
+ , gameViewTable = table
+ , gameViewHand = fromMaybe V.empty $
+ game ^? gamePlayers . ix self . playerHand
}
+
+ where
+ dummy = PlayerView "" False False 0
diff --git a/server/lib/Cafp/Main/GenerateElmTypes.hs b/server/lib/Cafp/Main/GenerateElmTypes.hs
index b1e6efe..ccf19e8 100644
--- a/server/lib/Cafp/Main/GenerateElmTypes.hs
+++ b/server/lib/Cafp/Main/GenerateElmTypes.hs
@@ -13,7 +13,8 @@ main = putStrLn $ makeElmModule "Messages"
[ DefineElm (Proxy :: Proxy BlackCard)
, DefineElm (Proxy :: Proxy WhiteCard)
, DefineElm (Proxy :: Proxy Cards)
- , DefineElm (Proxy :: Proxy Opponent)
+ , DefineElm (Proxy :: Proxy PlayerView)
+ , DefineElm (Proxy :: Proxy VotedView)
, DefineElm (Proxy :: Proxy TableView)
, DefineElm (Proxy :: Proxy GameView)
, DefineElm (Proxy :: Proxy ServerMessage)
diff --git a/server/lib/Cafp/Messages.hs b/server/lib/Cafp/Messages.hs
index cfc8597..4e5123d 100644
--- a/server/lib/Cafp/Messages.hs
+++ b/server/lib/Cafp/Messages.hs
@@ -4,7 +4,8 @@ module Cafp.Messages
( BlackCard (..)
, WhiteCard (..)
, Cards (..)
- , Opponent (..)
+ , PlayerView (..)
+ , VotedView (..)
, TableView (..)
, GameView (..)
, ServerMessage (..)
@@ -26,49 +27,59 @@ data WhiteCard = WhiteCard Int deriving (Eq, Generic, Show)
instance Hashable WhiteCard
data Cards = Cards
- { cardsBlack :: Vector Text
- , cardsWhite :: Vector Text
+ { cardsBlack :: !(Vector Text)
+ , cardsWhite :: !(Vector Text)
} deriving (Show)
-data Opponent = Opponent
- { opponentName :: Text
- , opponentAdmin :: Bool
- , opponentReady :: Bool
+data PlayerView = PlayerView
+ { playerViewName :: !Text
+ , playerViewAdmin :: !Bool
+ , playerViewReady :: !Bool
+ , playerViewPoints :: !Int
+ } deriving (Show)
+
+data VotedView = VotedView
+ { votedProposal :: !(Vector WhiteCard)
+ , votedScore :: !Int
+ , votedWinners :: !(Vector Text)
} deriving (Show)
data TableView
- = Proposing BlackCard [WhiteCard]
+ = Proposing !BlackCard !(Vector WhiteCard)
| Voting
- BlackCard
- [[WhiteCard]] -- ^ Proposals to vote for
- Int -- ^ My proposal
- (Maybe Int) -- ^ My vote
+ !BlackCard
+ !(Vector (Vector WhiteCard)) -- ^ Proposals to vote for
+ !Int -- ^ My proposal
+ !(Maybe Int) -- ^ My vote
+ | Tally !BlackCard !(Vector VotedView)
deriving (Show)
data GameView = GameView
- { gameViewOpponents :: [Opponent]
- , gameViewMyName :: Text
- , gameViewTable :: TableView
- , gameViewHand :: [WhiteCard]
+ { gameViewPlayers :: !(Vector PlayerView)
+ , gameViewMe :: !PlayerView
+ , gameViewTable :: !TableView
+ , gameViewHand :: !(Vector WhiteCard)
} deriving (Show)
data ServerMessage
- = Welcome Int
- | SyncCards Cards
- | SyncGameView GameView
+ = Welcome !Int
+ | SyncCards !Cards
+ | SyncGameView !GameView
| Bye
deriving (Show)
data ClientMessage
- = ChangeMyName Text
- | ProposeWhiteCards [WhiteCard]
- | SubmitVote Int
+ = ChangeMyName !Text
+ | ProposeWhiteCards !(Vector WhiteCard)
+ | SubmitVote !Int
+ | ConfirmTally
deriving (Show)
deriveBoth defaultOptions ''BlackCard
deriveBoth defaultOptions ''WhiteCard
deriveBoth (defaultOptionsDropLower 5) ''Cards
-deriveBoth (defaultOptionsDropLower 8) ''Opponent
+deriveBoth (defaultOptionsDropLower 10) ''PlayerView
+deriveBoth (defaultOptionsDropLower 5) ''VotedView
deriveBoth defaultOptions ''TableView
deriveBoth (defaultOptionsDropLower 8) ''GameView
deriveBoth defaultOptions ''ServerMessage
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-31 15:22:29 +0000