diff options
author | Jasper Van der Jeugt | 2020-07-30 20:09:47 +0200 |
---|---|---|
committer | Jasper Van der Jeugt | 2020-07-30 20:09:47 +0200 |
commit | 68588db76baaf8f2f17dd9b7f3649b09e102ea85 (patch) | |
tree | 5704809d61b4ecfb6ac40f06b1ad51e23c9d313c /server | |
parent | 3b7d11c6182b8aa3d3d4f9e36c213e4eba6c8d8f (diff) |
Pass black and white cards to the client
Diffstat (limited to 'server')
-rw-r--r-- | server/lib/Cafp/Game.hs | 6 | ||||
-rw-r--r-- | server/lib/Cafp/Main/GenerateElmTypes.hs | 4 | ||||
-rw-r--r-- | server/lib/Cafp/Main/Server.hs | 4 | ||||
-rw-r--r-- | server/lib/Cafp/Messages.hs | 13 |
4 files changed, 19 insertions, 8 deletions
diff --git a/server/lib/Cafp/Game.hs b/server/lib/Cafp/Game.hs index a083e57..ad33368 100644 --- a/server/lib/Cafp/Game.hs +++ b/server/lib/Cafp/Game.hs @@ -26,8 +26,8 @@ import qualified Data.Text as T type PlayerId = Int data Cards = Cards - { _cardsBlack :: [T.Text] - , _cardsWhite :: [T.Text] + { _cardsBlack :: [BlackCard] + , _cardsWhite :: [WhiteCard] } deriving (Show) data Game = Game @@ -50,7 +50,6 @@ joinGame game = , game & gameNextPlayerId %~ succ & gamePlayers %~ HMS.insert pid name ) - leaveGame :: PlayerId -> Game -> Game leaveGame pid = over gamePlayers $ HMS.delete pid @@ -67,4 +66,5 @@ gameViewForPlayer self game = { gameViewOpponents = opponents , gameViewMyName = name , gameViewBlackCard = game ^? gameCards . cardsBlack . ix 0 + , gameViewHand = take 10 $ game ^. gameCards . cardsWhite } diff --git a/server/lib/Cafp/Main/GenerateElmTypes.hs b/server/lib/Cafp/Main/GenerateElmTypes.hs index 9c72027..51376a5 100644 --- a/server/lib/Cafp/Main/GenerateElmTypes.hs +++ b/server/lib/Cafp/Main/GenerateElmTypes.hs @@ -10,7 +10,9 @@ import Elm.Module main :: IO () main = putStrLn $ makeElmModule "Messages" - [ DefineElm (Proxy :: Proxy GameView) + [ DefineElm (Proxy :: Proxy BlackCard) + , DefineElm (Proxy :: Proxy WhiteCard) + , DefineElm (Proxy :: Proxy GameView) , DefineElm (Proxy :: Proxy ServerMessage) , DefineElm (Proxy :: Proxy ClientMessage) ] diff --git a/server/lib/Cafp/Main/Server.hs b/server/lib/Cafp/Main/Server.hs index eae887e..3edf039 100644 --- a/server/lib/Cafp/Main/Server.hs +++ b/server/lib/Cafp/Main/Server.hs @@ -46,8 +46,8 @@ data Server = Server readCards :: IO Cards readCards = Cards - <$> fmap T.lines (T.readFile "assets/black.txt") - <*> fmap T.lines (T.readFile "assets/white.txt") + <$> fmap (map BlackCard . T.lines) (T.readFile "assets/black.txt") + <*> fmap (map WhiteCard . T.lines) (T.readFile "assets/white.txt") newServer :: IO Server newServer = Server <$> readCards <*> atomically (STM.newTVar HMS.empty) diff --git a/server/lib/Cafp/Messages.hs b/server/lib/Cafp/Messages.hs index 3e345f2..542189f 100644 --- a/server/lib/Cafp/Messages.hs +++ b/server/lib/Cafp/Messages.hs @@ -1,6 +1,8 @@ {-# LANGUAGE TemplateHaskell #-} module Cafp.Messages - ( GameView (..) + ( BlackCard (..) + , WhiteCard (..) + , GameView (..) , ServerMessage (..) , ClientMessage (..) ) where @@ -8,10 +10,15 @@ module Cafp.Messages import Data.Text (Text) import Elm.Derive +data BlackCard = BlackCard Text deriving (Show) + +data WhiteCard = WhiteCard Text deriving (Show) + data GameView = GameView { gameViewOpponents :: [Text] , gameViewMyName :: Text - , gameViewBlackCard :: Maybe Text + , gameViewBlackCard :: Maybe BlackCard + , gameViewHand :: [WhiteCard] } deriving (Show) data ServerMessage @@ -24,6 +31,8 @@ data ClientMessage = ChangeMyName Text deriving (Show) +deriveBoth defaultOptions ''BlackCard +deriveBoth defaultOptions ''WhiteCard deriveBoth (defaultOptionsDropLower 8) ''GameView deriveBoth defaultOptions ''ServerMessage deriveBoth defaultOptions ''ClientMessage |