aboutsummaryrefslogtreecommitdiff
path: root/server/lib/Uplcg/Messages.hs
blob: b1627e9e1b9df93996cc215d4c00200d650fb4e3 (plain)
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