diff options
| author | Jasper Van der Jeugt | 2020-08-02 21:52:46 +0200 |
|---|---|---|
| committer | Jasper Van der Jeugt | 2020-08-02 21:52:46 +0200 |
| commit | 477dae400d5f32a0572698ba132a26bc4a340975 (patch) | |
| tree | b74ebd8d52c4be5523ff478240cc6731ecf1b61f | |
| parent | fce7342703e8d6353f65cf28914948366f54ef81 (diff) | |
Admin but it's broken
| -rw-r--r-- | client/src/Client.elm | 3 | ||||
| -rw-r--r-- | client/src/Messages.elm | 5 | ||||
| -rw-r--r-- | server/lib/Cafp/Game.hs | 11 | ||||
| -rw-r--r-- | server/lib/Cafp/Messages.hs | 1 |
4 files changed, 13 insertions, 7 deletions
diff --git a/client/src/Client.elm b/client/src/Client.elm index aa6194e..e3ecbf6 100644 --- a/client/src/Client.elm +++ b/client/src/Client.elm @@ -53,7 +53,8 @@ viewOpponent : Messages.Opponent -> Html msg viewOpponent opponent = Html.div [] <| [ Html.text opponent.name ] ++ - if opponent.ready then [Html.text " ✅"] else [] + (if opponent.admin then [Html.text " 👑"] else []) ++ + (if opponent.ready then [Html.text " ✅"] else []) view : Model -> List (Html Msg) view model = case model of diff --git a/client/src/Messages.elm b/client/src/Messages.elm index 40a04a2..3324886 100644 --- a/client/src/Messages.elm +++ b/client/src/Messages.elm @@ -58,19 +58,22 @@ jsonEncCards val = type alias Opponent = { name: String + , admin: Bool , ready: Bool } jsonDecOpponent : Json.Decode.Decoder ( Opponent ) jsonDecOpponent = - Json.Decode.succeed (\pname pready -> {name = pname, ready = pready}) + Json.Decode.succeed (\pname padmin pready -> {name = pname, admin = padmin, ready = pready}) |> required "name" (Json.Decode.string) + |> required "admin" (Json.Decode.bool) |> required "ready" (Json.Decode.bool) jsonEncOpponent : Opponent -> Value jsonEncOpponent val = Json.Encode.object [ ("name", Json.Encode.string val.name) + , ("admin", Json.Encode.bool val.admin) , ("ready", Json.Encode.bool val.ready) ] diff --git a/server/lib/Cafp/Game.hs b/server/lib/Cafp/Game.hs index 0f80857..db904d6 100644 --- a/server/lib/Cafp/Game.hs +++ b/server/lib/Cafp/Game.hs @@ -106,9 +106,9 @@ newGame cards gen = flip execState state0 $ do joinGame :: Game -> (PlayerId, Game) joinGame = runState $ do pid <- gameNextPlayerId %%= (\x -> (x, x + 1)) - hasAdmin <- use (gamePlayers . traverse . playerAdmin . Any) + haveAdmin <- use (gamePlayers . traverse . playerAdmin . to Any) let name = "Player " <> T.pack (show pid) - admin = not (getAny hasAdmin) + admin = not (getAny haveAdmin) hand <- V.replicateM 6 popWhiteCard gamePlayers %= HMS.insert pid (Player name hand admin) pure pid @@ -170,9 +170,10 @@ gameViewForPlayer self game = let opponents = do (pid, p) <- HMS.toList $ game ^. gamePlayers guard $ pid /= self - pure $ Opponent (p ^. playerName) $ case game ^. gameTable of - TableProposing _ proposals -> HMS.member pid proposals - TableVoting _ _ votes -> HMS.member pid votes + let ready = case game ^. gameTable of + TableProposing _ proposals -> HMS.member pid proposals + TableVoting _ _ votes -> HMS.member pid votes + pure $ Opponent (p ^. playerName) (p ^. playerAdmin) ready player = game ^. gamePlayers . at self diff --git a/server/lib/Cafp/Messages.hs b/server/lib/Cafp/Messages.hs index df447c3..cfc8597 100644 --- a/server/lib/Cafp/Messages.hs +++ b/server/lib/Cafp/Messages.hs @@ -32,6 +32,7 @@ data Cards = Cards data Opponent = Opponent { opponentName :: Text + , opponentAdmin :: Bool , opponentReady :: Bool } deriving (Show) |