Full game flow

1 files changed, 34 insertions, 23 deletions

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