Send proposals to server

2 files changed, 32 insertions, 6 deletions

diff --git a/client/src/Client.elm b/client/src/Client.elm
index ea1a737..94e33cf 100644
--- a/client/src/Client.elm
+++ b/client/src/Client.elm
@@ -22,6 +22,7 @@ type Msg
     | SubmitMyName
     -- Card selection
     | SelectWhiteCard WhiteCard
+    | ProposeWhiteCards
 
 type alias Cards = {black : Array String, white : Array String}
 
@@ -74,7 +75,7 @@ view model = case model of
                 , Html.Attributes.disabled <|
                     game.view.myName == game.changeMyName
                 ]
-                [Html.text "change"]
+                [Html.text "Update name"]
             ]
         ] ++
         [viewTable game] ++
@@ -96,6 +97,15 @@ viewTable game = case game.view.table of
         [ blackCard game.cards c <| case selectedWhiteCard game of
             Nothing -> []
             Just wc -> [wc]
+        , Html.button
+            [ Html.Attributes.disabled <| case my of
+                Just _ -> True
+                _ -> case selectedWhiteCard game of
+                    Nothing -> True
+                    Just _ -> False
+            , Html.Events.onClick ProposeWhiteCards
+            ]
+            [Html.text "Propose"]
         ]
 
 intersperseWith : List a -> a -> List a -> List a
@@ -174,13 +184,22 @@ update msg model = case msg of
         Game game -> (Game {game | changeMyName = name}, Cmd.none)
         _ -> (model, Cmd.none)
     SubmitMyName -> case model of
-        Game game -> (model , send <| Messages.ChangeMyName game.changeMyName)
+        Game game -> (model, send <| Messages.ChangeMyName game.changeMyName)
         _ -> (model, Cmd.none)
 
     SelectWhiteCard card -> case model of
         Game game -> (Game {game | selectedWhiteCard = Just card}, Cmd.none)
         _ -> (model, Cmd.none)
 
+    ProposeWhiteCards -> case model of
+        Game game ->
+            ( Game {game | selectedWhiteCard = Nothing}
+            , case game.selectedWhiteCard of
+                Nothing -> Cmd.none
+                Just c -> send <| Messages.ProposeWhiteCards c
+            )
+        _ -> (model, Cmd.none)
+
 main : Program () Model Msg
 main = Browser.application
     { init = \() url key -> case parseRoomId url of
diff --git a/client/src/Messages.elm b/client/src/Messages.elm
index 69d0eff..1188525 100644
--- a/client/src/Messages.elm
+++ b/client/src/Messages.elm
@@ -125,14 +125,21 @@ jsonEncServerMessage  val =
 
 type ClientMessage  =
     ChangeMyName String
+    | ProposeWhiteCards WhiteCard
 
 jsonDecClientMessage : Json.Decode.Decoder ( ClientMessage )
 jsonDecClientMessage =
-    Json.Decode.lazy (\_ -> Json.Decode.map ChangeMyName (Json.Decode.string))
-
+    let jsonDecDictClientMessage = Dict.fromList
+            [ ("ChangeMyName", Json.Decode.lazy (\_ -> Json.Decode.map ChangeMyName (Json.Decode.string)))
+            , ("ProposeWhiteCards", Json.Decode.lazy (\_ -> Json.Decode.map ProposeWhiteCards (jsonDecWhiteCard)))
+            ]
+    in  decodeSumObjectWithSingleField  "ClientMessage" jsonDecDictClientMessage
 
 jsonEncClientMessage : ClientMessage -> Value
-jsonEncClientMessage (ChangeMyName v1) =
-    Json.Encode.string v1
+jsonEncClientMessage  val =
+    let keyval v = case v of
+                    ChangeMyName v1 -> ("ChangeMyName", encodeValue (Json.Encode.string v1))
+                    ProposeWhiteCards v1 -> ("ProposeWhiteCards", encodeValue (jsonEncWhiteCard v1))
+    in encodeSumObjectWithSingleField keyval val