From 68588db76baaf8f2f17dd9b7f3649b09e102ea85 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt
Date: Thu, 30 Jul 2020 20:09:47 +0200
Subject: Pass black and white cards to the client

---
 server/lib/Cafp/Game.hs                  |  6 +++---
 server/lib/Cafp/Main/GenerateElmTypes.hs |  4 +++-
 server/lib/Cafp/Main/Server.hs           |  4 ++--
 server/lib/Cafp/Messages.hs              | 13 +++++++++++--
 4 files changed, 19 insertions(+), 8 deletions(-)

(limited to 'server/lib')

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
-- 
cgit v1.2.3