1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
module Uplcg.Messages
( BlackCard (..)
, WhiteCard (..)
, Cards (..)
, PlayerView (..)
, VotedView (..)
, TableView (..)
, GameView (..)
, ServerMessage (..)
, ClientMessage (..)
) where
import Data.Hashable (Hashable)
import Data.Text (Text)
import Data.Vector (Vector)
import Elm.Derive
import GHC.Generics (Generic)
data BlackCard = BlackCard Int deriving (Eq, Generic, Show)
instance Hashable BlackCard
data WhiteCard = WhiteCard Int deriving (Eq, Generic, Show)
instance Hashable WhiteCard
data Cards = Cards
{ cardsBlack :: !(Vector Text)
, cardsWhite :: !(Vector Text)
} deriving (Show)
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 !(Vector WhiteCard)
| Voting
!BlackCard
!(Vector (Vector WhiteCard)) -- ^ Proposals to vote for
!(Maybe Int) -- ^ My proposal
!(Maybe Int) -- ^ My vote
| Tally !BlackCard !(Vector VotedView)
deriving (Show)
data GameView = GameView
{ gameViewPlayers :: !(Vector PlayerView)
, gameViewMe :: !PlayerView
, gameViewTable :: !TableView
, gameViewHand :: !(Vector WhiteCard)
} deriving (Show)
data ServerMessage
= Welcome !Text
| SyncCards !Cards
| SyncGameView !GameView
deriving (Show)
data ClientMessage
= ChangeMyName !Text
| ProposeWhiteCards !(Vector WhiteCard)
| SubmitVote !Int
| AdminSkipProposals
| AdminSkipVotes
| AdminConfirmTally
deriving (Show)
deriveBoth defaultOptions ''BlackCard
deriveBoth defaultOptions ''WhiteCard
deriveBoth (defaultOptionsDropLower 5) ''Cards
deriveBoth (defaultOptionsDropLower 10) ''PlayerView
deriveBoth (defaultOptionsDropLower 5) ''VotedView
deriveBoth defaultOptions ''TableView
deriveBoth (defaultOptionsDropLower 8) ''GameView
deriveBoth defaultOptions ''ServerMessage
deriveBoth defaultOptions ''ClientMessage
|
