Pass black and white cards to the client

7 files changed, 75 insertions, 18 deletions

diff --git a/client/src/Client.elm b/client/src/Client.elm
index efd97fb..41871e9 100644
--- a/client/src/Client.elm
+++ b/client/src/Client.elm
@@ -70,16 +70,22 @@ view model = case model of
         ] ++
         (case game.view.blackCard of
             Nothing -> []
-            Just c -> [blackCard c])
+            Just c -> [blackCard c]) ++
+        (List.map whiteCard game.view.hand)
 
-blackCard : String -> Html a
-blackCard string =
+blackCard : Messages.BlackCard -> Html a
+blackCard (Messages.BlackCard string) =
     let blank = Html.span [Html.Attributes.class "blank"] [] in
-    Html.div [Html.Attributes.class "black"] <|
+    Html.div [Html.Attributes.class "card", Html.Attributes.class "black"] <|
     List.intersperse blank <|
     List.map Html.text <|
     String.split "\\BLANK" string
 
+whiteCard : Messages.WhiteCard -> Html a
+whiteCard (Messages.WhiteCard string) = Html.div
+    [Html.Attributes.class "card", Html.Attributes.class "white"]
+    [Html.text string]
+
 subscriptions : Model -> Sub Msg
 subscriptions model = webSocketIn WebSocketIn
 
diff --git a/client/src/Messages.elm b/client/src/Messages.elm
index 77b3830..d2c2716 100644
--- a/client/src/Messages.elm
+++ b/client/src/Messages.elm
@@ -8,25 +8,56 @@ import Dict exposing (Dict)
 import Set exposing (Set)
 
 
+type BlackCard  =
+    BlackCard String
+
+jsonDecBlackCard : Json.Decode.Decoder ( BlackCard )
+jsonDecBlackCard =
+    Json.Decode.lazy (\_ -> Json.Decode.map BlackCard (Json.Decode.string))
+
+
+jsonEncBlackCard : BlackCard -> Value
+jsonEncBlackCard (BlackCard v1) =
+    Json.Encode.string v1
+
+
+
+type WhiteCard  =
+    WhiteCard String
+
+jsonDecWhiteCard : Json.Decode.Decoder ( WhiteCard )
+jsonDecWhiteCard =
+    Json.Decode.lazy (\_ -> Json.Decode.map WhiteCard (Json.Decode.string))
+
+
+jsonEncWhiteCard : WhiteCard -> Value
+jsonEncWhiteCard (WhiteCard v1) =
+    Json.Encode.string v1
+
+
+
 type alias GameView  =
    { opponents: (List String)
    , myName: String
-   , blackCard: (Maybe String)
+   , blackCard: (Maybe BlackCard)
+   , hand: (List WhiteCard)
    }
 
 jsonDecGameView : Json.Decode.Decoder ( GameView )
 jsonDecGameView =
-   Json.Decode.succeed (\popponents pmyName pblackCard -> {opponents = popponents, myName = pmyName, blackCard = pblackCard})
+   Json.Decode.succeed (\popponents pmyName pblackCard phand -> {opponents = popponents, myName = pmyName, blackCard = pblackCard, hand = phand})
    |> required "opponents" (Json.Decode.list (Json.Decode.string))
    |> required "myName" (Json.Decode.string)
-   |> fnullable "blackCard" (Json.Decode.string)
+   |> fnullable "blackCard" (jsonDecBlackCard)
+   |> required "hand" (Json.Decode.list (jsonDecWhiteCard))
 
 jsonEncGameView : GameView -> Value
 jsonEncGameView  val =
    Json.Encode.object
    [ ("opponents", (Json.Encode.list Json.Encode.string) val.opponents)
    , ("myName", Json.Encode.string val.myName)
-   , ("blackCard", (maybeEncode (Json.Encode.string)) val.blackCard)
+   , ("blackCard", (maybeEncode (jsonEncBlackCard)) val.blackCard)
+   , ("hand", (Json.Encode.list jsonEncWhiteCard) val.hand)
    ]
 
 
diff --git a/client/style.css b/client/style.css
index fd26c52..6cd9f5d 100644
--- a/client/style.css
+++ b/client/style.css
@@ -2,11 +2,20 @@ html {
   font-size: 18px;
 }
 
+.card {
+  padding: 18px;
+  border-radius: 18px;
+}
+
 .black {
   color: white;
   background: black;
-  padding: 18px;
-  border-radius: 18px;
+}
+
+.white {
+  color: black;
+  background: white;
+  border: 2px solid black;
 }
 
 .blank {
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