aboutsummaryrefslogtreecommitdiff
path: root/server/lib/Cafp/Messages.hs
blob: ea6361cfda935951c55b223ee275b6becfe83d26 (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
{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE TemplateHaskell #-}
module Cafp.Messages
    ( BlackCard (..)
    , WhiteCard (..)
    , Cards (..)
    , Opponent (..)
    , 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 Opponent = Opponent
    { opponentName  :: Text
    , opponentReady :: Bool
    } deriving (Show)

data TableView
    = Proposing BlackCard [WhiteCard]
    | Voting
        BlackCard
        [WhiteCard]    -- ^ My proposal
        [[WhiteCard]]  -- ^ Proposals to vote for
        (Maybe Int)    -- ^ My vote
    deriving (Show)

data GameView = GameView
    { gameViewOpponents :: [Opponent]
    , gameViewMyName    :: Text
    , gameViewTable     :: TableView
    , gameViewHand      :: [WhiteCard]
    } deriving (Show)

data ServerMessage
    = Welcome Int
    | SyncCards Cards
    | SyncGameView GameView
    | Bye
    deriving (Show)

data ClientMessage
    = ChangeMyName Text
    | ProposeWhiteCards [WhiteCard]
    deriving (Show)

deriveBoth defaultOptions ''BlackCard
deriveBoth defaultOptions ''WhiteCard
deriveBoth (defaultOptionsDropLower 5) ''Cards
deriveBoth (defaultOptionsDropLower 8) ''Opponent
deriveBoth defaultOptions ''TableView
deriveBoth (defaultOptionsDropLower 8) ''GameView
deriveBoth defaultOptions ''ServerMessage
deriveBoth defaultOptions ''ClientMessage