diff --git a/client/src/MassiveDecks.elm b/client/src/MassiveDecks.elm index 814a540..d34fb81 100644 --- a/client/src/MassiveDecks.elm +++ b/client/src/MassiveDecks.elm @@ -1,7 +1,6 @@ module MassiveDecks exposing (main) import Navigation - import MassiveDecks.Models exposing (Init, Path, pathFromLocation) import MassiveDecks.Scenes.Start as Start import MassiveDecks.Scenes.Start.Messages as Start @@ -11,13 +10,16 @@ import MassiveDecks.Scenes.Start.Models as Start {-| The main application loop setup. -} main : Program Init Start.Model Start.Message -main = Navigation.programWithFlags - locationToMessage - { init = Start.init - , update = Start.update - , subscriptions = Start.subscriptions - , view = Start.view - } +main = + Navigation.programWithFlags + locationToMessage + { init = Start.init + , update = Start.update + , subscriptions = Start.subscriptions + , view = Start.view + } + locationToMessage : Navigation.Location -> Start.Message -locationToMessage location = pathFromLocation location |> Start.PathChange +locationToMessage location = + pathFromLocation location |> Start.PathChange diff --git a/client/src/MassiveDecks/API.elm b/client/src/MassiveDecks/API.elm index d6fd11b..827e85c 100644 --- a/client/src/MassiveDecks/API.elm +++ b/client/src/MassiveDecks/API.elm @@ -2,7 +2,6 @@ module MassiveDecks.API exposing (..) import Json.Decode as Decode import Json.Encode as Encode - import MassiveDecks.API.Request exposing (..) import MassiveDecks.Scenes.Playing.HouseRule.Id as HouseRule import MassiveDecks.Models.Game as Game @@ -16,7 +15,8 @@ import MassiveDecks.Models.JSON.Encode exposing (..) {-| Makes a request to create a new game lobby to the server. On success, returns that lobby. -} createLobby : String -> Request Never Game.GameCodeAndSecret -createLobby name = request "POST" "/api/lobbies" (Just (encodeName name)) [] gameCodeAndSecretDecoder +createLobby name = + request "POST" "/api/lobbies" (Just (encodeName name)) [] gameCodeAndSecretDecoder {-| Errors specific to new player requests. @@ -24,65 +24,67 @@ createLobby name = request "POST" "/api/lobbies" (Just (encodeName name)) [] gam * `LobbyNotFound` - The given lobby does not exist. -} type NewPlayerError - = NameInUse - | NewPlayerLobbyNotFound + = NameInUse + | NewPlayerLobbyNotFound + {-| Makes a request to add a new player to the given lobby. On success, returns a `Secret` for that player. -} newPlayer : String -> String -> Request NewPlayerError Player.Secret newPlayer gameCode name = - request - "POST" - ("/api/lobbies/" ++ gameCode ++ "/players") - (Just (encodeName name)) - [ ((400, "name-in-use"), Decode.succeed NameInUse) - , ((404, "lobby-not-found"), Decode.succeed NewPlayerLobbyNotFound) - ] - playerSecretDecoder + request + "POST" + ("/api/lobbies/" ++ gameCode ++ "/players") + (Just (encodeName name)) + [ ( ( 400, "name-in-use" ), Decode.succeed NameInUse ) + , ( ( 404, "lobby-not-found" ), Decode.succeed NewPlayerLobbyNotFound ) + ] + playerSecretDecoder {-| Errors specific to getting the lobby and hand. * `LobbyNotFound` - The given lobby does not exist. -} type GetLobbyAndHandError - = LobbyNotFound - | SecretWrongOrNotAPlayer + = LobbyNotFound + | SecretWrongOrNotAPlayer {-| Get the lobby and the hand for the player with the given secret (using it to authenticate). -} getLobbyAndHand : String -> Player.Secret -> Request GetLobbyAndHandError Game.LobbyAndHand -getLobbyAndHand = commandRequest - "getLobbyAndHand" - [] - [ ((404, "lobby-not-found"), Decode.succeed LobbyNotFound) - , ((403, "secret-wrong-or-not-a-player"), Decode.succeed SecretWrongOrNotAPlayer) - ] - lobbyAndHandDecoder +getLobbyAndHand = + commandRequest + "getLobbyAndHand" + [] + [ ( ( 404, "lobby-not-found" ), Decode.succeed LobbyNotFound ) + , ( ( 403, "secret-wrong-or-not-a-player" ), Decode.succeed SecretWrongOrNotAPlayer ) + ] + lobbyAndHandDecoder {-| Get the hand of the player with the given secret (using it to authenticate). -} getHand : String -> Player.Secret -> Request Never Card.Hand getHand gameCode secret = - request - "POST" - ("/api/lobbies/" ++ gameCode ++ "/players/" ++ (toString secret.id)) - (Just (encodePlayerSecret secret)) - [] - handDecoder + request + "POST" + ("/api/lobbies/" ++ gameCode ++ "/players/" ++ (toString secret.id)) + (Just (encodePlayerSecret secret)) + [] + handDecoder {-| Get the history of the given game. -} getHistory : String -> Request Never (List Round.FinishedRound) getHistory gameCode = - request - "GET" - ("/api/lobbies/" ++ gameCode ++ "/history") - Nothing - [] - (Decode.list finishedRoundDecoder) + request + "GET" + ("/api/lobbies/" ++ gameCode ++ "/history") + Nothing + [] + (Decode.list finishedRoundDecoder) {-| Errors specific to add deck requests. @@ -90,35 +92,36 @@ getHistory gameCode = * `DeckNotFound` - The given play code does not resolve to a Cardcast deck. -} type AddDeckError - = CardcastTimeout - | DeckNotFound + = CardcastTimeout + | DeckNotFound + {-| Makes a request to add the deck for the given play code to the game configuration, using the given secret to authenticate. -} addDeck : String -> Player.Secret -> String -> Request AddDeckError () addDeck gameCode secret playCode = - commandRequest - "addDeck" - [ ("playCode", Encode.string playCode) ] - [ ((502, "cardcast-timeout"), Decode.succeed CardcastTimeout) - , ((400, "deck-not-found"), Decode.succeed DeckNotFound) - ] - (Decode.succeed ()) - gameCode - secret + commandRequest + "addDeck" + [ ( "playCode", Encode.string playCode ) ] + [ ( ( 502, "cardcast-timeout" ), Decode.succeed CardcastTimeout ) + , ( ( 400, "deck-not-found" ), Decode.succeed DeckNotFound ) + ] + (Decode.succeed ()) + gameCode + secret {-| Makes a request to the server to add a new AI player to the game. -} newAi : String -> Player.Secret -> Request Never () newAi gameCode secret = - request - "POST" - ("/api/lobbies/" ++ gameCode ++ "/players/newAi") - (Just (encodePlayerSecret secret)) - [] - (Decode.succeed ()) + request + "POST" + ("/api/lobbies/" ++ gameCode ++ "/players/newAi") + (Just (encodePlayerSecret secret)) + [] + (Decode.succeed ()) {-| Errors specific to starting a new game. @@ -126,43 +129,44 @@ newAi gameCode secret = * `GameInProgress` - There is already a game in progress. -} type NewGameError - = NotEnoughPlayers Int - | GameInProgress + = NotEnoughPlayers Int + | GameInProgress {-| Makes a request to the server to start a new game in the given lobby, using the given secret to authenticate. -} newGame : String -> Player.Secret -> Request NewGameError Card.Hand newGame gameCode secret = - commandRequest - "newGame" - [] - [ ((400, "game-in-progress"), Decode.succeed GameInProgress) - , ((400, "not-enough-players"), Decode.map NotEnoughPlayers (Decode.field "required" Decode.int)) - ] - handDecoder - gameCode - secret + commandRequest + "newGame" + [] + [ ( ( 400, "game-in-progress" ), Decode.succeed GameInProgress ) + , ( ( 400, "not-enough-players" ), Decode.map NotEnoughPlayers (Decode.field "required" Decode.int) ) + ] + handDecoder + gameCode + secret {-| Errors specific to choosing a winner for the round. * `NotCzar` - The player is not the card czar. -} type ChooseError - = NotCzar + = NotCzar + {-| Make a request to choose the given (by index) winning response for round for the given lobby, using the given secret to authenticate. -} choose : String -> Player.Secret -> Int -> Request ChooseError () choose gameCode secret winner = - commandRequest - "choose" - [ ("winner", Encode.int winner) ] - [ ((400, "not-czar"), Decode.succeed NotCzar) ] - (Decode.succeed ()) - gameCode - secret + commandRequest + "choose" + [ ( "winner", Encode.int winner ) ] + [ ( ( 400, "not-czar" ), Decode.succeed NotCzar ) ] + (Decode.succeed ()) + gameCode + secret {-| Errors specific to playing responses into the round. @@ -173,27 +177,28 @@ choose gameCode secret winner = * `WrongNumberOfCards` - The wrong number of cards were played, with the number got, and the number expected. -} type PlayError - = NotInRound - | AlreadyPlayed - | AlreadyJudging - | WrongNumberOfCards Int Int + = NotInRound + | AlreadyPlayed + | AlreadyJudging + | WrongNumberOfCards Int Int + {-| Make a request to play the given (by index) cards from the player's hand into the round for the given lobby, using the given secret to authenticate. -} play : String -> Player.Secret -> List String -> Request PlayError Card.Hand play gameCode secret ids = - commandRequest - "play" - [ ("ids", Encode.list (List.map Encode.string ids)) ] - [ ((400, "not-in-round"), Decode.succeed NotInRound) - , ((400, "already-played"), Decode.succeed AlreadyPlayed) - , ((400, "already-judging"), Decode.succeed AlreadyJudging) - , ((400, "wrong-number-of-cards-played"), Decode.map2 WrongNumberOfCards (Decode.field "got" Decode.int) (Decode.field "expected" Decode.int)) - ] - handDecoder - gameCode - secret + commandRequest + "play" + [ ( "ids", Encode.list (List.map Encode.string ids) ) ] + [ ( ( 400, "not-in-round" ), Decode.succeed NotInRound ) + , ( ( 400, "already-played" ), Decode.succeed AlreadyPlayed ) + , ( ( 400, "already-judging" ), Decode.succeed AlreadyJudging ) + , ( ( 400, "wrong-number-of-cards-played" ), Decode.map2 WrongNumberOfCards (Decode.field "got" Decode.int) (Decode.field "expected" Decode.int) ) + ] + handDecoder + gameCode + secret {-| Errors specific to skipping a player in the lobby. @@ -203,72 +208,76 @@ play gameCode secret ids = * disconnected or timed out). -} type SkipError - = NotEnoughPlayersToSkip Int - | PlayersNotSkippable + = NotEnoughPlayersToSkip Int + | PlayersNotSkippable + {-| Make a request to skip the given players in the given lobby using the given secret to authenticate. -} skip : String -> Player.Secret -> List Player.Id -> Request SkipError () skip gameCode secret players = - commandRequest - "skip" - [ ("players", Encode.list (List.map Encode.int players)) ] - [ ((400, "not-enough-players"), Decode.map NotEnoughPlayersToSkip (Decode.field "required" Decode.int)) - , ((400, "players-must-be-skippable"), Decode.succeed PlayersNotSkippable) - ] - (Decode.succeed ()) - gameCode - secret + commandRequest + "skip" + [ ( "players", Encode.list (List.map Encode.int players) ) ] + [ ( ( 400, "not-enough-players" ), Decode.map NotEnoughPlayersToSkip (Decode.field "required" Decode.int) ) + , ( ( 400, "players-must-be-skippable" ), Decode.succeed PlayersNotSkippable ) + ] + (Decode.succeed ()) + gameCode + secret {-| Make a request to stop being skipped. -} back : String -> Player.Secret -> Request Never () -back = commandRequest "back" [] [] (Decode.succeed ()) +back = + commandRequest "back" [] [] (Decode.succeed ()) {-| Make a request to leave the game. -} leave : String -> Player.Secret -> Request Never () leave gameCode secret = - request - "POST" - ("/api/lobbies/" ++ gameCode ++ "/players/" ++ (toString secret.id) ++ "/leave") - (Just (encodePlayerSecret secret)) - [] - (Decode.succeed ()) + request + "POST" + ("/api/lobbies/" ++ gameCode ++ "/players/" ++ (toString secret.id) ++ "/leave") + (Just (encodePlayerSecret secret)) + [] + (Decode.succeed ()) {-| Errors specific to redrawing. * `NotEnoughPoints` - The player does not have enough points to redraw. -} type RedrawError - = NotEnoughPoints + = NotEnoughPoints + {-| Make a request to redraw the players hand, losing a point. -} redraw : String -> Player.Secret -> Request RedrawError Card.Hand redraw = - commandRequest - "redraw" - [] - [ ((400, "not-enough-points"), Decode.succeed NotEnoughPoints) - ] - handDecoder + commandRequest + "redraw" + [] + [ ( ( 400, "not-enough-points" ), Decode.succeed NotEnoughPoints ) + ] + handDecoder {-| Make a request to enable a house rule. -} enableRule : HouseRule.Id -> String -> Player.Secret -> Request Never () enableRule rule gameCode secret = - commandRequest "enableRule" [ ("rule", rule |> HouseRule.toString |> Encode.string) ] [] (Decode.succeed ()) gameCode secret + commandRequest "enableRule" [ ( "rule", rule |> HouseRule.toString |> Encode.string ) ] [] (Decode.succeed ()) gameCode secret {-| Make a request to disable a house rule. -} disableRule : HouseRule.Id -> String -> Player.Secret -> Request Never () disableRule rule gameCode secret = - commandRequest "disableRule" [ ("rule", rule |> HouseRule.toString |> Encode.string) ] [] (Decode.succeed ()) gameCode secret + commandRequest "disableRule" [ ( "rule", rule |> HouseRule.toString |> Encode.string ) ] [] (Decode.succeed ()) gameCode secret + {- Private -} @@ -278,4 +287,4 @@ disableRule rule gameCode secret = -} commandRequest : String -> List ( String, Encode.Value ) -> List (KnownError a) -> Decode.Decoder b -> String -> Player.Secret -> Request a b commandRequest name args errors decoder gameCode secret = - request "POST" ("/api/lobbies/" ++ gameCode) (Just (encodeCommand name secret args)) errors decoder + request "POST" ("/api/lobbies/" ++ gameCode) (Just (encodeCommand name secret args)) errors decoder diff --git a/client/src/MassiveDecks/API/Request.elm b/client/src/MassiveDecks/API/Request.elm index 15fcfb3..feef740 100644 --- a/client/src/MassiveDecks/API/Request.elm +++ b/client/src/MassiveDecks/API/Request.elm @@ -2,9 +2,7 @@ module MassiveDecks.API.Request exposing (send, send_, request, Request, KnownEr import Json.Decode as Json import Dict exposing (Dict) - import Http - import MassiveDecks.Components.Errors as Errors import MassiveDecks.Util as Util @@ -20,90 +18,125 @@ If the request has no specific errors, use `send_` instead. -} send : Request specificError result -> (specificError -> message) -> (Errors.Message -> message) -> (result -> message) -> Cmd message send request onSpecificError onGeneralError onSuccess = - let - req = Http.request - { method = request.method - , headers = [] - , url = request.url - , body = case request.body of - Just json -> Http.jsonBody json - Nothing -> Http.emptyBody - , expect = Http.expectStringResponse (handleResponse request.resultDecoder request.errors) - , timeout = Nothing - , withCredentials = False - } - in - Http.send (\result -> - case result of - Result.Ok errorOrResult -> case errorOrResult of - Error error -> handleErrors onSpecificError onGeneralError error - Result result -> onSuccess result - Result.Err error -> (case error of - Http.BadStatus response -> - (Json.decodeString (Json.maybe errorKeyDecoder |> Json.andThen (\n -> - case n of - Just errorName -> errorDecoder response errorName request.errors - Nothing -> Json.succeed (General error))) response.body) |> Result.withDefault (General error) - _ -> - General error) |> handleErrors onSpecificError onGeneralError - ) req + let + req = + Http.request + { method = request.method + , headers = [] + , url = request.url + , body = + case request.body of + Just json -> + Http.jsonBody json + + Nothing -> + Http.emptyBody + , expect = Http.expectStringResponse (handleResponse request.resultDecoder request.errors) + , timeout = Nothing + , withCredentials = False + } + in + Http.send + (\result -> + case result of + Result.Ok errorOrResult -> + case errorOrResult of + Error error -> + handleErrors onSpecificError onGeneralError error + + Result result -> + onSuccess result + + Result.Err error -> + (case error of + Http.BadStatus response -> + (Json.decodeString + (Json.maybe errorKeyDecoder + |> Json.andThen + (\n -> + case n of + Just errorName -> + errorDecoder response errorName request.errors + + Nothing -> + Json.succeed (General error) + ) + ) + response.body + ) + |> Result.withDefault (General error) + + _ -> + General error + ) + |> handleErrors onSpecificError onGeneralError + ) + req handleErrors : (specificError -> message) -> (Errors.Message -> message) -> Error specificError -> message handleErrors onSpecificError onGeneralError error = - case error of - Known specificError -> onSpecificError specificError - _ -> onGeneralError (genericErrorHandler error) + case error of + Known specificError -> + onSpecificError specificError + + _ -> + onGeneralError (genericErrorHandler error) handleResponse : Json.Decoder result -> KnownErrors specificError -> Http.Response String -> Result String (ErrorOrResult specificError result) handleResponse resultDecoder knownErrors response = - Json.decodeString (resultOrErrorDecoder response resultDecoder knownErrors) response.body + Json.decodeString (resultOrErrorDecoder response resultDecoder knownErrors) response.body {-| Same as 'send', but for requests with no known errors. -} send_ : Request Never result -> (Errors.Message -> message) -> (result -> message) -> Cmd message -send_ request onGeneralError onSuccess = send request Util.impossible onGeneralError onSuccess +send_ request onGeneralError onSuccess = + send request Util.impossible onGeneralError onSuccess {-| A request to the API. -} type alias Request specificError result = - { method : String - , url : String - , body : Maybe Json.Value - , errors : KnownErrors specificError - , resultDecoder : Json.Decoder result - } + { method : String + , url : String + , body : Maybe Json.Value + , errors : KnownErrors specificError + , resultDecoder : Json.Decoder result + } {-| A convinience method to make the errors dictionary from a list. -} request : String -> String -> Maybe Json.Value -> List (KnownError specificError) -> Json.Decoder result -> Request specificError result -request verb url body errors resultDecoder = Request verb url body (Dict.fromList errors) resultDecoder +request verb url body errors resultDecoder = + Request verb url body (Dict.fromList errors) resultDecoder {-| Specifies an error the client understands and can present to the user nicely. -} -type alias KnownError specificError = ((Int, String), Json.Decoder specificError) +type alias KnownError specificError = + ( ( Int, String ), Json.Decoder specificError ) + {-| The dictionary of KnownErrors. -} -type alias KnownErrors specificError = Dict (Int, String) (Json.Decoder specificError) +type alias KnownErrors specificError = + Dict ( Int, String ) (Json.Decoder specificError) {-| The top level of potential errors from an API request. -} type Error specificError - = General Http.Error - | Known specificError - | Unknown (Http.Response String) + = General Http.Error + | Known specificError + | Unknown (Http.Response String) type ErrorOrResult specificError result - = Error (Error specificError) - | Result result + = Error (Error specificError) + | Result result {-| Convert errors to generic error messages for display in the errors component. Generally you want to use this as a @@ -111,48 +144,59 @@ fallback after handling all known errors. -} genericErrorHandler : Error a -> Errors.Message genericErrorHandler error = - case error of - Known specificError -> - Errors.New ("An error was not correctly handled: " ++ (toString specificError)) True + case error of + Known specificError -> + Errors.New ("An error was not correctly handled: " ++ (toString specificError)) True - Unknown response -> - Errors.New("An error was not not recognised (status " ++ (toString response.status.code) ++ "): " ++ response.body) True + Unknown response -> + Errors.New ("An error was not not recognised (status " ++ (toString response.status.code) ++ "): " ++ response.body) True - General Http.Timeout -> - Errors.New "Timed out trying to connect to the server." False + General (Http.Timeout) -> + Errors.New "Timed out trying to connect to the server." False - General Http.NetworkError -> - Errors.New "There was a network error trying to connect to the server." False + General (Http.NetworkError) -> + Errors.New "There was a network error trying to connect to the server." False - General (Http.BadUrl url) -> - Errors.New ("The URL '" ++ url ++ "' was invalid.") True + General (Http.BadUrl url) -> + Errors.New ("The URL '" ++ url ++ "' was invalid.") True - General (Http.BadStatus response) -> - Errors.New ("Recieved an unexpected response (" ++ (toString response.status.code) ++ ") from the server: " ++ response.status.message) True + General (Http.BadStatus response) -> + Errors.New ("Recieved an unexpected response (" ++ (toString response.status.code) ++ ") from the server: " ++ response.status.message) True - General (Http.BadPayload explanation response) -> - Errors.New ("The response recieved from the server wasn't what we expected: " ++ explanation) True + General (Http.BadPayload explanation response) -> + Errors.New ("The response recieved from the server wasn't what we expected: " ++ explanation) True {-| Decode the error key from -} errorKeyDecoder : Json.Decoder String -errorKeyDecoder = Json.at [ "error" ] Json.string +errorKeyDecoder = + Json.at [ "error" ] Json.string errorDecoder : Http.Response String -> String -> KnownErrors specificError -> Json.Decoder (Error specificError) errorDecoder response errorName knownErrors = - let - decoder = Dict.get (response.status.code, errorName) knownErrors - in - case decoder of - Just decoder -> Json.map Known decoder - Nothing -> Json.succeed (Unknown response) + let + decoder = + Dict.get ( response.status.code, errorName ) knownErrors + in + case decoder of + Just decoder -> + Json.map Known decoder + + Nothing -> + Json.succeed (Unknown response) resultOrErrorDecoder : Http.Response String -> Json.Decoder result -> KnownErrors specificError -> Json.Decoder (ErrorOrResult specificError result) resultOrErrorDecoder response resultDecoder knownErrors = - Json.maybe errorKeyDecoder |> Json.andThen (\error -> - case error of - Just errorName -> Json.map (Error) (errorDecoder response errorName knownErrors) - Nothing -> Json.map Result resultDecoder) + Json.maybe errorKeyDecoder + |> Json.andThen + (\error -> + case error of + Just errorName -> + Json.map (Error) (errorDecoder response errorName knownErrors) + + Nothing -> + Json.map Result resultDecoder + ) diff --git a/client/src/MassiveDecks/Components/About.elm b/client/src/MassiveDecks/Components/About.elm index 50148c7..ce85fd3 100644 --- a/client/src/MassiveDecks/Components/About.elm +++ b/client/src/MassiveDecks/Components/About.elm @@ -1,65 +1,83 @@ module MassiveDecks.Components.About exposing (show) import String - import Html exposing (..) import Html.Attributes exposing (..) - import MassiveDecks.Components.Overlay as Overlay exposing (Overlay) show : String -> Overlay.Message a -show version = Overlay.Show (Overlay icon title (contents version)) +show version = + Overlay.Show (Overlay icon title (contents version)) icon : String -icon = "info-circle" +icon = + "info-circle" title : String -title = "About" +title = + "About" contents : String -> List (Html a) contents version = - ([ p [] [ text "Massive Decks is a web game based on the excellent " - , a [ href "https://cardsagainsthumanity.com/", target "_blank", rel "noopener" ] [ text "Cards against Humanity" ] - , text " - a party game where you play white cards to try and produce the most amusing outcome when " - , text "combined with the given black card." - ] - , p [] [ text "Massive Decks is also inspired by: " - , ul [] [ li [] [ a [ href "https://www.cardcastgame.com/", target "_blank", rel "noopener" ] [ text "Cardcast" ] - , text " - an app that allows you to play on a ChromeCast." - ] - , li [] [ a [ href "http://pretendyoure.xyz/zy/", target "_blank", rel "noopener" ] [ text "Pretend You're Xyzzy" ] - , text " - a web game where you can jump in with people you don't know." - ] - ] - ] - , p [] [ text "This is an open source game developed in " - , a [ href "http://elm-lang.org/", target "_blank", rel "noopener" ] [ text "Elm" ] - , text " for the client and " - , a [ href "http://www.scala-lang.org/", target "_blank", rel "noopener" ] [ text "Scala" ] - , text " for the server." - ] - , p [] [ text "We also use: " - , ul [] [ li [] [ a [ href "https://www.cardcastgame.com/", target "_blank", rel "noopener" ] [ text "Cardcast" ] - , text "'s APIs for getting decks of cards (you can go there to make your own!)." - ] - , li [] [ text "The " - , a [ href "https://www.playframework.com/", target "_blank", rel "noopener" ] [ text "Play framework" ] - ] - , li [] [ a [ href "http://lesscss.org/", target "_blank", rel "noopener" ] [ text "Less" ] ] - , li [] [ a [ href "https://fortawesome.github.io/Font-Awesome/", target "_blank", rel "noopener" ] [ text "Font Awesome" ] ] - , li [] [ a [ href "https://www.muicss.com", target "_blank", rel "noopener" ] [ text "MUI" ] ] - ] - ] - , p [] [ text "Bug reports and contributions are welcome on the " - , a [ href "https://github.com/Lattyware/massivedecks", target "_blank", rel "noopener" ] [ text "GitHub repository" ] - , text ", where you can find the complete source to the game, under the GPLv3 license. The game concept " - , text "'Cards against Humanity' is used under a " - , a [ href "https://creativecommons.org/licenses/by-nc-sa/2.0/", target "_blank", rel "noopener" ] [ text "Creative Commons BY-NC-SA 2.0 license" ] - , text " granted by " - , a [ href "https://cardsagainsthumanity.com/", target "_blank", rel "noopener" ] [ text "Cards against Humanity" ] - ] - ]) ++ (if String.isEmpty version then [] else [ p [] [ text ("This server is running version " ++ version ++ ".") ] ]) + ([ p [] + [ text "Massive Decks is a web game based on the excellent " + , a [ href "https://cardsagainsthumanity.com/", target "_blank", rel "noopener" ] [ text "Cards against Humanity" ] + , text " - a party game where you play white cards to try and produce the most amusing outcome when " + , text "combined with the given black card." + ] + , p [] + [ text "Massive Decks is also inspired by: " + , ul [] + [ li [] + [ a [ href "https://www.cardcastgame.com/", target "_blank", rel "noopener" ] [ text "Cardcast" ] + , text " - an app that allows you to play on a ChromeCast." + ] + , li [] + [ a [ href "http://pretendyoure.xyz/zy/", target "_blank", rel "noopener" ] [ text "Pretend You're Xyzzy" ] + , text " - a web game where you can jump in with people you don't know." + ] + ] + ] + , p [] + [ text "This is an open source game developed in " + , a [ href "http://elm-lang.org/", target "_blank", rel "noopener" ] [ text "Elm" ] + , text " for the client and " + , a [ href "http://www.scala-lang.org/", target "_blank", rel "noopener" ] [ text "Scala" ] + , text " for the server." + ] + , p [] + [ text "We also use: " + , ul [] + [ li [] + [ a [ href "https://www.cardcastgame.com/", target "_blank", rel "noopener" ] [ text "Cardcast" ] + , text "'s APIs for getting decks of cards (you can go there to make your own!)." + ] + , li [] + [ text "The " + , a [ href "https://www.playframework.com/", target "_blank", rel "noopener" ] [ text "Play framework" ] + ] + , li [] [ a [ href "http://lesscss.org/", target "_blank", rel "noopener" ] [ text "Less" ] ] + , li [] [ a [ href "https://fortawesome.github.io/Font-Awesome/", target "_blank", rel "noopener" ] [ text "Font Awesome" ] ] + , li [] [ a [ href "https://www.muicss.com", target "_blank", rel "noopener" ] [ text "MUI" ] ] + ] + ] + , p [] + [ text "Bug reports and contributions are welcome on the " + , a [ href "https://github.com/Lattyware/massivedecks", target "_blank", rel "noopener" ] [ text "GitHub repository" ] + , text ", where you can find the complete source to the game, under the GPLv3 license. The game concept " + , text "'Cards against Humanity' is used under a " + , a [ href "https://creativecommons.org/licenses/by-nc-sa/2.0/", target "_blank", rel "noopener" ] [ text "Creative Commons BY-NC-SA 2.0 license" ] + , text " granted by " + , a [ href "https://cardsagainsthumanity.com/", target "_blank", rel "noopener" ] [ text "Cards against Humanity" ] + ] + ] + ) + ++ (if String.isEmpty version then + [] + else + [ p [] [ text ("This server is running version " ++ version ++ ".") ] ] + ) diff --git a/client/src/MassiveDecks/Components/BrowserNotifications.elm b/client/src/MassiveDecks/Components/BrowserNotifications.elm index a393ecf..9473f3d 100644 --- a/client/src/MassiveDecks/Components/BrowserNotifications.elm +++ b/client/src/MassiveDecks/Components/BrowserNotifications.elm @@ -1,102 +1,117 @@ port module MassiveDecks.Components.BrowserNotifications exposing (Model, Message, ConsumerMessage(..), Permission(..), init, update, subscriptions, notify, enable, disable) import Maybe - import MassiveDecks.Util as Util init : Bool -> Bool -> Model init supported enabled = - { supported = supported - , enabled = enabled - , permission = Nothing - } + { supported = supported + , enabled = enabled + , permission = Nothing + } type alias Model = - { supported : Bool - , enabled : Bool - , permission : Maybe Permission - } + { supported : Bool + , enabled : Bool + , permission : Maybe Permission + } type alias Notification = - { title : String - , icon : Maybe String - } + { title : String + , icon : Maybe String + } type Permission - = Granted - | Denied - | Default + = Granted + | Denied + | Default -update : Message -> Model -> (Model, Cmd Message, Cmd ConsumerMessage) +update : Message -> Model -> ( Model, Cmd Message, Cmd ConsumerMessage ) update message model = - case message of - PermissionGiven permission -> - ({ model | permission = Just permission }, Cmd.none, Util.cmd (PermissionChanged permission)) + case message of + PermissionGiven permission -> + ( { model | permission = Just permission }, Cmd.none, Util.cmd (PermissionChanged permission) ) - SendNotification notification -> - if model.supported && model.enabled then - (model, notifications notification, Cmd.none) - else - (model, Cmd.none, Cmd.none) + SendNotification notification -> + if model.supported && model.enabled then + ( model, notifications notification, Cmd.none ) + else + ( model, Cmd.none, Cmd.none ) - EnableNotifications -> - ({ model | enabled = True }, requestPermission (), Cmd.none) + EnableNotifications -> + ( { model | enabled = True }, requestPermission (), Cmd.none ) - DisableNotifications -> - ({ model | enabled = False }, Cmd.none, Cmd.none) + DisableNotifications -> + ( { model | enabled = False }, Cmd.none, Cmd.none ) type ConsumerMessage - = PermissionChanged Permission + = PermissionChanged Permission type Message - = PermissionGiven Permission - | SendNotification Notification - | EnableNotifications - | DisableNotifications + = PermissionGiven Permission + | SendNotification Notification + | EnableNotifications + | DisableNotifications subscriptions : Model -> Sub Message subscriptions model = - if model.supported && model.enabled && model.permission == Nothing then - permissions permission - else - Sub.none + if model.supported && model.enabled && model.permission == Nothing then + permissions permission + else + Sub.none + port permissions : (String -> msg) -> Sub msg + permission : String -> Message permission name = - let - permission = case name of - "granted" -> Granted - "denied" -> Denied - "default" -> Default - _ -> - let - _ = Debug.log "Unexpected permission for browser notifications, assuming denied" name - in - Denied - in - PermissionGiven permission + let + permission = + case name of + "granted" -> + Granted + + "denied" -> + Denied + + "default" -> + Default + + _ -> + let + _ = + Debug.log "Unexpected permission for browser notifications, assuming denied" name + in + Denied + in + PermissionGiven permission notify : Notification -> Message -notify notification = SendNotification notification +notify notification = + SendNotification notification + port notifications : Notification -> Cmd msg enable : Message -enable = EnableNotifications +enable = + EnableNotifications + disable : Message -disable = DisableNotifications +disable = + DisableNotifications + port requestPermission : () -> Cmd msg diff --git a/client/src/MassiveDecks/Components/Errors.elm b/client/src/MassiveDecks/Components/Errors.elm index 7f606ff..5b58020 100644 --- a/client/src/MassiveDecks/Components/Errors.elm +++ b/client/src/MassiveDecks/Components/Errors.elm @@ -1,107 +1,121 @@ module MassiveDecks.Components.Errors exposing (Message(..), Model, ApplicationInfo, view, update, init, reportUrl) import String - import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) - import MassiveDecks.Components.Icon as Icon import MassiveDecks.Util as Util type Message - = New String Bool - | Remove Int + = New String Bool + | Remove Int type alias Model = - { currentId : Int - , errors : List Error - } + { currentId : Int + , errors : List Error + } type alias ApplicationInfo = - { url : String - , version : String - } + { url : String + , version : String + } {-| A generic error message to be displayed when something goes wrong. Should only be used where there isn't a good way to avoid the error altogether or display the error closer to it's source. -} type alias Error = - { id : Int - , message : String - , bugReport : Bool - } + { id : Int + , message : String + , bugReport : Bool + } init : Model init = - { currentId = 0 - , errors = [] - } + { currentId = 0 + , errors = [] + } view : ApplicationInfo -> Model -> Html Message -view applicationInfo model = ol [ id "error-panel"] (List.map (errorMessage applicationInfo) model.errors) +view applicationInfo model = + ol [ id "error-panel" ] (List.map (errorMessage applicationInfo) model.errors) -update : Message -> Model -> (Model, Cmd Message) +update : Message -> Model -> ( Model, Cmd Message ) update message model = - case message of - New message bugReport -> - let - new = { id = model.currentId, message = message, bugReport = bugReport } - in - ( { model | errors = model.errors ++ [ new ] - , currentId = model.currentId + 1 + case message of + New message bugReport -> + let + new = + { id = model.currentId, message = message, bugReport = bugReport } + in + ( { model + | errors = model.errors ++ [ new ] + , currentId = model.currentId + 1 } - , Cmd.none - ) + , Cmd.none + ) - Remove id -> - ({ model | errors = List.filter (\error -> error.id /= id) model.errors}, Cmd.none) + Remove id -> + ( { model | errors = List.filter (\error -> error.id /= id) model.errors }, Cmd.none ) reportText : String -> String reportText message = - ("I was [a short explanation of what you were doing] when I got the following error: \n\n" ++ message) + ("I was [a short explanation of what you were doing] when I got the following error: \n\n" ++ message) reportUrl : ApplicationInfo -> String -> String reportUrl applicationInfo message = - let - version = if String.isEmpty applicationInfo.version then "Not Specified" else applicationInfo.version - full = message ++ "\n\nApplication Info:\n\tVersion: " ++ version ++ "\n\tURL: " ++ applicationInfo.url - in - "https://github.com/Lattyware/massivedecks/issues/new?body=" ++ full + let + version = + if String.isEmpty applicationInfo.version then + "Not Specified" + else + applicationInfo.version + + full = + message ++ "\n\nApplication Info:\n\tVersion: " ++ version ++ "\n\tURL: " ++ applicationInfo.url + in + "https://github.com/Lattyware/massivedecks/issues/new?body=" ++ full errorMessage : ApplicationInfo -> Error -> Html Message errorMessage applicationInfo error = - let - url = reportUrl applicationInfo (reportText error.message) - bugReportLink = - if error.bugReport then - Just (p [] [ a [ href url, target "_blank", rel "noopener" ] [ Icon.icon "bug", text " Report this as a bug." ] ]) - else - Nothing - in - li - [ class "error" ] - [ div - [] - ([ a [ class "link" - , attribute "tabindex" "0" - , attribute "role" "button" - , onClick (Remove error.id) - ] [ Icon.icon "times" ] - , h5 [] [ Icon.icon "exclamation-triangle" - , text " Error" - ] - , div [ class "mui-divider" ] [] - , p [] [ text error.message ] - ] |> Util.andMaybe bugReportLink) - ] + let + url = + reportUrl applicationInfo (reportText error.message) + + bugReportLink = + if error.bugReport then + Just (p [] [ a [ href url, target "_blank", rel "noopener" ] [ Icon.icon "bug", text " Report this as a bug." ] ]) + else + Nothing + in + li + [ class "error" ] + [ div + [] + ([ a + [ class "link" + , attribute "tabindex" "0" + , attribute "role" "button" + , onClick (Remove error.id) + ] + [ Icon.icon "times" ] + , h5 [] + [ Icon.icon "exclamation-triangle" + , text " Error" + ] + , div [ class "mui-divider" ] [] + , p [] [ text error.message ] + ] + |> Util.andMaybe bugReportLink + ) + ] diff --git a/client/src/MassiveDecks/Components/Icon.elm b/client/src/MassiveDecks/Components/Icon.elm index da755f7..2a2a416 100644 --- a/client/src/MassiveDecks/Components/Icon.elm +++ b/client/src/MassiveDecks/Components/Icon.elm @@ -7,16 +7,19 @@ import Html.Attributes exposing (..) {-| A FointAwesome icon by name. -} icon : String -> Html a -icon name = i [ class ("fa fa-" ++ name) ] [] +icon name = + i [ class ("fa fa-" ++ name) ] [] {-| A full width FointAwesome icon by name. -} fwIcon : String -> Html a -fwIcon name = i [ class ("fa fa-fw fa-" ++ name) ] [] +fwIcon name = + i [ class ("fa fa-fw fa-" ++ name) ] [] {-| A loading spinner. -} spinner : Html a -spinner = i [ class "fa fa-circle-o-notch fa-spin" ] [] +spinner = + i [ class "fa fa-circle-o-notch fa-spin" ] [] diff --git a/client/src/MassiveDecks/Components/Input.elm b/client/src/MassiveDecks/Components/Input.elm index 099dce5..429f057 100644 --- a/client/src/MassiveDecks/Components/Input.elm +++ b/client/src/MassiveDecks/Components/Input.elm @@ -1,45 +1,44 @@ module MassiveDecks.Components.Input exposing (Message, Model, Change(..), init, initWithExtra, subscriptions, view, update) import Json.Decode as Json - import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) - import MassiveDecks.Util as Util import MassiveDecks.Components.Icon as Icon {-| Messages for changes to the input. -} -type alias Message id = (id, Change) +type alias Message id = + ( id, Change ) {-| Changes to the input. -} type Change - = Changed String - | Error (Maybe String) - | Submit - | SetEnabled Bool - | SetDefaultValue String - | NoOp + = Changed String + | Error (Maybe String) + | Submit + | SetEnabled Bool + | SetDefaultValue String + | NoOp {-| The state of the input. -} type alias Model id msg = - { identity : id - , class : String - , label : List (Html msg) - , placeholder : String - , value : String - , error : Maybe String - , extra : (String -> List (Html msg)) - , embedMethod : Message id -> msg - , submit : Cmd msg - , enabled : Bool - } + { identity : id + , class : String + , label : List (Html msg) + , placeholder : String + , value : String + , error : Maybe String + , extra : String -> List (Html msg) + , embedMethod : Message id -> msg + , submit : Cmd msg + , enabled : Bool + } {-| Create the initial model. @@ -57,7 +56,7 @@ The embedMethod is how to wrap the input message for the surrounding message typ -} init : id -> String -> List (Html msg) -> String -> String -> Cmd msg -> (Message id -> msg) -> Model id msg init identity class label value placeholder submit embedMethod = - initWithExtra identity class label value placeholder (\_ -> []) submit embedMethod + initWithExtra identity class label value placeholder (\_ -> []) submit embedMethod {-| Create the initial model with some extra content. See init for most of how this works. @@ -67,63 +66,83 @@ current value. -} initWithExtra : id -> String -> List (Html msg) -> String -> String -> (String -> List (Html msg)) -> Cmd msg -> (Message id -> msg) -> Model id msg initWithExtra identity class label value placeholder extra submit embedMethod = - { identity = identity - , class = class - , label = label - , value = value - , placeholder = placeholder - , error = Nothing - , extra = extra - , embedMethod = embedMethod - , submit = submit - , enabled = True - } + { identity = identity + , class = class + , label = label + , value = value + , placeholder = placeholder + , error = Nothing + , extra = extra + , embedMethod = embedMethod + , submit = submit + , enabled = True + } {-| Subscriptions for the input. -} subscriptions : Model id msg -> Sub (Message id) -subscriptions model = Sub.none +subscriptions model = + Sub.none {-| Render the input. -} view : Model id msg -> Html msg view model = - div [ class model.class ] - ([ div [ class "mui-textfield" ] - ([ input [ type_ "text" - , defaultValue model.value - , placeholder model.placeholder - , disabled (not model.enabled) - , on "input" (Json.map (\value -> (model.embedMethod (model.identity, Changed value))) targetValue) - , Util.onKeyDown "Enter" (model.embedMethod (model.identity, Submit)) (model.embedMethod (model.identity, NoOp)) - ] [] - , label [] (List.append [ Icon.icon "info-circle", text " " ] model.label) - ] |> Util.andMaybe (error model.error)) - ] ++ model.extra model.value) + div [ class model.class ] + ([ div [ class "mui-textfield" ] + ([ input + [ type_ "text" + , defaultValue model.value + , placeholder model.placeholder + , disabled (not model.enabled) + , on "input" (Json.map (\value -> (model.embedMethod ( model.identity, Changed value ))) targetValue) + , Util.onKeyDown "Enter" (model.embedMethod ( model.identity, Submit )) (model.embedMethod ( model.identity, NoOp )) + ] + [] + , label [] (List.append [ Icon.icon "info-circle", text " " ] model.label) + ] + |> Util.andMaybe (error model.error) + ) + ] + ++ model.extra model.value + ) {-| Render an error message for the input. -} error : Maybe String -> Maybe (Html msg) -error message = Maybe.map (\error -> span [ class "input-error" ] [ Icon.icon "exclamation", text " ", text error ]) message +error message = + Maybe.map (\error -> span [ class "input-error" ] [ Icon.icon "exclamation", text " ", text error ]) message {-| Handles messages and alters the model as appropriate. -} -update : Message id -> Model id msg -> (Model id msg, Cmd msg) +update : Message id -> Model id msg -> ( Model id msg, Cmd msg ) update message model = - let - (identity, change) = message - in - if (identity == model.identity) then - case change of - Changed value -> ({ model | value = value }, Cmd.none) - Error error -> ({ model | error = error }, Cmd.none) - Submit -> (model, model.submit) - SetEnabled enabled -> ({ model | enabled = enabled}, Cmd.none) - SetDefaultValue value -> ({ model | value = value}, Cmd.none) - NoOp -> (model, Cmd.none) - else - (model, Cmd.none) + let + ( identity, change ) = + message + in + if (identity == model.identity) then + case change of + Changed value -> + ( { model | value = value }, Cmd.none ) + + Error error -> + ( { model | error = error }, Cmd.none ) + + Submit -> + ( model, model.submit ) + + SetEnabled enabled -> + ( { model | enabled = enabled }, Cmd.none ) + + SetDefaultValue value -> + ( { model | value = value }, Cmd.none ) + + NoOp -> + ( model, Cmd.none ) + else + ( model, Cmd.none ) diff --git a/client/src/MassiveDecks/Components/Overlay.elm b/client/src/MassiveDecks/Components/Overlay.elm index c617741..b3d1382 100644 --- a/client/src/MassiveDecks/Components/Overlay.elm +++ b/client/src/MassiveDecks/Components/Overlay.elm @@ -1,88 +1,91 @@ port module MassiveDecks.Components.Overlay exposing (Overlay, Model, Message(..), init, view, update, map) import Json.Decode as Json - import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) - import MassiveDecks.Components.Icon as Icon import MassiveDecks.Util as Util type alias Model a = - { overlay : Maybe (Overlay a) - , wrap : (Message a) -> a - } + { overlay : Maybe (Overlay a) + , wrap : Message a -> a + } type alias Overlay a = - { icon : String - , title : String - , contents : List (Html a) - } + { icon : String + , title : String + , contents : List (Html a) + } type Message a - = Show (Overlay a) - | Hide - | NoOp + = Show (Overlay a) + | Hide + | NoOp -init : ((Message a) -> a) -> Model a +init : (Message a -> a) -> Model a init wrap = - { overlay = Nothing - , wrap = wrap - } + { overlay = Nothing + , wrap = wrap + } map : (a -> b) -> Message a -> Message b map mapper message = - case message of - Show overlay -> - Show (Overlay overlay.icon overlay.title (List.map (Html.map mapper) overlay.contents)) + case message of + Show overlay -> + Show (Overlay overlay.icon overlay.title (List.map (Html.map mapper) overlay.contents)) - Hide -> - Hide + Hide -> + Hide - NoOp -> - NoOp + NoOp -> + NoOp update : Message a -> Model a -> Model a update message model = - case message of - Show overlay -> - { model | overlay = Just overlay } + case message of + Show overlay -> + { model | overlay = Just overlay } - Hide -> - { model | overlay = Nothing } + Hide -> + { model | overlay = Nothing } - NoOp -> - model + NoOp -> + model view : Model a -> List (Html a) view model = - case model.overlay of - Just overlay -> - [ div [ id "mui-overlay" - , Util.onClickIfId "mui-overlay" (model.wrap Hide) (model.wrap NoOp) - , Util.onKeyDown "Escape" (model.wrap Hide) (model.wrap NoOp) - , tabindex 0 + case model.overlay of + Just overlay -> + [ div + [ id "mui-overlay" + , Util.onClickIfId "mui-overlay" (model.wrap Hide) (model.wrap NoOp) + , Util.onKeyDown "Escape" (model.wrap Hide) (model.wrap NoOp) + , tabindex 0 + ] + [ div [ class "overlay mui-panel" ] + ([ h1 [] [ Icon.icon overlay.icon, text " ", text overlay.title ] ] + ++ overlay.contents + ++ [ p [ class "close-link" ] + [ a + [ class "link" + , attribute "tabindex" "0" + , attribute "role" "button" + , onClick (model.wrap Hide) + ] + [ Icon.icon "times", text " Close" ] + ] + ] + ) + ] ] - [ div [ class "overlay mui-panel" ] - ([ h1 [] [ Icon.icon overlay.icon, text " ", text overlay.title ] ] ++ - overlay.contents ++ - [ p [ class "close-link"] - [ a [ class "link" - , attribute "tabindex" "0" - , attribute "role" "button" - , onClick (model.wrap Hide) - ] [ Icon.icon "times", text " Close" ] - ] - ]) - ] - ] - Nothing -> - [] + + Nothing -> + [] diff --git a/client/src/MassiveDecks/Components/QR.elm b/client/src/MassiveDecks/Components/QR.elm index 50efe91..06cc41c 100644 --- a/client/src/MassiveDecks/Components/QR.elm +++ b/client/src/MassiveDecks/Components/QR.elm @@ -4,12 +4,14 @@ import Html exposing (Html) import Html.Attributes as Html -port qr : { id: String, value: String } -> Cmd msg +port qr : { id : String, value : String } -> Cmd msg view : String -> Html msg -view containerId = Html.div [ Html.id containerId ] [] +view containerId = + Html.div [ Html.id containerId ] [] encodeAndRender : String -> String -> Cmd msg -encodeAndRender containerId value = qr { id = containerId, value = value } +encodeAndRender containerId value = + qr { id = containerId, value = value } diff --git a/client/src/MassiveDecks/Components/Storage.elm b/client/src/MassiveDecks/Components/Storage.elm index c16bcca..17fd320 100644 --- a/client/src/MassiveDecks/Components/Storage.elm +++ b/client/src/MassiveDecks/Components/Storage.elm @@ -3,36 +3,38 @@ port module MassiveDecks.Components.Storage exposing (Model, Message(..), update import MassiveDecks.Models.Game as Game -type alias Model = List Game.GameCodeAndSecret +type alias Model = + List Game.GameCodeAndSecret type Message - = Store - | Clear + = Store + | Clear port store : Model -> Cmd msg -update : Message -> Model -> (Model, Cmd Message) +update : Message -> Model -> ( Model, Cmd Message ) update message model = - case message of - Store -> - (model, store model) + case message of + Store -> + ( model, store model ) - Clear -> - ([], store []) + Clear -> + ( [], store [] ) join : Game.GameCodeAndSecret -> Model -> Model join gameCodeAndSecret model = - gameCodeAndSecret :: List.filter (different gameCodeAndSecret) model + gameCodeAndSecret :: List.filter (different gameCodeAndSecret) model leave : Game.GameCodeAndSecret -> Model -> Model leave gameCodeAndSecret = - List.filter (different gameCodeAndSecret) + List.filter (different gameCodeAndSecret) different : Game.GameCodeAndSecret -> Game.GameCodeAndSecret -> Bool -different check existing = check.gameCode /= existing.gameCode +different check existing = + check.gameCode /= existing.gameCode diff --git a/client/src/MassiveDecks/Components/TTS.elm b/client/src/MassiveDecks/Components/TTS.elm index dd86dfc..dc72326 100644 --- a/client/src/MassiveDecks/Components/TTS.elm +++ b/client/src/MassiveDecks/Components/TTS.elm @@ -4,27 +4,38 @@ import MassiveDecks.Util as Util type alias Model = - { enabled : Bool - } + { enabled : Bool + } type Message - = Say String - | Enabled Bool + = Say String + | Enabled Bool init : Model -init = { enabled = False } +init = + { enabled = False } -update : Message -> Model -> (Model, Cmd Message) +update : Message -> Model -> ( Model, Cmd Message ) update message model = - case message of - Say text -> - (model, if model.enabled then say text else Cmd.none) + case message of + Say text -> + ( model + , if model.enabled then + say text + else + Cmd.none + ) - Enabled enabled -> - ({ model | enabled = enabled }, if enabled then Cmd.none else Say "" |> Util.cmd) + Enabled enabled -> + ( { model | enabled = enabled } + , if enabled then + Cmd.none + else + Say "" |> Util.cmd + ) port say : String -> Cmd msg diff --git a/client/src/MassiveDecks/Components/Tabs.elm b/client/src/MassiveDecks/Components/Tabs.elm index ca09c19..4f28ca4 100644 --- a/client/src/MassiveDecks/Components/Tabs.elm +++ b/client/src/MassiveDecks/Components/Tabs.elm @@ -8,39 +8,40 @@ import Html.Events exposing (..) {-| Messages for the tab system. -} type Message tabId - = SetTab tabId + = SetTab tabId {-| The model for the tabs. -} type alias Model tabId msg = - { tabs : List (Tab tabId msg) - , current : tabId - , tagger : Message tabId -> msg - } + { tabs : List (Tab tabId msg) + , current : tabId + , tagger : Message tabId -> msg + } {-| An individual tab. -} type alias Tab tabId msg = - { id : tabId - , title : List (Html msg) - } + { id : tabId + , title : List (Html msg) + } {-| Initialise the model. -} init : List (Tab tabId msg) -> tabId -> (Message tabId -> msg) -> Model tabId msg -init = Model +init = + Model {-| Given a message, update the model to fit. -} update : Message tabId -> Model tabId msg -> Model tabId msg update message model = - case message of - SetTab tabId -> - { model | current = tabId } + case message of + SetTab tabId -> + { model | current = tabId } {-| Given a model, render it. @@ -50,18 +51,21 @@ content easily. -} view : (tabId -> List (Html msg)) -> Model tabId msg -> List (Html msg) view renderer model = - [ ul [ class "mui-tabs__bar mui-tabs__bar--justified" ] (List.map (viewTab model.tagger model.current) model.tabs) - ] ++ (List.map (viewPane model.current renderer) model.tabs) + [ ul [ class "mui-tabs__bar mui-tabs__bar--justified" ] (List.map (viewTab model.tagger model.current) model.tabs) + ] + ++ (List.map (viewPane model.current renderer) model.tabs) viewTab : (Message tabId -> msg) -> tabId -> Tab tabId msg -> Html msg viewTab tagger current model = - li [ classList [ ("mui--is-active", current == model.id) ] ] - [ a [ onClick (tagger <| SetTab model.id) - ] model.title - ] + li [ classList [ ( "mui--is-active", current == model.id ) ] ] + [ a + [ onClick (tagger <| SetTab model.id) + ] + model.title + ] viewPane : tabId -> (tabId -> List (Html msg)) -> Tab tabId msg -> Html msg viewPane current renderer model = - div [ classList [ ("mui-tabs__pane", True), ("mui--is-active", current == model.id) ] ] (renderer model.id) + div [ classList [ ( "mui-tabs__pane", True ), ( "mui--is-active", current == model.id ) ] ] (renderer model.id) diff --git a/client/src/MassiveDecks/Components/Title.elm b/client/src/MassiveDecks/Components/Title.elm index c80db22..6c3e27c 100644 --- a/client/src/MassiveDecks/Components/Title.elm +++ b/client/src/MassiveDecks/Components/Title.elm @@ -1,6 +1,9 @@ port module MassiveDecks.Components.Title exposing (set) + port title : String -> Cmd msg + set : String -> Cmd msg -set = title +set = + title diff --git a/client/src/MassiveDecks/Models.elm b/client/src/MassiveDecks/Models.elm index ab3149f..b306e32 100644 --- a/client/src/MassiveDecks/Models.elm +++ b/client/src/MassiveDecks/Models.elm @@ -1,29 +1,28 @@ module MassiveDecks.Models exposing (..) import Navigation - import MassiveDecks.Models.Game exposing (GameCodeAndSecret) {-| Data required to create the initial application state. -} type alias Init = - { version : String - , url : String - , existingGames : List GameCodeAndSecret - , seed : String - , browserNotificationsSupported : Bool - } + { version : String + , url : String + , existingGames : List GameCodeAndSecret + , seed : String + , browserNotificationsSupported : Bool + } {-| A path to a part of the application. -} type alias Path = - { gameCode : Maybe String - } + { gameCode : Maybe String + } pathFromLocation : Navigation.Location -> Path pathFromLocation location = - { gameCode = Maybe.map Tuple.second (String.uncons location.hash) - } + { gameCode = Maybe.map Tuple.second (String.uncons location.hash) + } diff --git a/client/src/MassiveDecks/Models/Card.elm b/client/src/MassiveDecks/Models/Card.elm index a88231c..6ac3623 100644 --- a/client/src/MassiveDecks/Models/Card.elm +++ b/client/src/MassiveDecks/Models/Card.elm @@ -2,7 +2,6 @@ module MassiveDecks.Models.Card exposing (..) import String import Dict exposing (Dict) - import MassiveDecks.Models.Player as Player import MassiveDecks.Util as Util @@ -11,55 +10,62 @@ import MassiveDecks.Util as Util a response implicitly existing inbetween each string. -} type alias Call = - { id: String - , parts: List String - } + { id : String + , parts : List String + } {-| A response (white card). -} type alias Response = - { id: String - , text: String - } + { id : String + , text : String + } {-| A hand of a player. -} type alias Hand = - { hand : List Response - } + { hand : List Response + } {-| Cards that have been played into a round for a call. -} -type alias PlayedCards = List Response +type alias PlayedCards = + List Response {-| The number of slots on a given call. -} slots : Call -> Int -slots call = (List.length call.parts) - 1 +slots call = + (List.length call.parts) - 1 {-| Produce a string of the given call with the given played cards injected into it. -} filled : Call -> PlayedCards -> String -filled call playedCards = String.concat (Util.interleave (List.map .text playedCards) call.parts) +filled call playedCards = + String.concat (Util.interleave (List.map .text playedCards) call.parts) {-| Join the player ids to the cards played into a round. -} playedCardsByPlayer : List Player.Id -> List PlayedCards -> Dict Player.Id PlayedCards -playedCardsByPlayer players cards = List.map2 (,) players cards |> Dict.fromList +playedCardsByPlayer players cards = + List.map2 (,) players cards |> Dict.fromList {-| The cards played by the winner of the game. -} winningCards : List PlayedCards -> Player.PlayedByAndWinner -> Maybe PlayedCards winningCards cards playedByAndWinner = - let - cardsByPlayer = playedCardsByPlayer playedByAndWinner.playedBy cards - winner = playedByAndWinner.winner - in - Dict.get winner cardsByPlayer + let + cardsByPlayer = + playedCardsByPlayer playedByAndWinner.playedBy cards + + winner = + playedByAndWinner.winner + in + Dict.get winner cardsByPlayer diff --git a/client/src/MassiveDecks/Models/Event.elm b/client/src/MassiveDecks/Models/Event.elm index 2ceedd3..f4a31a2 100644 --- a/client/src/MassiveDecks/Models/Event.elm +++ b/client/src/MassiveDecks/Models/Event.elm @@ -1,7 +1,6 @@ module MassiveDecks.Models.Event exposing (Event(..), fromJson) import Json.Decode as Json - import MassiveDecks.Models.JSON.Decode exposing (..) import MassiveDecks.Models.Game as Game import MassiveDecks.Models.Game.Round as Round @@ -12,63 +11,84 @@ import MassiveDecks.Models.Card as Card {-| An event represents a change in the game state from the server. These are recieved by websocket. -} type Event - = Sync Game.LobbyAndHand - - | PlayerJoin Player - | PlayerStatus Player.Id Player.Status - | PlayerLeft Player.Id - | PlayerDisconnect Player.Id - | PlayerReconnect Player.Id - | PlayerScoreChange Player.Id Int - - | HandChange Card.Hand - - | RoundStart Player.Id Card.Call - | RoundPlayed Int - | RoundJudging (List Card.PlayedCards) - | RoundEnd Round.FinishedRound - - | GameStart Player.Id Card.Call - | GameEnd - - | ConfigChange Game.Config - - | RoundTimeLimitHit + = Sync Game.LobbyAndHand + | PlayerJoin Player + | PlayerStatus Player.Id Player.Status + | PlayerLeft Player.Id + | PlayerDisconnect Player.Id + | PlayerReconnect Player.Id + | PlayerScoreChange Player.Id Int + | HandChange Card.Hand + | RoundStart Player.Id Card.Call + | RoundPlayed Int + | RoundJudging (List Card.PlayedCards) + | RoundEnd Round.FinishedRound + | GameStart Player.Id Card.Call + | GameEnd + | ConfigChange Game.Config + | RoundTimeLimitHit fromJson : String -> Result String Event -fromJson json = Json.decodeString eventDecoder json +fromJson json = + Json.decodeString eventDecoder json eventDecoder : Json.Decoder Event eventDecoder = - (Json.field "event" Json.string) |> Json.andThen specificEventDecoder + (Json.field "event" Json.string) |> Json.andThen specificEventDecoder -specificEventDecoder : String -> Json.Decoder Event +specificEventDecoder : String -> Json.Decoder Event specificEventDecoder name = - case name of - "Sync" -> Json.map Sync (Json.field "lobbyAndHand" lobbyAndHandDecoder) + case name of + "Sync" -> + Json.map Sync (Json.field "lobbyAndHand" lobbyAndHandDecoder) - "PlayerJoin" -> Json.map PlayerJoin (Json.field "player" playerDecoder) - "PlayerStatus" -> Json.map2 PlayerStatus (Json.field "player" playerIdDecoder) (Json.field "status" playerStatusDecoder) - "PlayerLeft" -> Json.map PlayerLeft (Json.field "player" playerIdDecoder) - "PlayerDisconnect" -> Json.map PlayerDisconnect (Json.field "player" playerIdDecoder) - "PlayerReconnect" -> Json.map PlayerReconnect (Json.field "player" playerIdDecoder) - "PlayerScoreChange" -> Json.map2 PlayerScoreChange (Json.field "player" playerIdDecoder) (Json.field "score" Json.int) + "PlayerJoin" -> + Json.map PlayerJoin (Json.field "player" playerDecoder) - "HandChange" -> Json.map HandChange (Json.field "hand" handDecoder) + "PlayerStatus" -> + Json.map2 PlayerStatus (Json.field "player" playerIdDecoder) (Json.field "status" playerStatusDecoder) - "RoundStart" -> Json.map2 RoundStart (Json.field "czar" playerIdDecoder) (Json.field "call" callDecoder) - "RoundPlayed" -> Json.map RoundPlayed (Json.field "playedCards" Json.int) - "RoundJudging" -> Json.map RoundJudging (Json.field "playedCards" (Json.list (Json.list responseDecoder))) - "RoundEnd" -> Json.map RoundEnd (Json.field "finishedRound" finishedRoundDecoder) + "PlayerLeft" -> + Json.map PlayerLeft (Json.field "player" playerIdDecoder) - "GameStart" -> Json.map2 GameStart (Json.field "czar" playerIdDecoder) (Json.field "call" callDecoder) - "GameEnd" -> Json.succeed GameEnd + "PlayerDisconnect" -> + Json.map PlayerDisconnect (Json.field "player" playerIdDecoder) - "ConfigChange" -> Json.map ConfigChange (Json.field "config" configDecoder) + "PlayerReconnect" -> + Json.map PlayerReconnect (Json.field "player" playerIdDecoder) - "RoundTimeLimitHit" -> Json.succeed RoundTimeLimitHit + "PlayerScoreChange" -> + Json.map2 PlayerScoreChange (Json.field "player" playerIdDecoder) (Json.field "score" Json.int) - unknown -> Json.fail (unknown ++ " is not a recognised event.") + "HandChange" -> + Json.map HandChange (Json.field "hand" handDecoder) + + "RoundStart" -> + Json.map2 RoundStart (Json.field "czar" playerIdDecoder) (Json.field "call" callDecoder) + + "RoundPlayed" -> + Json.map RoundPlayed (Json.field "playedCards" Json.int) + + "RoundJudging" -> + Json.map RoundJudging (Json.field "playedCards" (Json.list (Json.list responseDecoder))) + + "RoundEnd" -> + Json.map RoundEnd (Json.field "finishedRound" finishedRoundDecoder) + + "GameStart" -> + Json.map2 GameStart (Json.field "czar" playerIdDecoder) (Json.field "call" callDecoder) + + "GameEnd" -> + Json.succeed GameEnd + + "ConfigChange" -> + Json.map ConfigChange (Json.field "config" configDecoder) + + "RoundTimeLimitHit" -> + Json.succeed RoundTimeLimitHit + + unknown -> + Json.fail (unknown ++ " is not a recognised event.") diff --git a/client/src/MassiveDecks/Models/Game.elm b/client/src/MassiveDecks/Models/Game.elm index c86ac9e..c97f313 100644 --- a/client/src/MassiveDecks/Models/Game.elm +++ b/client/src/MassiveDecks/Models/Game.elm @@ -9,55 +9,56 @@ import MassiveDecks.Scenes.Playing.HouseRule.Id as HouseRule {-| The required information to rejoin a lobby - the ID and the secret. -} type alias GameCodeAndSecret = - { gameCode : GameCode - , secret : Player.Secret - } + { gameCode : GameCode + , secret : Player.Secret + } {-| A lobby ID is a string used to identify a given lobby. -} -type alias GameCode = String +type alias GameCode = + String {-| Configuration for a game. -} type alias Config = - { decks : List DeckInfo - , houseRules : List HouseRule.Id - , pasword : Maybe String - } + { decks : List DeckInfo + , houseRules : List HouseRule.Id + , pasword : Maybe String + } {-| Information about a deck of cards. -} type alias DeckInfo = - { id : String - , name : String - , calls : Int - , responses : Int - } + { id : String + , name : String + , calls : Int + , responses : Int + } type State - = Configuring - | Playing Round - | Finished + = Configuring + | Playing Round + | Finished {-| A lobby. -} type alias Lobby = - { gameCode : String - , owner : Player.Id - , config : Config - , players : List Player - , game : State - } + { gameCode : String + , owner : Player.Id + , config : Config + , players : List Player + , game : State + } {-| A lobby and a player's hand. -} type alias LobbyAndHand = - { lobby : Lobby - , hand: Card.Hand - } + { lobby : Lobby + , hand : Card.Hand + } diff --git a/client/src/MassiveDecks/Models/Game/Round.elm b/client/src/MassiveDecks/Models/Game/Round.elm index db9bb87..f25080c 100644 --- a/client/src/MassiveDecks/Models/Game/Round.elm +++ b/client/src/MassiveDecks/Models/Game/Round.elm @@ -5,71 +5,89 @@ import MassiveDecks.Models.Player as Player type alias Round = - { czar : Player.Id - , call : Card.Call - , state : State - } + { czar : Player.Id + , call : Card.Call + , state : State + } {-| The possible states of the round. -} type State - = P Playing - | J Judging - | F Finished + = P Playing + | J Judging + | F Finished playing : Int -> Bool -> State -playing numberPlayed afterTimeLimit = P (Playing numberPlayed afterTimeLimit) +playing numberPlayed afterTimeLimit = + P (Playing numberPlayed afterTimeLimit) + {-| A round that is being played into. -} type alias Playing = - { numberPlayed : Int - , afterTimeLimit : Bool - } + { numberPlayed : Int + , afterTimeLimit : Bool + } judging : List Card.PlayedCards -> Bool -> State -judging responses afterTimeLimit = J (Judging responses afterTimeLimit) +judging responses afterTimeLimit = + J (Judging responses afterTimeLimit) + {-| A round that is being judged. -} type alias Judging = - { responses : (List Card.PlayedCards) - , afterTimeLimit : Bool - } + { responses : List Card.PlayedCards + , afterTimeLimit : Bool + } finished : List Card.PlayedCards -> Player.PlayedByAndWinner -> State -finished responses playedByAndWinner = F (Finished responses playedByAndWinner) +finished responses playedByAndWinner = + F (Finished responses playedByAndWinner) + {-| A round that has been completed. -} type alias Finished = - { responses : (List Card.PlayedCards) - , playedByAndWinner : Player.PlayedByAndWinner - } + { responses : List Card.PlayedCards + , playedByAndWinner : Player.PlayedByAndWinner + } {-| A historical round that has been completed. -} type alias FinishedRound = - { czar : Player.Id - , call : Card.Call - , state : Finished - } + { czar : Player.Id + , call : Card.Call + , state : Finished + } afterTimeLimit : State -> Bool -afterTimeLimit state = case state of - P playing -> playing.afterTimeLimit - J judging -> judging.afterTimeLimit - F finished -> False +afterTimeLimit state = + case state of + P playing -> + playing.afterTimeLimit + + J judging -> + judging.afterTimeLimit + + F finished -> + False setAfterTimeLimit : Round -> Bool -> Round -setAfterTimeLimit round afterTimeLimit = case round.state of - P playing -> { round | state = P { playing | afterTimeLimit = afterTimeLimit } } - J judging -> { round | state = J { judging | afterTimeLimit = afterTimeLimit } } - F finished -> round +setAfterTimeLimit round afterTimeLimit = + case round.state of + P playing -> + { round | state = P { playing | afterTimeLimit = afterTimeLimit } } + + J judging -> + { round | state = J { judging | afterTimeLimit = afterTimeLimit } } + + F finished -> + round diff --git a/client/src/MassiveDecks/Models/JSON/Decode.elm b/client/src/MassiveDecks/Models/JSON/Decode.elm index 51450cf..adcece5 100644 --- a/client/src/MassiveDecks/Models/JSON/Decode.elm +++ b/client/src/MassiveDecks/Models/JSON/Decode.elm @@ -1,7 +1,6 @@ module MassiveDecks.Models.JSON.Decode exposing (..) import Json.Decode exposing (..) - import MassiveDecks.Models.Game as Game import MassiveDecks.Models.Game.Round as Round exposing (Round) import MassiveDecks.Models.Player as Player exposing (Player) @@ -10,160 +9,194 @@ import MassiveDecks.Scenes.Playing.HouseRule.Id as HouseRule lobbyAndHandDecoder : Decoder Game.LobbyAndHand -lobbyAndHandDecoder = map2 Game.LobbyAndHand - (field "lobby" lobbyDecoder) - (field "hand" handDecoder) +lobbyAndHandDecoder = + map2 Game.LobbyAndHand + (field "lobby" lobbyDecoder) + (field "hand" handDecoder) lobbyDecoder : Decoder Game.Lobby -lobbyDecoder = map5 Game.Lobby - (field "gameCode" string) - (field "owner" playerIdDecoder) - (field "config" configDecoder) - (field "players" (list playerDecoder)) - (field "state" gameStateDecoder) +lobbyDecoder = + map5 Game.Lobby + (field "gameCode" string) + (field "owner" playerIdDecoder) + (field "config" configDecoder) + (field "players" (list playerDecoder)) + (field "state" gameStateDecoder) gameCodeAndSecretDecoder : Decoder Game.GameCodeAndSecret -gameCodeAndSecretDecoder = map2 Game.GameCodeAndSecret - (field "gameCode" string) - (field "secret" playerSecretDecoder) +gameCodeAndSecretDecoder = + map2 Game.GameCodeAndSecret + (field "gameCode" string) + (field "secret" playerSecretDecoder) deckInfoDecoder : Decoder Game.DeckInfo -deckInfoDecoder = map4 Game.DeckInfo - (field "id" string) - (field "name" string) - (field "calls" int) - (field "responses" int) +deckInfoDecoder = + map4 Game.DeckInfo + (field "id" string) + (field "name" string) + (field "calls" int) + (field "responses" int) configDecoder : Decoder Game.Config -configDecoder = map3 Game.Config - (field "decks" (list deckInfoDecoder)) - (field "houseRules" (list houseRuleDecoder)) - (maybe (field "password" string)) +configDecoder = + map3 Game.Config + (field "decks" (list deckInfoDecoder)) + (field "houseRules" (list houseRuleDecoder)) + (maybe (field "password" string)) handDecoder : Decoder Card.Hand -handDecoder = map Card.Hand - (field "hand" (list responseDecoder)) +handDecoder = + map Card.Hand + (field "hand" (list responseDecoder)) playerDecoder : Decoder Player -playerDecoder = map6 Player - (field "id" playerIdDecoder) - (field "name" string) - (field "status" playerStatusDecoder) - (field "score" int) - (field "disconnected" bool) - (field "left" bool) +playerDecoder = + map6 Player + (field "id" playerIdDecoder) + (field "name" string) + (field "status" playerStatusDecoder) + (field "score" int) + (field "disconnected" bool) + (field "left" bool) playerStatusDecoder : Decoder Player.Status -playerStatusDecoder = customDecoder (string) (\name -> Player.nameToStatus name |> Result.fromMaybe ("Unknown player status '" ++ name ++ "'.")) +playerStatusDecoder = + customDecoder (string) (\name -> Player.nameToStatus name |> Result.fromMaybe ("Unknown player status '" ++ name ++ "'.")) gameStateDecoder : Decoder Game.State gameStateDecoder = - (field "gameState" string |> andThen (\gameState -> - case gameState of - "configuring" -> - succeed Game.Configuring + (field "gameState" string + |> andThen + (\gameState -> + case gameState of + "configuring" -> + succeed Game.Configuring - "playing" -> - map Game.Playing (field "round" roundDecoder) + "playing" -> + map Game.Playing (field "round" roundDecoder) - "finished" -> - succeed Game.Finished + "finished" -> + succeed Game.Finished - _ -> - fail ("Unknown game state '" ++ gameState ++ "'."))) + _ -> + fail ("Unknown game state '" ++ gameState ++ "'.") + ) + ) roundDecoder : Decoder Round -roundDecoder = map3 Round - (field "czar" playerIdDecoder) - (field "call" callDecoder) - (field "state" roundStateDecoder) +roundDecoder = + map3 Round + (field "czar" playerIdDecoder) + (field "call" callDecoder) + (field "state" roundStateDecoder) roundStateDecoder : Decoder Round.State roundStateDecoder = - (field "roundState" string |> andThen (\roundState -> - case roundState of - "playing" -> - map2 Round.playing - (field "numberPlayed" int) - (field "afterTimeLimit" bool) + (field "roundState" string + |> andThen + (\roundState -> + case roundState of + "playing" -> + map2 Round.playing + (field "numberPlayed" int) + (field "afterTimeLimit" bool) - "judging" -> - map2 Round.judging - (field "cards" (list (list responseDecoder))) - (field "afterTimeLimit" bool) + "judging" -> + map2 Round.judging + (field "cards" (list (list responseDecoder))) + (field "afterTimeLimit" bool) - "finished" -> - map Round.F finishedStateDecoder + "finished" -> + map Round.F finishedStateDecoder + + _ -> + fail ("Unknown round state '" ++ roundState ++ "'.") + ) + ) - _ -> - fail ("Unknown round state '" ++ roundState ++ "'."))) finishedStateDecoder : Decoder Round.Finished -finishedStateDecoder = map2 Round.Finished - (field "cards" (list (list responseDecoder))) - (field "playedByAndWinner" playedByAndWinnerDecoder) +finishedStateDecoder = + map2 Round.Finished + (field "cards" (list (list responseDecoder))) + (field "playedByAndWinner" playedByAndWinnerDecoder) finishedRoundDecoder : Decoder Round.FinishedRound -finishedRoundDecoder = map3 Round.FinishedRound - (field "czar" playerIdDecoder) - (field "call" callDecoder) - (field "state" finishedStateDecoder) +finishedRoundDecoder = + map3 Round.FinishedRound + (field "czar" playerIdDecoder) + (field "call" callDecoder) + (field "state" finishedStateDecoder) playedByAndWinnerDecoder : Decoder Player.PlayedByAndWinner -playedByAndWinnerDecoder = map2 Player.PlayedByAndWinner - (field "playedBy" (list (playerIdDecoder))) - (field "winner" playerIdDecoder) +playedByAndWinnerDecoder = + map2 Player.PlayedByAndWinner + (field "playedBy" (list (playerIdDecoder))) + (field "winner" playerIdDecoder) callDecoder : Decoder Card.Call -callDecoder = map2 Card.Call - (field "id" string) - (field "parts" (list string)) +callDecoder = + map2 Card.Call + (field "id" string) + (field "parts" (list string)) responseDecoder : Decoder Card.Response -responseDecoder = map2 Card.Response - (field "id" string) - (field "text" string) +responseDecoder = + map2 Card.Response + (field "id" string) + (field "text" string) playerIdDecoder : Decoder Player.Id -playerIdDecoder = int +playerIdDecoder = + int playerSecretDecoder : Decoder Player.Secret -playerSecretDecoder = map2 Player.Secret - (field "id" playerIdDecoder) - (field "secret" string) +playerSecretDecoder = + map2 Player.Secret + (field "id" playerIdDecoder) + (field "secret" string) houseRuleDecoder : Decoder HouseRule.Id -houseRuleDecoder = customDecoder (string) (\name -> ruleNameToId name |> Result.fromMaybe ("Unknown house rule '" ++ name ++ "'.")) +houseRuleDecoder = + customDecoder (string) (\name -> ruleNameToId name |> Result.fromMaybe ("Unknown house rule '" ++ name ++ "'.")) ruleNameToId : String -> Maybe HouseRule.Id ruleNameToId name = - case name of - "reboot" -> Just HouseRule.Reboot - _ -> Nothing + case name of + "reboot" -> + Just HouseRule.Reboot + + _ -> + Nothing customDecoder : Decoder b -> (b -> Result String a) -> Decoder a customDecoder decoder toResult = - andThen (\a -> - case toResult a of - Ok b -> succeed b - Err err -> fail err - ) decoder + andThen + (\a -> + case toResult a of + Ok b -> + succeed b + + Err err -> + fail err + ) + decoder diff --git a/client/src/MassiveDecks/Models/JSON/Encode.elm b/client/src/MassiveDecks/Models/JSON/Encode.elm index 74db74c..0a378e1 100644 --- a/client/src/MassiveDecks/Models/JSON/Encode.elm +++ b/client/src/MassiveDecks/Models/JSON/Encode.elm @@ -1,32 +1,38 @@ module MassiveDecks.Models.JSON.Encode exposing (..) import Json.Encode as Json - import MassiveDecks.Models.Player as Player -encodeCommand : String -> Player.Secret -> List (String, Json.Value) -> Json.Value +encodeCommand : String -> Player.Secret -> List ( String, Json.Value ) -> Json.Value encodeCommand action playerSecret rest = - Json.object - (List.append [ ("command", Json.string action) - , ("secret", encodePlayerSecret playerSecret) - ] rest) + Json.object + (List.append + [ ( "command", Json.string action ) + , ( "secret", encodePlayerSecret playerSecret ) + ] + rest + ) -encodeDeckId : String -> (String, Json.Value) -encodeDeckId id = ("deckId", Json.string id) +encodeDeckId : String -> ( String, Json.Value ) +encodeDeckId id = + ( "deckId", Json.string id ) encodePlayerSecret : Player.Secret -> Json.Value -encodePlayerSecret playerSecret = Json.object - [ ("id", encodePlayerId playerSecret.id) - , ("secret", Json.string playerSecret.secret) - ] +encodePlayerSecret playerSecret = + Json.object + [ ( "id", encodePlayerId playerSecret.id ) + , ( "secret", Json.string playerSecret.secret ) + ] encodePlayerId : Player.Id -> Json.Value -encodePlayerId playerId = Json.int playerId +encodePlayerId playerId = + Json.int playerId encodeName : String -> Json.Value -encodeName name = Json.object [ ("name", Json.string name) ] +encodeName name = + Json.object [ ( "name", Json.string name ) ] diff --git a/client/src/MassiveDecks/Models/Notification.elm b/client/src/MassiveDecks/Models/Notification.elm index 8baa0a8..243e826 100644 --- a/client/src/MassiveDecks/Models/Notification.elm +++ b/client/src/MassiveDecks/Models/Notification.elm @@ -6,45 +6,50 @@ import MassiveDecks.Models.Player as Player exposing (Player) {-| A notification about a player. -} type alias Notification = - { icon : String - , name : String - , description : String - , visible : Bool - } + { icon : String + , name : String + , description : String + , visible : Bool + } {-| Hide the given notificaiton. -} hide : Notification -> Notification -hide notification = { notification | visible = False } +hide notification = + { notification | visible = False } {-| Create a notification for a player joining the game. -} playerJoin : Player.Id -> List Player -> Maybe Notification -playerJoin id players = playerFromIdAndPlayers id players "sign-in" " has joined the game." +playerJoin id players = + playerFromIdAndPlayers id players "sign-in" " has joined the game." {-| Create a notification for a player reconnecting to the game. -} playerReconnect : Player.Id -> List Player -> Maybe Notification -playerReconnect id players = playerFromIdAndPlayers id players "sign-in" " has reconnected to the game." +playerReconnect id players = + playerFromIdAndPlayers id players "sign-in" " has reconnected to the game." {-| Create a notification for a player disconnecting from the game. -} playerDisconnect : Player.Id -> List Player -> Maybe Notification -playerDisconnect id players = playerFromIdAndPlayers id players "minus-circle" " has disconnected from the game." +playerDisconnect id players = + playerFromIdAndPlayers id players "minus-circle" " has disconnected from the game." {-| Create a notification for a player leaving the game. -} playerLeft : Player.Id -> List Player -> Maybe Notification -playerLeft id players = playerFromIdAndPlayers id players "sign-out" " has left the game." +playerLeft id players = + playerFromIdAndPlayers id players "sign-out" " has left the game." playerFromIdAndPlayers : Player.Id -> List Player -> String -> String -> Maybe Notification -playerFromIdAndPlayers id players icon suffix - = Player.byId id players - |> Maybe.map .name - |> Maybe.map (\name -> Notification icon name (name ++ suffix) True) +playerFromIdAndPlayers id players icon suffix = + Player.byId id players + |> Maybe.map .name + |> Maybe.map (\name -> Notification icon name (name ++ suffix) True) diff --git a/client/src/MassiveDecks/Models/Player.elm b/client/src/MassiveDecks/Models/Player.elm index f7f4de7..c3150b0 100644 --- a/client/src/MassiveDecks/Models/Player.elm +++ b/client/src/MassiveDecks/Models/Player.elm @@ -5,74 +5,102 @@ import MassiveDecks.Util as Util {-| A game-unique identifier for a player. -} -type alias Id = Int +type alias Id = + Int {-| A player. -} type alias Player = - { id : Id - , name : String - , status : Status - , score : Int - , disconnected : Bool - , left : Bool - } + { id : Id + , name : String + , status : Status + , score : Int + , disconnected : Bool + , left : Bool + } {-| A list of ids to identify who played what responses into a round and the id of the winner of the round. -} type alias PlayedByAndWinner = - { playedBy : List Id - , winner : Id - } + { playedBy : List Id + , winner : Id + } {-| A secret that a player uses to authenticate themselves to the server. -} type alias Secret = - { id : Id - , secret : String - } + { id : Id + , secret : String + } {-| The status of a player. -} type Status - = NotPlayed - | Played - | Czar - | Ai - | Neutral - | Skipping + = NotPlayed + | Played + | Czar + | Ai + | Neutral + | Skipping {-| The name of the status. -} statusName : Status -> String -statusName status = case status of - NotPlayed -> "not-played" - Played -> "played" - Czar -> "czar" - Ai -> "ai" - Neutral -> "neutral" - Skipping -> "skipping" +statusName status = + case status of + NotPlayed -> + "not-played" + + Played -> + "played" + + Czar -> + "czar" + + Ai -> + "ai" + + Neutral -> + "neutral" + + Skipping -> + "skipping" {-| Get a status from a name. -} nameToStatus : String -> Maybe Status -nameToStatus name = case name of - "not-played" -> Just NotPlayed - "played" -> Just Played - "czar" -> Just Czar - "ai" -> Just Ai - "neutral" -> Just Neutral - "skipping" -> Just Skipping - _ -> Nothing +nameToStatus name = + case name of + "not-played" -> + Just NotPlayed + + "played" -> + Just Played + + "czar" -> + Just Czar + + "ai" -> + Just Ai + + "neutral" -> + Just Neutral + + "skipping" -> + Just Skipping + + _ -> + Nothing {-| Get a player from a list of players by their id. -} byId : Id -> List Player -> Maybe Player -byId id players = Util.find (\player -> player.id == id) players +byId id players = + Util.find (\player -> player.id == id) players diff --git a/client/src/MassiveDecks/Scenes/Config.elm b/client/src/MassiveDecks/Scenes/Config.elm index 48d61b8..14208b9 100644 --- a/client/src/MassiveDecks/Scenes/Config.elm +++ b/client/src/MassiveDecks/Scenes/Config.elm @@ -1,9 +1,7 @@ module MassiveDecks.Scenes.Config exposing (update, view, init, subscriptions) import String - import Html exposing (Html) - import MassiveDecks.API as API import MassiveDecks.API.Request as Request import MassiveDecks.Components.Input as Input @@ -19,104 +17,122 @@ import MassiveDecks.Util as Util exposing ((:>)) -} init : Model init = - { decks = [] - , deckIdInput = Input.initWithExtra DeckId "deck-id-input" UI.deckIdInputLabel "" "Play Code" UI.addDeckButton (Util.cmd AddDeck) InputMessage - , passwordInput = Input.init Password "password-input" UI.passwordInputLabel "" "Password" (Cmd.none) InputMessage - , loadingDecks = [] - } + { decks = [] + , deckIdInput = Input.initWithExtra DeckId "deck-id-input" UI.deckIdInputLabel "" "Play Code" UI.addDeckButton (Util.cmd AddDeck) InputMessage + , passwordInput = Input.init Password "password-input" UI.passwordInputLabel "" "Password" (Cmd.none) InputMessage + , loadingDecks = [] + } {-| Subscriptions for the config screen. -} subscriptions : Model -> Sub ConsumerMessage -subscriptions model = Sub.none +subscriptions model = + Sub.none {-| Render the config screen. -} view : Lobby.Model -> Html ConsumerMessage -view lobbyModel = UI.view lobbyModel |> Html.map LocalMessage +view lobbyModel = + UI.view lobbyModel |> Html.map LocalMessage {-| Handles messages and alters the model as appropriate. -} -update : Message -> Lobby.Model -> (Model, Cmd ConsumerMessage) +update : Message -> Lobby.Model -> ( Model, Cmd ConsumerMessage ) update message lobbyModel = - let - lobby = lobbyModel.lobby - gameCode = lobbyModel.lobby.gameCode - secret = lobbyModel.secret - model = lobbyModel.config - in - case message of - ConfigureDecks (Request rawDeckId) -> - let - deckId = String.toUpper rawDeckId - in - { model | loadingDecks = model.loadingDecks ++ [ deckId ] } ! - [ Request.send (API.addDeck gameCode secret deckId) (addDeckErrorHandler deckId) ErrorMessage (\_ -> (Add deckId) |> ConfigureDecks |> LocalMessage) - , inputClearErrorCmd DeckId - ] + let + lobby = + lobbyModel.lobby - AddDeck -> - (model, Util.cmd (LocalMessage (ConfigureDecks (Request model.deckIdInput.value)))) + gameCode = + lobbyModel.lobby.gameCode - ConfigureDecks (Add deckId) -> - (removeDeckLoadingSpinner deckId model, Cmd.none) + secret = + lobbyModel.secret - ConfigureDecks (Fail deckId errorMessage) -> - (removeDeckLoadingSpinner deckId model, inputSetErrorCmd DeckId errorMessage) + model = + lobbyModel.config + in + case message of + ConfigureDecks (Request rawDeckId) -> + let + deckId = + String.toUpper rawDeckId + in + { model | loadingDecks = model.loadingDecks ++ [ deckId ] } + ! [ Request.send (API.addDeck gameCode secret deckId) (addDeckErrorHandler deckId) ErrorMessage (\_ -> (Add deckId) |> ConfigureDecks |> LocalMessage) + , inputClearErrorCmd DeckId + ] - InputMessage message -> - let - (deckIdInput, msg) = Input.update message lobbyModel.config.deckIdInput - in - ({ model | deckIdInput = deckIdInput }, Cmd.map LocalMessage msg) + AddDeck -> + ( model, Util.cmd (LocalMessage (ConfigureDecks (Request model.deckIdInput.value))) ) - AddAi -> - (model, Request.send_ (API.newAi gameCode secret) ErrorMessage (\_ -> LocalMessage NoOp)) + ConfigureDecks (Add deckId) -> + ( removeDeckLoadingSpinner deckId model, Cmd.none ) - StartGame -> - (model, Request.send (API.newGame gameCode secret) newGameErrorHandler ErrorMessage HandUpdate) + ConfigureDecks (Fail deckId errorMessage) -> + ( removeDeckLoadingSpinner deckId model, inputSetErrorCmd DeckId errorMessage ) - EnableRule rule -> - (model, Request.send_ (API.enableRule rule gameCode secret) ErrorMessage ignore) + InputMessage message -> + let + ( deckIdInput, msg ) = + Input.update message lobbyModel.config.deckIdInput + in + ( { model | deckIdInput = deckIdInput }, Cmd.map LocalMessage msg ) - DisableRule rule -> - (model, Request.send_ (API.disableRule rule gameCode secret) ErrorMessage ignore) + AddAi -> + ( model, Request.send_ (API.newAi gameCode secret) ErrorMessage (\_ -> LocalMessage NoOp) ) - NoOp -> - (model, Cmd.none) + StartGame -> + ( model, Request.send (API.newGame gameCode secret) newGameErrorHandler ErrorMessage HandUpdate ) + + EnableRule rule -> + ( model, Request.send_ (API.enableRule rule gameCode secret) ErrorMessage ignore ) + + DisableRule rule -> + ( model, Request.send_ (API.disableRule rule gameCode secret) ErrorMessage ignore ) + + NoOp -> + ( model, Cmd.none ) ignore : () -> ConsumerMessage -ignore = (\_ -> LocalMessage NoOp) +ignore = + (\_ -> LocalMessage NoOp) inputClearErrorCmd : InputId -> Cmd ConsumerMessage -inputClearErrorCmd inputId = (inputId, Nothing |> Input.Error) |> InputMessage |> LocalMessage |> Util.cmd +inputClearErrorCmd inputId = + ( inputId, Nothing |> Input.Error ) |> InputMessage |> LocalMessage |> Util.cmd inputSetErrorCmd : InputId -> String -> Cmd ConsumerMessage -inputSetErrorCmd inputId error = (inputId, Just error |> Input.Error) |> InputMessage |> LocalMessage |> Util.cmd +inputSetErrorCmd inputId error = + ( inputId, Just error |> Input.Error ) |> InputMessage |> LocalMessage |> Util.cmd removeDeckLoadingSpinner : String -> Model -> Model -removeDeckLoadingSpinner deckId model = { model | loadingDecks = List.filter ((/=) deckId) model.loadingDecks } +removeDeckLoadingSpinner deckId model = + { model | loadingDecks = List.filter ((/=) deckId) model.loadingDecks } addDeckErrorHandler : String -> API.AddDeckError -> ConsumerMessage addDeckErrorHandler deckId error = - case error of - API.CardcastTimeout -> - ConfigureDecks (Fail deckId "There was a problem accessing CardCast, please try again after a short wait.") |> LocalMessage + case error of + API.CardcastTimeout -> + ConfigureDecks (Fail deckId "There was a problem accessing CardCast, please try again after a short wait.") |> LocalMessage - API.DeckNotFound -> - ConfigureDecks (Fail deckId "The given play code doesn't exist, please check you have the correct code.") |> LocalMessage + API.DeckNotFound -> + ConfigureDecks (Fail deckId "The given play code doesn't exist, please check you have the correct code.") |> LocalMessage newGameErrorHandler : API.NewGameError -> ConsumerMessage newGameErrorHandler error = - case error of - API.GameInProgress -> ErrorMessage <| Errors.New "Can't start the game - it is already in progress." False - API.NotEnoughPlayers required -> ErrorMessage <| Errors.New ("Can't start the game - you need at least " ++ (toString required) ++ " players to start the game.") False + case error of + API.GameInProgress -> + ErrorMessage <| Errors.New "Can't start the game - it is already in progress." False + + API.NotEnoughPlayers required -> + ErrorMessage <| Errors.New ("Can't start the game - you need at least " ++ (toString required) ++ " players to start the game.") False diff --git a/client/src/MassiveDecks/Scenes/Config/Messages.elm b/client/src/MassiveDecks/Scenes/Config/Messages.elm index eba999c..2a37cb1 100644 --- a/client/src/MassiveDecks/Scenes/Config/Messages.elm +++ b/client/src/MassiveDecks/Scenes/Config/Messages.elm @@ -9,38 +9,40 @@ import MassiveDecks.Scenes.Playing.HouseRule.Id as HouseRule {-| This type is used for all sending of messages, allowing us to send messages handled outside this scene. -} type ConsumerMessage - = HandUpdate Card.Hand - | ErrorMessage Errors.Message - | LocalMessage Message + = HandUpdate Card.Hand + | ErrorMessage Errors.Message + | LocalMessage Message {-| The messages used in the start screen. -} type Message - = AddDeck - | ConfigureDecks Deck - | InputMessage (Input.Message InputId) - | AddAi - | StartGame - | EnableRule HouseRule.Id - | DisableRule HouseRule.Id - | NoOp + = AddDeck + | ConfigureDecks Deck + | InputMessage (Input.Message InputId) + | AddAi + | StartGame + | EnableRule HouseRule.Id + | DisableRule HouseRule.Id + | NoOp type Deck - = Request DeckId - | Add DeckId - | Fail DeckId FailureMessage + = Request DeckId + | Add DeckId + | Fail DeckId FailureMessage -type alias DeckId = String +type alias DeckId = + String -type alias FailureMessage = String +type alias FailureMessage = + String {-| IDs for the inputs to differentiate between them in messages. -} type InputId - = DeckId - | Password + = DeckId + | Password diff --git a/client/src/MassiveDecks/Scenes/Config/Models.elm b/client/src/MassiveDecks/Scenes/Config/Models.elm index f922358..26bb9dd 100644 --- a/client/src/MassiveDecks/Scenes/Config/Models.elm +++ b/client/src/MassiveDecks/Scenes/Config/Models.elm @@ -8,8 +8,8 @@ import MassiveDecks.Scenes.Config.Messages exposing (Message, InputId) {-| The state of the config screen. -} type alias Model = - { decks : List Game.DeckInfo - , deckIdInput : Input.Model InputId Message - , passwordInput : Input.Model InputId Message - , loadingDecks : List String - } + { decks : List Game.DeckInfo + , deckIdInput : Input.Model InputId Message + , passwordInput : Input.Model InputId Message + , loadingDecks : List String + } diff --git a/client/src/MassiveDecks/Scenes/Config/UI.elm b/client/src/MassiveDecks/Scenes/Config/UI.elm index 5bfe96e..c1288d3 100644 --- a/client/src/MassiveDecks/Scenes/Config/UI.elm +++ b/client/src/MassiveDecks/Scenes/Config/UI.elm @@ -1,11 +1,9 @@ module MassiveDecks.Scenes.Config.UI exposing (view, deckIdInputLabel, passwordInputLabel, addDeckButton) import String - import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) - import MassiveDecks.Components.Icon as Icon import MassiveDecks.Components.Input as Input import MassiveDecks.Models.Game as Game @@ -19,202 +17,266 @@ import MassiveDecks.Util as Util view : Lobby.Model -> Html Message view lobbyModel = - let - model = lobbyModel.config - lobby = lobbyModel.lobby - decks = lobby.config.decks - enoughPlayers = ((List.length lobby.players) > 1) - enoughCards = not (List.isEmpty decks) - canNotChangeConfig = lobbyModel.lobby.owner /= lobbyModel.secret.id - in - div [ id "config" ] - ( (if canNotChangeConfig then infoBar else []) - ++ [ div [ id "config-content", class "mui-panel" ] - [ invite lobbyModel.init.url lobby.gameCode - , div [ class "mui-divider" ] [] - , h1 [] [ text "Game Setup" ] - , ul [ class "mui-tabs__bar" ] - [ li [ class "mui--is-active" ] [ a [ attribute "data-mui-toggle" "tab" - , attribute "data-mui-controls" "decks" ] - [ text "Decks" ] - ] - , li [] [ a [ attribute "data-mui-toggle" "tab" - , attribute "data-mui-controls" "house-rules" - ] [ text "House Rules" ] - ] - , li [] [ a [ attribute "data-mui-toggle" "tab" - , attribute "data-mui-controls" "lobby-settings" - ] [ text "Lobby Settings" ] - ] + let + model = + lobbyModel.config + + lobby = + lobbyModel.lobby + + decks = + lobby.config.decks + + enoughPlayers = + ((List.length lobby.players) > 1) + + enoughCards = + not (List.isEmpty decks) + + canNotChangeConfig = + lobbyModel.lobby.owner /= lobbyModel.secret.id + in + div [ id "config" ] + ((if canNotChangeConfig then + infoBar + else + [] + ) + ++ [ div [ id "config-content", class "mui-panel" ] + [ invite lobbyModel.init.url lobby.gameCode + , div [ class "mui-divider" ] [] + , h1 [] [ text "Game Setup" ] + , ul [ class "mui-tabs__bar" ] + [ li [ class "mui--is-active" ] + [ a + [ attribute "data-mui-toggle" "tab" + , attribute "data-mui-controls" "decks" + ] + [ text "Decks" ] + ] + , li [] + [ a + [ attribute "data-mui-toggle" "tab" + , attribute "data-mui-controls" "house-rules" + ] + [ text "House Rules" ] + ] + , li [] + [ a + [ attribute "data-mui-toggle" "tab" + , attribute "data-mui-controls" "lobby-settings" + ] + [ text "Lobby Settings" ] + ] + ] + , div [ id "decks", class "mui-tabs__pane mui--is-active" ] + [ deckList canNotChangeConfig decks model.loadingDecks model.deckIdInput ] + , div [ id "house-rules", class "mui-tabs__pane" ] + ([ rando canNotChangeConfig ] ++ (List.map (\rule -> houseRule canNotChangeConfig (List.member rule.id lobbyModel.lobby.config.houseRules) rule) houseRules)) + , div [ id "lobby-settings", class "mui-tabs__pane" ] + [ password model.passwordInput ] + , div [ class "mui-divider" ] [] + , startGameButton canNotChangeConfig enoughPlayers enoughCards + ] ] - , div [ id "decks", class "mui-tabs__pane mui--is-active" ] - [ deckList canNotChangeConfig decks model.loadingDecks model.deckIdInput ] - , div [ id "house-rules", class "mui-tabs__pane" ] - ([ rando canNotChangeConfig ] ++ (List.map (\rule -> houseRule canNotChangeConfig (List.member rule.id lobbyModel.lobby.config.houseRules) rule) houseRules)) - , div [ id "lobby-settings", class "mui-tabs__pane" ] - [ password model.passwordInput ] - , div [ class "mui-divider" ] [] - , startGameButton canNotChangeConfig enoughPlayers enoughCards - ] - ]) + ) infoBar : List (Html msg) infoBar = - [ div [ id "info-bar", class "mui--z1" ] - [ Icon.icon "info-circle" - , text " " - , text "You can't change the configuration of the game, as you are not the owner." + [ div [ id "info-bar", class "mui--z1" ] + [ Icon.icon "info-circle" + , text " " + , text "You can't change the configuration of the game, as you are not the owner." + ] ] - ] + passwordInputLabel : List (Html msg) -passwordInputLabel = [ text "If blank, no password will be needed - anyone with the game code can play." ] +passwordInputLabel = + [ text "If blank, no password will be needed - anyone with the game code can play." ] + password : Input.Model InputId Message -> Html Message password passwordInputModel = - div [] [ h3 [] [ Icon.icon "key", text " Privacy" ] - , p [] [ text "A password that players will need to enter to get in the game." ] - , Input.view passwordInputModel - ] + div [] + [ h3 [] [ Icon.icon "key", text " Privacy" ] + , p [] [ text "A password that players will need to enter to get in the game." ] + , Input.view passwordInputModel + ] invite : String -> String -> Html msg invite appUrl lobbyId = - let - url = Util.lobbyUrl appUrl lobbyId - in - div [] - [ p [] [ text "Invite others to the game with the code '" - , strong [ class "game-code" ] [ text lobbyId ] - , text "' to enter on the main page, or give them this link: " ] - , p [] [ a [ href url ] [ text url ] ] - ] + let + url = + Util.lobbyUrl appUrl lobbyId + in + div [] + [ p [] + [ text "Invite others to the game with the code '" + , strong [ class "game-code" ] [ text lobbyId ] + , text "' to enter on the main page, or give them this link: " + ] + , p [] [ a [ href url ] [ text url ] ] + ] deckIdInputLabel : List (Html msg) deckIdInputLabel = - [ text " A " - , a [ href "https://www.cardcastgame.com/browse", target "_blank", rel "noopener" ] [ text "Cardcast" ] - , text " Play Code" - ] + [ text " A " + , a [ href "https://www.cardcastgame.com/browse", target "_blank", rel "noopener" ] [ text "Cardcast" ] + , text " Play Code" + ] addDeckButton : String -> List (Html Message) addDeckButton deckId = - [ button [ class "mui-btn mui-btn--small mui-btn--primary mui-btn--fab", disabled (String.isEmpty deckId) - , onClick (ConfigureDecks (Request deckId)) - , title "Add deck to game." - ] [ Icon.icon "plus" ] - ] + [ button + [ class "mui-btn mui-btn--small mui-btn--primary mui-btn--fab" + , disabled (String.isEmpty deckId) + , onClick (ConfigureDecks (Request deckId)) + , title "Add deck to game." + ] + [ Icon.icon "plus" ] + ] deckList : Bool -> List Game.DeckInfo -> List String -> Input.Model InputId Message -> Html Message deckList canNotChangeConfig decks loadingDecks deckId = - table [ class "decks mui-table" ] - [ thead [] - [ tr [] - [ th [] [ text "Id" ] - , th [] [ text "Name" ] - , th [ title "Calls" ] [ Icon.icon "square" ] - , th [ title "Responses" ] [ Icon.icon "square-o" ] + table [ class "decks mui-table" ] + [ thead [] + [ tr [] + [ th [] [ text "Id" ] + , th [] [ text "Name" ] + , th [ title "Calls" ] [ Icon.icon "square" ] + , th [ title "Responses" ] [ Icon.icon "square-o" ] + ] + ] + , Util.tbody [] + (List.concat + [ if (canNotChangeConfig && (List.isEmpty decks)) then + [ ( "!!emptyInfo", tr [] [ td [ colspan 4 ] [ text "No decks have been added yet." ] ] ) ] + else + [] + , emptyDeckListInfo ((not canNotChangeConfig) && (List.isEmpty decks) && List.isEmpty loadingDecks) + , List.map loadedDeckEntry decks + , List.map loadingDeckEntry loadingDecks + , if (canNotChangeConfig) then + [] + else + [ ( "!!input", tr [] [ td [ colspan 4 ] [ Input.view deckId ] ] ) ] + ] + ) ] - ] - , Util.tbody [] (List.concat - [ if (canNotChangeConfig && (List.isEmpty decks) ) then - [ ("!!emptyInfo", tr [] [ td [ colspan 4 ] [ text "No decks have been added yet." ] ]) ] - else - [] - , emptyDeckListInfo ((not canNotChangeConfig) && (List.isEmpty decks) && List.isEmpty loadingDecks) - , List.map loadedDeckEntry decks - , List.map loadingDeckEntry loadingDecks - , if (canNotChangeConfig) then [] else [ ("!!input", tr [] [ td [ colspan 4 ] [ Input.view deckId ] ]) ] - ]) - ] -loadedDeckEntry : Game.DeckInfo -> (String, Html msg) + +loadedDeckEntry : Game.DeckInfo -> ( String, Html msg ) loadedDeckEntry deck = - let - row = tr [] [ td [] [ deckLink deck.id ] + let + row = + tr [] + [ td [] [ deckLink deck.id ] , td [ title deck.name ] [ text deck.name ] , td [] [ text (toString deck.calls) ] , td [] [ text (toString deck.responses) ] ] - in - (deck.id, row) + in + ( deck.id, row ) -loadingDeckEntry : String -> (String, Html msg) + +loadingDeckEntry : String -> ( String, Html msg ) loadingDeckEntry deckId = - let - row = tr [] [ td [] [ deckLink deckId ], td [ colspan 3 ] [ Icon.spinner ] ] - in - (deckId, row) + let + row = + tr [] [ td [] [ deckLink deckId ], td [ colspan 3 ] [ Icon.spinner ] ] + in + ( deckId, row ) + deckLink : String -> Html msg -deckLink id = a [ href ("https://www.cardcastgame.com/browse/deck/" ++ id), target "_blank", rel "noopener" ] [ text id ] +deckLink id = + a [ href ("https://www.cardcastgame.com/browse/deck/" ++ id), target "_blank", rel "noopener" ] [ text id ] -emptyDeckListInfo : Bool -> List (String, Html Message) + +emptyDeckListInfo : Bool -> List ( String, Html Message ) emptyDeckListInfo display = - if display then - [ ("!!emptyInfo", tr [] [ td [ colspan 4 ] - [ Icon.icon "info-circle" - , text " You will need to add at least one " - , a [ href "https://www.cardcastgame.com/browse", target "_blank", rel "noopener" ] [ text "Cardcast deck" ] - , text " to the game." - , text " Not sure? Try " - , a [ class "link" - , attribute "tabindex" "0" - , attribute "role" "button" - , onClick (ConfigureDecks (Request "CAHBS")) - ] [ text "clicking here to add the Cards Against Humanity base set" ] - , text "." + if display then + [ ( "!!emptyInfo" + , tr [] + [ td [ colspan 4 ] + [ Icon.icon "info-circle" + , text " You will need to add at least one " + , a [ href "https://www.cardcastgame.com/browse", target "_blank", rel "noopener" ] [ text "Cardcast deck" ] + , text " to the game." + , text " Not sure? Try " + , a + [ class "link" + , attribute "tabindex" "0" + , attribute "role" "button" + , onClick (ConfigureDecks (Request "CAHBS")) + ] + [ text "clicking here to add the Cards Against Humanity base set" ] + , text "." + ] + ] + ) ] - ]) - ] - else - [] + else + [] houseRule : Bool -> Bool -> HouseRule -> Html Message houseRule canNotChangeConfig enabled rule = - let - (buttonText, command) = - if enabled then - ("Disable", DisableRule rule.id) - else - ("Enable", EnableRule rule.id) - in - houseRuleTemplate canNotChangeConfig (HouseRule.toString rule.id) rule.name rule.icon rule.description buttonText command + let + ( buttonText, command ) = + if enabled then + ( "Disable", DisableRule rule.id ) + else + ( "Enable", EnableRule rule.id ) + in + houseRuleTemplate canNotChangeConfig (HouseRule.toString rule.id) rule.name rule.icon rule.description buttonText command houseRuleTemplate : Bool -> String -> String -> String -> String -> String -> msg -> Html msg houseRuleTemplate canNotChangeConfig id_ title icon description buttonText message = - div [ id id_, class "house-rule" ] - [ div [] [ h3 [] [ Icon.icon icon, text " ", text title ] - , button [ class "mui-btn mui-btn--small mui-btn--primary", onClick message, disabled canNotChangeConfig ] - [ text buttonText ] - ] - , p [] [ text description ] - ] + div [ id id_, class "house-rule" ] + [ div [] + [ h3 [] [ Icon.icon icon, text " ", text title ] + , button [ class "mui-btn mui-btn--small mui-btn--primary", onClick message, disabled canNotChangeConfig ] + [ text buttonText ] + ] + , p [] [ text description ] + ] rando : Bool -> Html Message -rando canNotChangeConfig = houseRuleTemplate canNotChangeConfig "rando" "Rando Cardrissian" "cogs" - "Every round, one random card will be played for an imaginary player named Rando Cardrissian, if he wins, all players go home in a state of everlasting shame." - "Add an AI player" AddAi +rando canNotChangeConfig = + houseRuleTemplate canNotChangeConfig + "rando" + "Rando Cardrissian" + "cogs" + "Every round, one random card will be played for an imaginary player named Rando Cardrissian, if he wins, all players go home in a state of everlasting shame." + "Add an AI player" + AddAi startGameWarning : Bool -> Html msg -startGameWarning canStart = if canStart then text "" else - span [] [ Icon.icon "info-circle", text " You will need at least two players to start the game." ] +startGameWarning canStart = + if canStart then + text "" + else + span [] [ Icon.icon "info-circle", text " You will need at least two players to start the game." ] startGameButton : Bool -> Bool -> Bool -> Html Message -startGameButton notOwner enoughPlayers enoughCards = div [ id "start-game" ] - [ startGameWarning enoughPlayers - , button - [ class "mui-btn mui-btn--primary mui-btn--raised" - , onClick StartGame - , disabled ((not (enoughPlayers && enoughCards)) || notOwner) - ] [ text "Start Game" ] - ] +startGameButton notOwner enoughPlayers enoughCards = + div [ id "start-game" ] + [ startGameWarning enoughPlayers + , button + [ class "mui-btn mui-btn--primary mui-btn--raised" + , onClick StartGame + , disabled ((not (enoughPlayers && enoughCards)) || notOwner) + ] + [ text "Start Game" ] + ] diff --git a/client/src/MassiveDecks/Scenes/History.elm b/client/src/MassiveDecks/Scenes/History.elm index 26c1cec..671d018 100644 --- a/client/src/MassiveDecks/Scenes/History.elm +++ b/client/src/MassiveDecks/Scenes/History.elm @@ -1,7 +1,6 @@ module MassiveDecks.Scenes.History exposing (init, subscriptions, view, update) import Html exposing (Html) - import MassiveDecks.API as API import MassiveDecks.API.Request as Request import MassiveDecks.Scenes.History.Messages exposing (Message(..), ConsumerMessage(..)) @@ -10,30 +9,32 @@ import MassiveDecks.Scenes.History.UI as UI import MassiveDecks.Models.Player as Player exposing (Player) -init : String -> (Model, Cmd ConsumerMessage) +init : String -> ( Model, Cmd ConsumerMessage ) init gameCode = - ( { rounds = Nothing - } - , Request.send_ (API.getHistory gameCode) ErrorMessage (LocalMessage << Load) - ) + ( { rounds = Nothing + } + , Request.send_ (API.getHistory gameCode) ErrorMessage (LocalMessage << Load) + ) {-| Subscriptions for the playing scene. -} subscriptions : Model -> Sub ConsumerMessage -subscriptions model = Sub.none +subscriptions model = + Sub.none {-| Render the history. -} view : Model -> List Player -> Html ConsumerMessage -view = UI.view +view = + UI.view {-| Update the model. -} -update : Message -> Model -> (Model, Cmd ConsumerMessage) +update : Message -> Model -> ( Model, Cmd ConsumerMessage ) update message model = - case message of - Load rounds -> - ({ model | rounds = Just rounds }, Cmd.none) + case message of + Load rounds -> + ( { model | rounds = Just rounds }, Cmd.none ) diff --git a/client/src/MassiveDecks/Scenes/History/Messages.elm b/client/src/MassiveDecks/Scenes/History/Messages.elm index 45c038c..a2f0c2d 100644 --- a/client/src/MassiveDecks/Scenes/History/Messages.elm +++ b/client/src/MassiveDecks/Scenes/History/Messages.elm @@ -7,12 +7,12 @@ import MassiveDecks.Models.Game.Round as Round {-| This type is used for all sending of messages, allowing us to send messages handled outside this scene. -} type ConsumerMessage - = ErrorMessage Errors.Message - | Close - | LocalMessage Message + = ErrorMessage Errors.Message + | Close + | LocalMessage Message {-| The messages used in the history scene. -} type Message - = Load (List Round.FinishedRound) + = Load (List Round.FinishedRound) diff --git a/client/src/MassiveDecks/Scenes/History/Models.elm b/client/src/MassiveDecks/Scenes/History/Models.elm index f1fa4fc..98cf17e 100644 --- a/client/src/MassiveDecks/Scenes/History/Models.elm +++ b/client/src/MassiveDecks/Scenes/History/Models.elm @@ -6,5 +6,5 @@ import MassiveDecks.Models.Game.Round as Round {-| The state of the lobby. -} type alias Model = - { rounds : Maybe (List Round.FinishedRound) - } + { rounds : Maybe (List Round.FinishedRound) + } diff --git a/client/src/MassiveDecks/Scenes/History/UI.elm b/client/src/MassiveDecks/Scenes/History/UI.elm index caa4189..c2aec66 100644 --- a/client/src/MassiveDecks/Scenes/History/UI.elm +++ b/client/src/MassiveDecks/Scenes/History/UI.elm @@ -1,12 +1,10 @@ module MassiveDecks.Scenes.History.UI exposing (view) import Dict - import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) import Html.Keyed as Keyed - import MassiveDecks.Scenes.History.Models exposing (Model) import MassiveDecks.Scenes.History.Messages exposing (ConsumerMessage(..)) import MassiveDecks.Scenes.Playing.UI.Cards as CardsUI @@ -18,63 +16,81 @@ import MassiveDecks.Components.Icon as Icon view : Model -> List Player -> Html ConsumerMessage view model players = - let - content = case model.rounds of - Just rounds -> - Keyed.ul [] (List.map (\round -> (round.call.id, finishedRound players round)) rounds) + let + content = + case model.rounds of + Just rounds -> + Keyed.ul [] (List.map (\round -> ( round.call.id, finishedRound players round )) rounds) - Nothing -> - Icon.spinner - in - div - [ id "history" ] - [ h1 [ class "mui--divider-bottom" ] [ text "Previous Rounds" ] - , closeButton - , content - ] + Nothing -> + Icon.spinner + in + div + [ id "history" ] + [ h1 [ class "mui--divider-bottom" ] [ text "Previous Rounds" ] + , closeButton + , content + ] finishedRound : List Player -> Round.FinishedRound -> Html msg finishedRound players round = - let - state = round.state - playedBy = state.playedByAndWinner.playedBy - winner = state.playedByAndWinner.winner - czar = - Maybe.map - (\player -> [ Icon.icon "gavel", text " ", text player.name ]) - (Player.byId round.czar players) |> Maybe.withDefault [] - playedCardsByPlayer = Card.playedCardsByPlayer playedBy state.responses |> Dict.toList - in - li - [ class "round" ] - [ div [] [ div [ class "who" ] czar, CardsUI.call round.call [] ] - , Keyed.ul [ class "plays" ] (List.map (\(id, cards) -> (toString id, responses players winner id cards)) playedCardsByPlayer) - ] + let + state = + round.state + + playedBy = + state.playedByAndWinner.playedBy + + winner = + state.playedByAndWinner.winner + + czar = + Maybe.map + (\player -> [ Icon.icon "gavel", text " ", text player.name ]) + (Player.byId round.czar players) + |> Maybe.withDefault [] + + playedCardsByPlayer = + Card.playedCardsByPlayer playedBy state.responses |> Dict.toList + in + li + [ class "round" ] + [ div [] [ div [ class "who" ] czar, CardsUI.call round.call [] ] + , Keyed.ul [ class "plays" ] (List.map (\( id, cards ) -> ( toString id, responses players winner id cards )) playedCardsByPlayer) + ] responses : List Player -> Player.Id -> Player.Id -> List Card.Response -> Html msg responses players winnerId playerId responses = - let - winner = playerId == winnerId - winnerPrefix = if (winner) then [ Icon.icon "trophy", text " " ] else [] - player = - Maybe.map - (\player -> winnerPrefix ++ [ text player.name ]) - (Player.byId playerId players) |> Maybe.withDefault [] - in - li [] - [ div [ class "responses" ] - [ div [ classList [ ("who", True), ("won", winner) ] ] player - , Keyed.ul [] (List.map (\r -> (r.id, li [] [ CardsUI.response False [] r ])) responses) - ] - ] + let + winner = + playerId == winnerId + + winnerPrefix = + if (winner) then + [ Icon.icon "trophy", text " " ] + else + [] + + player = + Maybe.map + (\player -> winnerPrefix ++ [ text player.name ]) + (Player.byId playerId players) + |> Maybe.withDefault [] + in + li [] + [ div [ class "responses" ] + [ div [ classList [ ( "who", True ), ( "won", winner ) ] ] player + , Keyed.ul [] (List.map (\r -> ( r.id, li [] [ CardsUI.response False [] r ] )) responses) + ] + ] closeButton : Html ConsumerMessage closeButton = - button - [ class "mui-btn mui-btn--small mui-btn--fab" - , onClick Close - ] - [ Icon.icon "times" ] + button + [ class "mui-btn mui-btn--small mui-btn--fab" + , onClick Close + ] + [ Icon.icon "times" ] diff --git a/client/src/MassiveDecks/Scenes/Lobby.elm b/client/src/MassiveDecks/Scenes/Lobby.elm index d76eea2..34ed651 100644 --- a/client/src/MassiveDecks/Scenes/Lobby.elm +++ b/client/src/MassiveDecks/Scenes/Lobby.elm @@ -4,13 +4,9 @@ import String import Json.Encode exposing (encode) import Task import Time - import WebSocket - import AnimationFrame - import Html exposing (Html) - import MassiveDecks.Components.Errors as Errors import MassiveDecks.Components.QR as QR import MassiveDecks.Components.BrowserNotifications as BrowserNotifications @@ -36,340 +32,420 @@ import MassiveDecks.Util as Util exposing ((:>)) {-| Create the initial model for the lobby. -} -init : Init -> Game.LobbyAndHand -> Player.Secret -> (Model, Cmd ConsumerMessage) +init : Init -> Game.LobbyAndHand -> Player.Secret -> ( Model, Cmd ConsumerMessage ) init init lobbyAndHand secret = - { lobby = lobbyAndHand.lobby - , hand = lobbyAndHand.hand - , config = Config.init - , playing = Playing.init init - , browserNotifications = BrowserNotifications.init init.browserNotificationsSupported False - , secret = secret - , init = init - , notification = Nothing - , qrNeedsRendering = False - , sidebar = Sidebar.init 768 {- Should match the enhance-width in less. -} - , tts = TTS.init - } ! [] + { lobby = lobbyAndHand.lobby + , hand = lobbyAndHand.hand + , config = Config.init + , playing = Playing.init init + , browserNotifications = BrowserNotifications.init init.browserNotificationsSupported False + , secret = secret + , init = init + , notification = Nothing + , qrNeedsRendering = False + , sidebar = Sidebar.init 768 {- Should match the enhance-width in less. -} + , tts = TTS.init + } + ! [] {-| Subscriptions for the lobby. -} subscriptions : Model -> Sub ConsumerMessage subscriptions model = - let - delegated = case model.lobby.game of - Game.Configuring -> Config.subscriptions model.config |> Sub.map ConfigMessage - Game.Playing round -> Playing.subscriptions model.playing |> Sub.map PlayingMessage - Game.Finished -> Sub.none + let + delegated = + case model.lobby.game of + Game.Configuring -> + Config.subscriptions model.config |> Sub.map ConfigMessage - websocket = WebSocket.listen (webSocketUrl model.init.url model.lobby.gameCode) webSocketResponseDecoder + Game.Playing round -> + Playing.subscriptions model.playing |> Sub.map PlayingMessage - browserNotifications = BrowserNotifications.subscriptions model.browserNotifications |> Sub.map BrowserNotificationsMessage + Game.Finished -> + Sub.none - render = if model.qrNeedsRendering then [ AnimationFrame.diffs (\_ -> LocalMessage RenderQr) ] else [] - in - Sub.batch ([ delegated |> Sub.map LocalMessage - , websocket - , browserNotifications |> Sub.map LocalMessage - ] ++ render) + websocket = + WebSocket.listen (webSocketUrl model.init.url model.lobby.gameCode) webSocketResponseDecoder + + browserNotifications = + BrowserNotifications.subscriptions model.browserNotifications |> Sub.map BrowserNotificationsMessage + + render = + if model.qrNeedsRendering then + [ AnimationFrame.diffs (\_ -> LocalMessage RenderQr) ] + else + [] + in + Sub.batch + ([ delegated |> Sub.map LocalMessage + , websocket + , browserNotifications |> Sub.map LocalMessage + ] + ++ render + ) webSocketUrl : String -> String -> String webSocketUrl url gameCode = - let - (protocol, rest) = case String.split ":" url of - [] -> ("No protocol.", []) - protocol :: rest -> (protocol, rest) - host = String.join ":" rest + let + ( protocol, rest ) = + case String.split ":" url of + [] -> + ( "No protocol.", [] ) - baseUrl = case protocol of - "http" -> - "ws:" ++ host - "https" -> - "wss:" ++ host - unknown -> - let - _ = Debug.log "Assuming https due to unknown protocol for URL" unknown - in - "wss:" ++ host - in - baseUrl ++ "api/lobbies/" ++ gameCode ++ "/notifications" + protocol :: rest -> + ( protocol, rest ) + + host = + String.join ":" rest + + baseUrl = + case protocol of + "http" -> + "ws:" ++ host + + "https" -> + "wss:" ++ host + + unknown -> + let + _ = + Debug.log "Assuming https due to unknown protocol for URL" unknown + in + "wss:" ++ host + in + baseUrl ++ "api/lobbies/" ++ gameCode ++ "/notifications" webSocketResponseDecoder : String -> ConsumerMessage webSocketResponseDecoder response = - if (response == "identify") then - Identify |> LocalMessage - else - case Event.fromJson response of - Ok event -> - LocalMessage <| Batch <| handleEvent event + if (response == "identify") then + Identify |> LocalMessage + else + case Event.fromJson response of + Ok event -> + LocalMessage <| Batch <| handleEvent event - Err message -> - ErrorMessage <| Errors.New ("Error handling notification: " ++ message) True + Err message -> + ErrorMessage <| Errors.New ("Error handling notification: " ++ message) True {-| Render the lobby. -} view : Model -> Html ConsumerMessage -view model = UI.view model +view model = + UI.view model {-| Handles messages and alters the model as appropriate. -} -update : Message -> Model -> (Model, Cmd ConsumerMessage) +update : Message -> Model -> ( Model, Cmd ConsumerMessage ) update message model = - let - lobby = model.lobby - in - case message of - ConfigMessage configMessage -> - case configMessage of - Config.ErrorMessage errorMessage -> - (model, ErrorMessage errorMessage |> Util.cmd) + let + lobby = + model.lobby + in + case message of + ConfigMessage configMessage -> + case configMessage of + Config.ErrorMessage errorMessage -> + ( model, ErrorMessage errorMessage |> Util.cmd ) - Config.HandUpdate hand -> - model |> updateLobbyAndHand (Game.LobbyAndHand model.lobby hand) + Config.HandUpdate hand -> + model |> updateLobbyAndHand (Game.LobbyAndHand model.lobby hand) - Config.LocalMessage localMessage -> - let - (config, cmd) = Config.update localMessage model - in - ({ model | config = config }, Cmd.map (LocalMessage << ConfigMessage) cmd) + Config.LocalMessage localMessage -> + let + ( config, cmd ) = + Config.update localMessage model + in + ( { model | config = config }, Cmd.map (LocalMessage << ConfigMessage) cmd ) - PlayingMessage playingMessage -> - case playingMessage of - Playing.ErrorMessage errorMessage -> - (model, ErrorMessage errorMessage |> Util.cmd) + PlayingMessage playingMessage -> + case playingMessage of + Playing.ErrorMessage errorMessage -> + ( model, ErrorMessage errorMessage |> Util.cmd ) - Playing.HandUpdate hand -> - model |> updateLobbyAndHand (Game.LobbyAndHand model.lobby hand) + Playing.HandUpdate hand -> + model |> updateLobbyAndHand (Game.LobbyAndHand model.lobby hand) - Playing.TTSMessage ttsMessage -> - (model, TTSMessage ttsMessage |> LocalMessage |> Util.cmd) + Playing.TTSMessage ttsMessage -> + ( model, TTSMessage ttsMessage |> LocalMessage |> Util.cmd ) - Playing.LocalMessage localMessage -> - case model.lobby.game of - Game.Playing round -> + Playing.LocalMessage localMessage -> + case model.lobby.game of + Game.Playing round -> + let + ( playing, cmd ) = + Playing.update localMessage model round + in + ( { model | playing = playing }, Cmd.map (LocalMessage << PlayingMessage) cmd ) + + _ -> + ( model, Cmd.none ) + + SidebarMessage sidebarMessage -> let - (playing, cmd) = Playing.update localMessage model round + ( sidebarModel, cmd ) = + Sidebar.update sidebarMessage model.sidebar in - ({ model | playing = playing }, Cmd.map (LocalMessage << PlayingMessage) cmd) + ( { model | sidebar = sidebarModel }, Cmd.map (LocalMessage << SidebarMessage) cmd ) - _ -> - (model, Cmd.none) + TTSMessage ttsMessage -> + let + ( ttsModel, cmd ) = + TTS.update ttsMessage model.tts + in + ( { model | tts = ttsModel }, Cmd.map (LocalMessage << TTSMessage) cmd ) - SidebarMessage sidebarMessage -> - let - (sidebarModel, cmd) = Sidebar.update sidebarMessage model.sidebar - in - ({ model | sidebar = sidebarModel }, Cmd.map (LocalMessage << SidebarMessage) cmd) + BrowserNotificationsMessage notificationMessage -> + let + ( browserNotifications, localCmd, cmd ) = + BrowserNotifications.update notificationMessage model.browserNotifications + in + { model | browserNotifications = browserNotifications } + ! [ Cmd.map (LocalMessage << BrowserNotificationsMessage) localCmd + , Cmd.map overlayAlert cmd + ] - TTSMessage ttsMessage -> - let - (ttsModel, cmd) = TTS.update ttsMessage model.tts - in - ({ model | tts = ttsModel }, Cmd.map (LocalMessage << TTSMessage) cmd) + BrowserNotificationForUser getUserId title iconName -> + let + cmd = + case (getUserId lobby) of + Just id -> + if (id == model.secret.id) then + Util.cmd (BrowserNotifications.notify { title = title, icon = icon model iconName } |> BrowserNotificationsMessage |> LocalMessage) + else + Cmd.none - BrowserNotificationsMessage notificationMessage -> - let - (browserNotifications, localCmd, cmd) = BrowserNotifications.update notificationMessage model.browserNotifications - in - { model | browserNotifications = browserNotifications } ! - [ Cmd.map (LocalMessage << BrowserNotificationsMessage) localCmd - , Cmd.map overlayAlert cmd - ] + Nothing -> + Cmd.none + in + ( model, cmd ) - BrowserNotificationForUser getUserId title iconName -> - let - cmd = case (getUserId lobby) of - Just(id) -> - if (id == model.secret.id) then - Util.cmd (BrowserNotifications.notify { title = title, icon = icon model iconName } |> BrowserNotificationsMessage |> LocalMessage) - else - Cmd.none - Nothing -> - Cmd.none - in - (model, cmd) + UpdateLobbyAndHand lobbyAndHand -> + model |> updateLobbyAndHand lobbyAndHand - UpdateLobbyAndHand lobbyAndHand -> - model |> updateLobbyAndHand lobbyAndHand + UpdateLobby update -> + model |> updateLobbyAndHand (Game.LobbyAndHand (update lobby) model.hand) - UpdateLobby update -> - model |> updateLobbyAndHand (Game.LobbyAndHand (update lobby) model.hand) + UpdateHand hand -> + model |> updateLobbyAndHand (Game.LobbyAndHand model.lobby hand) - UpdateHand hand -> - model |> updateLobbyAndHand (Game.LobbyAndHand model.lobby hand) + SetNotification notification -> + notificationChange model (notification lobby.players) - SetNotification notification -> - notificationChange model (notification lobby.players) + Identify -> + ( model, Cmd.map LocalMessage (WebSocket.send (webSocketUrl model.init.url model.lobby.gameCode) (encodePlayerSecret model.secret |> encode 0)) ) - Identify -> - (model, Cmd.map LocalMessage (WebSocket.send (webSocketUrl model.init.url model.lobby.gameCode) (encodePlayerSecret model.secret |> encode 0))) + DisplayInviteOverlay -> + { model | qrNeedsRendering = True } ! [ Util.cmd (UI.inviteOverlay model.init.url model.lobby.gameCode |> OverlayMessage) ] - DisplayInviteOverlay -> - { model | qrNeedsRendering = True } ! [ Util.cmd (UI.inviteOverlay model.init.url model.lobby.gameCode |> OverlayMessage) ] + RenderQr -> + { model | qrNeedsRendering = False } ! [ QR.encodeAndRender "invite-qr-code" (Util.lobbyUrl model.init.url model.lobby.gameCode) ] - RenderQr -> - { model | qrNeedsRendering = False } ! [ QR.encodeAndRender "invite-qr-code" (Util.lobbyUrl model.init.url model.lobby.gameCode) ] + DismissNotification notification -> + let + newModel = + if model.notification == Just notification then + { model | notification = Maybe.map Notification.hide model.notification } + else + model + in + ( newModel, Cmd.none ) - DismissNotification notification -> - let - newModel = - if model.notification == Just notification then - { model | notification = Maybe.map Notification.hide model.notification } - else - model - in - (newModel, Cmd.none) + Batch messages -> + model ! (List.map (Util.cmd << LocalMessage) messages) - Batch messages -> - model ! (List.map (Util.cmd << LocalMessage) messages) - - NoOp -> - (model, Cmd.none) + NoOp -> + ( model, Cmd.none ) handleEvent : Event -> List Message handleEvent event = - case event of - Event.Sync lobbyAndHand -> - [ UpdateLobbyAndHand lobbyAndHand ] + case event of + Event.Sync lobbyAndHand -> + [ UpdateLobbyAndHand lobbyAndHand ] - Event.PlayerJoin player -> - [ SetNotification (Notification.playerJoin player.id) - , UpdateLobby (\lobby -> { lobby | players = lobby.players ++ [ player ] }) - ] - Event.PlayerStatus player status -> - let - browserNotification = case status of - Player.NotPlayed -> - [ BrowserNotificationForUser (\_ -> Just player) "You need to play a card for the round." "hourglass" ] - Player.Skipping -> - [ BrowserNotificationForUser (\_ -> Just player) "You are being skipped due to inactivity." "fast-forward" ] - _ -> - [] - in - [ updatePlayer player (\player -> { player | status = status }) - ] ++ browserNotification - Event.PlayerLeft player -> - [ SetNotification (Notification.playerLeft player) - , updatePlayer player (\player -> { player | left = True }) - ] - Event.PlayerDisconnect player -> - [ SetNotification (Notification.playerDisconnect player) - , updatePlayer player (\player -> { player | disconnected = True }) - ] - Event.PlayerReconnect player -> - [ SetNotification (Notification.playerReconnect player) - , updatePlayer player (\player -> { player | disconnected = False }) - ] - Event.PlayerScoreChange player score -> - [ updatePlayer player (\player -> { player | score = score }) ] + Event.PlayerJoin player -> + [ SetNotification (Notification.playerJoin player.id) + , UpdateLobby (\lobby -> { lobby | players = lobby.players ++ [ player ] }) + ] - Event.HandChange hand -> - [ UpdateHand hand ] + Event.PlayerStatus player status -> + let + browserNotification = + case status of + Player.NotPlayed -> + [ BrowserNotificationForUser (\_ -> Just player) "You need to play a card for the round." "hourglass" ] - Event.RoundStart czar call -> - [ UpdateLobby (\lobby -> { lobby | game = Game.Playing (Round czar call (Round.playing 0 False)) }) ] - Event.RoundPlayed playedCards -> - [ updateRoundState (\state -> Round.playing playedCards (Round.afterTimeLimit state)) ] - Event.RoundJudging playedCards -> - [ updateRoundState (\state -> Round.judging playedCards False) - , BrowserNotificationForUser (\lobby -> lobbyRound lobby |> Maybe.map .czar) "You need to pick a winner for the round." "gavel" - ] - Event.RoundEnd finishedRound -> - [ updateRoundState (\state -> Round.F finishedRound.state) - , PlayingMessage <| Playing.LocalMessage <| Playing.FinishRound finishedRound - ] + Player.Skipping -> + [ BrowserNotificationForUser (\_ -> Just player) "You are being skipped due to inactivity." "fast-forward" ] - Event.GameStart czar call -> - [ UpdateLobby (\lobby -> { lobby | game = Game.Playing (Round czar call (Round.playing 0 False)) }) ] - Event.GameEnd -> - [ UpdateLobby (\lobby -> { lobby | game = Game.Finished }) - , UpdateHand { hand = [] } - ] + _ -> + [] + in + [ updatePlayer player (\player -> { player | status = status }) + ] + ++ browserNotification - Event.ConfigChange config -> - [ UpdateLobby (\lobby -> { lobby | config = config }) ] + Event.PlayerLeft player -> + [ SetNotification (Notification.playerLeft player) + , updatePlayer player (\player -> { player | left = True }) + ] - Event.RoundTimeLimitHit -> - [ updateRound (\round -> Round.setAfterTimeLimit round True) ] + Event.PlayerDisconnect player -> + [ SetNotification (Notification.playerDisconnect player) + , updatePlayer player (\player -> { player | disconnected = True }) + ] + + Event.PlayerReconnect player -> + [ SetNotification (Notification.playerReconnect player) + , updatePlayer player (\player -> { player | disconnected = False }) + ] + + Event.PlayerScoreChange player score -> + [ updatePlayer player (\player -> { player | score = score }) ] + + Event.HandChange hand -> + [ UpdateHand hand ] + + Event.RoundStart czar call -> + [ UpdateLobby (\lobby -> { lobby | game = Game.Playing (Round czar call (Round.playing 0 False)) }) ] + + Event.RoundPlayed playedCards -> + [ updateRoundState (\state -> Round.playing playedCards (Round.afterTimeLimit state)) ] + + Event.RoundJudging playedCards -> + [ updateRoundState (\state -> Round.judging playedCards False) + , BrowserNotificationForUser (\lobby -> lobbyRound lobby |> Maybe.map .czar) "You need to pick a winner for the round." "gavel" + ] + + Event.RoundEnd finishedRound -> + [ updateRoundState (\state -> Round.F finishedRound.state) + , PlayingMessage <| Playing.LocalMessage <| Playing.FinishRound finishedRound + ] + + Event.GameStart czar call -> + [ UpdateLobby (\lobby -> { lobby | game = Game.Playing (Round czar call (Round.playing 0 False)) }) ] + + Event.GameEnd -> + [ UpdateLobby (\lobby -> { lobby | game = Game.Finished }) + , UpdateHand { hand = [] } + ] + + Event.ConfigChange config -> + [ UpdateLobby (\lobby -> { lobby | config = config }) ] + + Event.RoundTimeLimitHit -> + [ updateRound (\round -> Round.setAfterTimeLimit round True) ] lobbyRound : Game.Lobby -> Maybe Round -lobbyRound lobby = case lobby.game of - Game.Playing round -> Just round - _ -> Nothing +lobbyRound lobby = + case lobby.game of + Game.Playing round -> + Just round + + _ -> + Nothing updatePlayer : Player.Id -> (Player -> Player) -> Message updatePlayer playerId playerUpdate = - UpdateLobby (\lobby -> { lobby | players = List.map (\player -> if player.id == playerId then playerUpdate player else player) lobby.players }) + UpdateLobby + (\lobby -> + { lobby + | players = + List.map + (\player -> + if player.id == playerId then + playerUpdate player + else + player + ) + lobby.players + } + ) updateRound : (Round -> Round) -> Message updateRound roundUpdate = - UpdateLobby (\lobby -> - let - game = case lobby.game of - Game.Playing round -> - Game.Playing (roundUpdate round) + UpdateLobby + (\lobby -> + let + game = + case lobby.game of + Game.Playing round -> + Game.Playing (roundUpdate round) - other -> - other - in - { lobby | game = game }) + other -> + other + in + { lobby | game = game } + ) updateRoundState : (Round.State -> Round.State) -> Message updateRoundState roundStateUpdate = - updateRound (\round -> { round | state = roundStateUpdate round.state }) + updateRound (\round -> { round | state = roundStateUpdate round.state }) overlayAlert : BrowserNotifications.ConsumerMessage -> ConsumerMessage overlayAlert message = - case message of - BrowserNotifications.PermissionChanged permission -> - case permission of - BrowserNotifications.Denied -> - (Overlay.Show (Overlay "times-circle" "Can't enable desktop notifications." - [ Html.text "You did not give Massive Decks permission to give you desktop notifications." ]) - ) |> OverlayMessage + case message of + BrowserNotifications.PermissionChanged permission -> + case permission of + BrowserNotifications.Denied -> + (Overlay.Show + (Overlay "times-circle" + "Can't enable desktop notifications." + [ Html.text "You did not give Massive Decks permission to give you desktop notifications." ] + ) + ) + |> OverlayMessage - _ -> - NoOp |> LocalMessage + _ -> + NoOp |> LocalMessage icon : Model -> String -> Maybe String -icon model name = Just (model.init.url ++ "assets/images/icons/" ++ name ++ ".png") +icon model name = + Just (model.init.url ++ "assets/images/icons/" ++ name ++ ".png") -type alias Update = Model -> (Model, Cmd ConsumerMessage) +type alias Update = + Model -> ( Model, Cmd ConsumerMessage ) updateLobbyAndHand : Game.LobbyAndHand -> Update updateLobbyAndHand lobbyAndHand model = - { model | lobby = lobbyAndHand.lobby - , hand = lobbyAndHand.hand} ! - [ Util.cmd (Playing.LobbyAndHandUpdated |> Playing.LocalMessage |> PlayingMessage |> LocalMessage) ] + { model + | lobby = lobbyAndHand.lobby + , hand = lobbyAndHand.hand + } + ! [ Util.cmd (Playing.LobbyAndHandUpdated |> Playing.LocalMessage |> PlayingMessage |> LocalMessage) ] {-| Handles a change to the displayed notification. -} -notificationChange : Model -> Maybe Notification -> (Model, Cmd ConsumerMessage) +notificationChange : Model -> Maybe Notification -> ( Model, Cmd ConsumerMessage ) notificationChange model notification = - let - newNotification = notification |> Util.or model.notification - cmd = case newNotification of - Just nn -> - let - dismiss = Util.after (Time.second * 5) (Task.succeed nn) - in - Task.perform (LocalMessage << DismissNotification) dismiss + let + newNotification = + notification |> Util.or model.notification - Nothing -> - Cmd.none - in - ({ model | notification = newNotification }, cmd) + cmd = + case newNotification of + Just nn -> + let + dismiss = + Util.after (Time.second * 5) (Task.succeed nn) + in + Task.perform (LocalMessage << DismissNotification) dismiss + + Nothing -> + Cmd.none + in + ( { model | notification = newNotification }, cmd ) diff --git a/client/src/MassiveDecks/Scenes/Lobby/Messages.elm b/client/src/MassiveDecks/Scenes/Lobby/Messages.elm index e44e663..386e844 100644 --- a/client/src/MassiveDecks/Scenes/Lobby/Messages.elm +++ b/client/src/MassiveDecks/Scenes/Lobby/Messages.elm @@ -16,28 +16,28 @@ import MassiveDecks.Components.TTS as TTS {-| This type is used for all sending of messages, allowing us to send messages handled outside this scene. -} type ConsumerMessage - = ErrorMessage Errors.Message - | OverlayMessage (Overlay.Message Message) - | Leave - | LocalMessage Message + = ErrorMessage Errors.Message + | OverlayMessage (Overlay.Message Message) + | Leave + | LocalMessage Message {-| The messages used in the start screen. -} type Message - = DismissNotification Notification - | SetNotification (List Player -> Maybe Notification) - | UpdateLobbyAndHand Game.LobbyAndHand - | UpdateLobby (Game.Lobby -> Game.Lobby) - | UpdateHand Card.Hand - | Identify - | DisplayInviteOverlay - | BrowserNotificationForUser (Game.Lobby -> Maybe Player.Id) String String - | RenderQr - | Batch (List Message) - | NoOp - | BrowserNotificationsMessage BrowserNotifications.Message - | ConfigMessage Config.ConsumerMessage - | PlayingMessage Playing.ConsumerMessage - | SidebarMessage Sidebar.Message - | TTSMessage TTS.Message + = DismissNotification Notification + | SetNotification (List Player -> Maybe Notification) + | UpdateLobbyAndHand Game.LobbyAndHand + | UpdateLobby (Game.Lobby -> Game.Lobby) + | UpdateHand Card.Hand + | Identify + | DisplayInviteOverlay + | BrowserNotificationForUser (Game.Lobby -> Maybe Player.Id) String String + | RenderQr + | Batch (List Message) + | NoOp + | BrowserNotificationsMessage BrowserNotifications.Message + | ConfigMessage Config.ConsumerMessage + | PlayingMessage Playing.ConsumerMessage + | SidebarMessage Sidebar.Message + | TTSMessage TTS.Message diff --git a/client/src/MassiveDecks/Scenes/Lobby/Models.elm b/client/src/MassiveDecks/Scenes/Lobby/Models.elm index f9e3de7..5c4303a 100644 --- a/client/src/MassiveDecks/Scenes/Lobby/Models.elm +++ b/client/src/MassiveDecks/Scenes/Lobby/Models.elm @@ -15,15 +15,15 @@ import MassiveDecks.Components.TTS as TTS {-| The state of the lobby. -} type alias Model = - { lobby : Game.Lobby - , hand : Card.Hand - , config : Config.Model - , playing : Playing.Model - , browserNotifications : BrowserNotifications.Model - , secret : Player.Secret - , init : Init - , notification : Maybe Notification - , qrNeedsRendering : Bool - , sidebar : Sidebar.Model - , tts : TTS.Model - } + { lobby : Game.Lobby + , hand : Card.Hand + , config : Config.Model + , playing : Playing.Model + , browserNotifications : BrowserNotifications.Model + , secret : Player.Secret + , init : Init + , notification : Maybe Notification + , qrNeedsRendering : Bool + , sidebar : Sidebar.Model + , tts : TTS.Model + } diff --git a/client/src/MassiveDecks/Scenes/Lobby/Sidebar.elm b/client/src/MassiveDecks/Scenes/Lobby/Sidebar.elm index ca8d340..c517f4e 100644 --- a/client/src/MassiveDecks/Scenes/Lobby/Sidebar.elm +++ b/client/src/MassiveDecks/Scenes/Lobby/Sidebar.elm @@ -1,9 +1,7 @@ port module MassiveDecks.Scenes.Lobby.Sidebar exposing (Model, Message(..), init, update) import Task - import Window - import MassiveDecks.Util as Util @@ -13,42 +11,40 @@ lobby. No rendering is done within this module - instead the model should be inspected and the sidebar rendered as required. -} - - type alias Model = - { enhanceWidth : Int - , hidden : Bool - , shownAsOverlay : Bool - } + { enhanceWidth : Int + , hidden : Bool + , shownAsOverlay : Bool + } type Message - = Toggle - | Show Int - | Hide + = Toggle + | Show Int + | Hide init : Int -> Model init enhanceWidth = - { enhanceWidth = enhanceWidth - , hidden = False - , shownAsOverlay = False - } + { enhanceWidth = enhanceWidth + , hidden = False + , shownAsOverlay = False + } -update : Message -> Model -> (Model, Cmd Message) +update : Message -> Model -> ( Model, Cmd Message ) update message model = - case message of - Toggle -> - (model, Task.perform Show Window.width) + case message of + Toggle -> + ( model, Task.perform Show Window.width ) - Show screenWidth -> - if model.shownAsOverlay then - ({ model | shownAsOverlay = False }, Cmd.none) - else if screenWidth > model.enhanceWidth then - ({ model | hidden = not model.hidden }, Cmd.none) - else - ({ model | shownAsOverlay = True }, Cmd.none) + Show screenWidth -> + if model.shownAsOverlay then + ( { model | shownAsOverlay = False }, Cmd.none ) + else if screenWidth > model.enhanceWidth then + ( { model | hidden = not model.hidden }, Cmd.none ) + else + ( { model | shownAsOverlay = True }, Cmd.none ) - Hide -> - ({ model | shownAsOverlay = False }, Cmd.none) + Hide -> + ( { model | shownAsOverlay = False }, Cmd.none ) diff --git a/client/src/MassiveDecks/Scenes/Lobby/UI.elm b/client/src/MassiveDecks/Scenes/Lobby/UI.elm index a36fc77..e8e0b08 100644 --- a/client/src/MassiveDecks/Scenes/Lobby/UI.elm +++ b/client/src/MassiveDecks/Scenes/Lobby/UI.elm @@ -3,7 +3,6 @@ module MassiveDecks.Scenes.Lobby.UI exposing (view, inviteOverlay) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) - import MassiveDecks.Components.About as About import MassiveDecks.Components.Errors as Errors import MassiveDecks.Components.QR as QR @@ -24,263 +23,405 @@ import MassiveDecks.Util as Util view : Model -> Html ConsumerMessage view model = - let - lobby = model.lobby - url = model.init.url - gameCode = lobby.gameCode - players = lobby.players - (header, contents) = case lobby.game of - Game.Configuring -> - ([], [ Config.view model |> Html.map (ConfigMessage >> LocalMessage) ]) + let + lobby = + model.lobby - Game.Playing round -> - let - (h, c) = Playing.view model round - in - (h |> List.map (Html.map (PlayingMessage >> LocalMessage)), c |> List.map (Html.map (PlayingMessage >> LocalMessage))) + url = + model.init.url - Game.Finished -> - ([], []) - in - root model.sidebar.hidden - [ appHeader header model - , spacer - , scores model.secret.id model.lobby.owner model.sidebar.shownAsOverlay players - , contentWrapper contents - ] + gameCode = + lobby.gameCode + + players = + lobby.players + + ( header, contents ) = + case lobby.game of + Game.Configuring -> + ( [], [ Config.view model |> Html.map (ConfigMessage >> LocalMessage) ] ) + + Game.Playing round -> + let + ( h, c ) = + Playing.view model round + in + ( h |> List.map (Html.map (PlayingMessage >> LocalMessage)), c |> List.map (Html.map (PlayingMessage >> LocalMessage)) ) + + Game.Finished -> + ( [], [] ) + in + root model.sidebar.hidden + [ appHeader header model + , spacer + , scores model.secret.id model.lobby.owner model.sidebar.shownAsOverlay players + , contentWrapper contents + ] root : Bool -> List (Html msg) -> Html msg -root hideScores contents = div [ classList [ ("content", True), ("hide-scores", hideScores) ] ] contents +root hideScores contents = + div [ classList [ ( "content", True ), ( "hide-scores", hideScores ) ] ] contents contentWrapper : List (Html msg) -> Html msg -contentWrapper contents = div [ id "content-wrapper" ] contents +contentWrapper contents = + div [ id "content-wrapper" ] contents spacer : Html msg -spacer = div [ class "mui--appbar-height" ] [] +spacer = + div [ class "mui--appbar-height" ] [] scores : Player.Id -> Player.Id -> Bool -> List Player -> Html ConsumerMessage scores client owner shownAsOverlay players = - let - hideMessage = LocalMessage (SidebarMessage Sidebar.Hide) - closeLink = if shownAsOverlay then - [ a [ class "link close-link" - , title "Hide." - , attribute "tabindex" "0" - , attribute "role" "button" - , onClick hideMessage - ] [ Icon.icon "times" ] - ] - else - [] - sidebar = - div [ id "scores", classList [ ("shownAsOverlay", shownAsOverlay), ("mui--z1", True) ] ] - [ div [ id "scores-title", class "mui--appbar-line-height mui--text-headline" ] ([ text "Players" ] ++ closeLink) - , div [ class "mui-divider" ] [] - , table [ class "mui-table" ] - [ thead [] [ tr [] [ th [ class "state", title "State" ] [ Icon.icon "tasks" ] - , th [ class "name" ] [ text "Player" ] - , th [ class "score", title "Score" ] [ Icon.icon "trophy" ] - ] - ] - , tbody [] (List.map (score client owner) players) - ] - ] - in - if shownAsOverlay then - div [ id "mui-overlay" - , Util.onClickIfId "mui-overlay" hideMessage (LocalMessage NoOp) - , Util.onKeyDown "Escape" hideMessage (LocalMessage NoOp) - , tabindex 0 - ] - [ sidebar ] - else - sidebar + let + hideMessage = + LocalMessage (SidebarMessage Sidebar.Hide) + + closeLink = + if shownAsOverlay then + [ a + [ class "link close-link" + , title "Hide." + , attribute "tabindex" "0" + , attribute "role" "button" + , onClick hideMessage + ] + [ Icon.icon "times" ] + ] + else + [] + + sidebar = + div [ id "scores", classList [ ( "shownAsOverlay", shownAsOverlay ), ( "mui--z1", True ) ] ] + [ div [ id "scores-title", class "mui--appbar-line-height mui--text-headline" ] ([ text "Players" ] ++ closeLink) + , div [ class "mui-divider" ] [] + , table [ class "mui-table" ] + [ thead [] + [ tr [] + [ th [ class "state", title "State" ] [ Icon.icon "tasks" ] + , th [ class "name" ] [ text "Player" ] + , th [ class "score", title "Score" ] [ Icon.icon "trophy" ] + ] + ] + , tbody [] (List.map (score client owner) players) + ] + ] + in + if shownAsOverlay then + div + [ id "mui-overlay" + , Util.onClickIfId "mui-overlay" hideMessage (LocalMessage NoOp) + , Util.onKeyDown "Escape" hideMessage (LocalMessage NoOp) + , tabindex 0 + ] + [ sidebar ] + else + sidebar score : Player.Id -> Player.Id -> Player -> Html msg score client owner player = - let - classes = classList - [ (Player.statusName player.status, True) - , ("disconnected", player.disconnected) - , ("left", player.left) - ] - prename = ((if player.id == owner then [ Icon.icon "star", text " " ] else []) - ++ (if player.disconnected then [ Icon.icon "minus-circle", text " " ] else [])) - afterNameTitle = (if player.id == owner then " (Owner)" else "") - ++ (if player.id == client then " (You)" else "") - ++ (if player.disconnected then " (Disconnected)" else "") - in - tr [ classes ] - [ td [ class "state", title (statusDescription player) ] [ (playerIcon player) ] - , td [ class "name", title (player.name ++ afterNameTitle) ] (List.append prename [ text player.name ]) - , td [ class "score" ] [ text (toString player.score) ] - ] + let + classes = + classList + [ ( Player.statusName player.status, True ) + , ( "disconnected", player.disconnected ) + , ( "left", player.left ) + ] + + prename = + ((if player.id == owner then + [ Icon.icon "star", text " " ] + else + [] + ) + ++ (if player.disconnected then + [ Icon.icon "minus-circle", text " " ] + else + [] + ) + ) + + afterNameTitle = + (if player.id == owner then + " (Owner)" + else + "" + ) + ++ (if player.id == client then + " (You)" + else + "" + ) + ++ (if player.disconnected then + " (Disconnected)" + else + "" + ) + in + tr [ classes ] + [ td [ class "state", title (statusDescription player) ] [ (playerIcon player) ] + , td [ class "name", title (player.name ++ afterNameTitle) ] (List.append prename [ text player.name ]) + , td [ class "score" ] [ text (toString player.score) ] + ] appHeader : List (Html ConsumerMessage) -> Model -> Html ConsumerMessage -appHeader contents model = (header [] [ div [ class "mui-appbar mui--z1 mui--appbar-line-height" ] - [ div [ class "mui--appbar-line-height" ] - [ span [ class "score-buttons" ] ([ scoresButton ] ++ (notificationPopup model.notification)) - , span [ id "title", class "mui--text-title mui--visible-xs-inline-block" ] contents - , gameMenu model ] ] ]) +appHeader contents model = + (header [] + [ div [ class "mui-appbar mui--z1 mui--appbar-line-height" ] + [ div [ class "mui--appbar-line-height" ] + [ span [ class "score-buttons" ] ([ scoresButton ] ++ (notificationPopup model.notification)) + , span [ id "title", class "mui--text-title mui--visible-xs-inline-block" ] contents + , gameMenu model + ] + ] + ] + ) scoresButton : Html ConsumerMessage scoresButton = - button [ class ("scores-toggle mui-btn mui-btn--small mui-btn--primary badged") - , title "Players." - , onClick (LocalMessage (SidebarMessage Sidebar.Toggle)) - ] - [ Icon.fwIcon "users" ] + button + [ class ("scores-toggle mui-btn mui-btn--small mui-btn--primary badged") + , title "Players." + , onClick (LocalMessage (SidebarMessage Sidebar.Toggle)) + ] + [ Icon.fwIcon "users" ] notificationPopup : Maybe Notification -> List (Html ConsumerMessage) notificationPopup notification = - case notification of - Just notification -> - let - hidden = if notification.visible then "" else "hide" - in - [ div [ class ("badge mui--z2 " ++ hidden) - , title notification.description - , onClick (LocalMessage (DismissNotification notification)) - ] - [ Icon.icon notification.icon, text (" " ++ notification.name) ] - ] - Nothing -> - [ div [ class ("badge mui--z2 hide") ] [] ] + case notification of + Just notification -> + let + hidden = + if notification.visible then + "" + else + "hide" + in + [ div + [ class ("badge mui--z2 " ++ hidden) + , title notification.description + , onClick (LocalMessage (DismissNotification notification)) + ] + [ Icon.icon notification.icon, text (" " ++ notification.name) ] + ] + + Nothing -> + [ div [ class ("badge mui--z2 hide") ] [] ] statusDescription : Player -> String -statusDescription player = case player.status of - NotPlayed -> "Choosing" - Played -> "Played" - Czar -> "Round Czar" - Ai -> "A Computer" - Neutral -> "" - Skipping -> "Being Skipped" +statusDescription player = + case player.status of + NotPlayed -> + "Choosing" + + Played -> + "Played" + + Czar -> + "Round Czar" + + Ai -> + "A Computer" + + Neutral -> + "" + + Skipping -> + "Being Skipped" statusIcon : Status -> Html msg -statusIcon status = Maybe.map Icon.fwIcon (statusIconName status) |> Maybe.withDefault (text "") +statusIcon status = + Maybe.map Icon.fwIcon (statusIconName status) |> Maybe.withDefault (text "") statusIconName : Status -> Maybe String -statusIconName status = case status of - NotPlayed -> Just "hourglass" - Played -> Just "check" - Czar -> Just "gavel" - Ai -> Just "cogs" - Neutral -> Nothing - Skipping -> Just "fast-forward" +statusIconName status = + case status of + NotPlayed -> + Just "hourglass" + + Played -> + Just "check" + + Czar -> + Just "gavel" + + Ai -> + Just "cogs" + + Neutral -> + Nothing + + Skipping -> + Just "fast-forward" playerIcon : Player -> Html msg playerIcon player = - if player.left then - Icon.icon "sign-out" - else - statusIcon player.status + if player.left then + Icon.icon "sign-out" + else + statusIcon player.status {-| The overlay for inviting players to a lobby. -} inviteOverlay : String -> String -> Overlay.Message msg inviteOverlay appUrl gameCode = - let - url = Util.lobbyUrl appUrl gameCode - contents = - [ p [] [ text "To invite other players, simply send them this link: " ] - , p [] [ a [ href url ] [ text url ] ] - , p [] [ text "Have them scan this QR code: " ] - , QR.view "invite-qr-code" - , p [] [ text "Or give them this game code to enter on the start page: " ] - , p [] [ input [ readonly True, value gameCode ] [] ] - ] - in - Overlay.Show - { icon = "bullhorn" - , title = "Invite Players" - , contents = contents - } + let + url = + Util.lobbyUrl appUrl gameCode + + contents = + [ p [] [ text "To invite other players, simply send them this link: " ] + , p [] [ a [ href url ] [ text url ] ] + , p [] [ text "Have them scan this QR code: " ] + , QR.view "invite-qr-code" + , p [] [ text "Or give them this game code to enter on the start page: " ] + , p [] [ input [ readonly True, value gameCode ] [] ] + ] + in + Overlay.Show + { icon = "bullhorn" + , title = "Invite Players" + , contents = contents + } notificationsMenuItem : BrowserNotifications.Model -> List (Html ConsumerMessage) notificationsMenuItem model = - let - (notClickable, enabled) = - if not model.supported then - (Just "Your browser does not support desktop notifications.", False) - else if model.permission == Just BrowserNotifications.Denied then - (Just "You have denied Massive Decks permission to display desktop notifications.", False) - else - (Nothing, model.enabled) + let + ( notClickable, enabled ) = + if not model.supported then + ( Just "Your browser does not support desktop notifications.", False ) + else if model.permission == Just BrowserNotifications.Denied then + ( Just "You have denied Massive Decks permission to display desktop notifications.", False ) + else + ( Nothing, model.enabled ) - classes = classList - [ ("link", True) - , ("disabled", not (Util.isNothing notClickable)) - ] + classes = + classList + [ ( "link", True ) + , ( "disabled", not (Util.isNothing notClickable) ) + ] - extraAttrs = - case notClickable of - Nothing -> - [ onClick (LocalMessage <| BrowserNotificationsMessage <| (if enabled then BrowserNotifications.disable else BrowserNotifications.enable)) ] - Just msg -> - [ title msg ] + extraAttrs = + case notClickable of + Nothing -> + [ onClick + (LocalMessage <| + BrowserNotificationsMessage <| + (if enabled then + BrowserNotifications.disable + else + BrowserNotifications.enable + ) + ) + ] - attributes = [ classes, attribute "tabindex" "0", attribute "role" "button" ] ++ extraAttrs + Just msg -> + [ title msg ] - description = " " ++ (if enabled then "Disable" else "Enable") ++ " Notifications" - in - [ li [] [ a attributes [ Icon.fwIcon (if enabled then "bell-slash" else "bell"), text description ] ] - ] + attributes = + [ classes, attribute "tabindex" "0", attribute "role" "button" ] ++ extraAttrs + + description = + " " + ++ (if enabled then + "Disable" + else + "Enable" + ) + ++ " Notifications" + in + [ li [] + [ a attributes + [ Icon.fwIcon + (if enabled then + "bell-slash" + else + "bell" + ) + , text description + ] + ] + ] {-| The menu for the game. -} gameMenu : Model -> Html ConsumerMessage gameMenu model = - let - url = (Errors.reportUrl { url = model.init.url, version = model.init.version } - "I was [a short explanation of what you were doing] when [a short explanation of the bug].") - in - div [ class "menu mui-dropdown" ] - [ button [ class "mui-btn mui-btn--small mui-btn--primary" - , attribute "data-mui-toggle" "dropdown" - , title "Game menu." - ] [ Icon.fwIcon "ellipsis-h" ] - , ul [ class "mui-dropdown__menu mui-dropdown__menu--right" ] - ([ li [] [ a [ class "link" + let + url = + (Errors.reportUrl { url = model.init.url, version = model.init.version } + "I was [a short explanation of what you were doing] when [a short explanation of the bug]." + ) + in + div [ class "menu mui-dropdown" ] + [ button + [ class "mui-btn mui-btn--small mui-btn--primary" + , attribute "data-mui-toggle" "dropdown" + , title "Game menu." + ] + [ Icon.fwIcon "ellipsis-h" ] + , ul [ class "mui-dropdown__menu mui-dropdown__menu--right" ] + ([ li [] + [ a + [ class "link" , attribute "tabindex" "0" , attribute "role" "button" , onClick (DisplayInviteOverlay |> LocalMessage) - ] [ Icon.fwIcon "bullhorn", text " Invite Players" ] ] - ] ++ (notificationsMenuItem model.browserNotifications) ++ - [ li [] [ a [ class "link" - , attribute "tabindex" "0" - , attribute "role" "button" - , onClick (TTS.Enabled (not model.tts.enabled) |> TTSMessage |> LocalMessage) ] - (if model.tts.enabled then [ Icon.fwIcon "volume-off", text " Disable Speech" ] - else [ Icon.fwIcon "volume-up", text " Enable Speech" ]) + [ Icon.fwIcon "bullhorn", text " Invite Players" ] ] - , li [] [ a [ class "link" - , attribute "tabindex" "0" - , attribute "role" "button" - , onClick Leave - ] [ Icon.fwIcon "sign-out", text " Leave Game" ] ] - , li [ class "mui-divider" ] [] - , li [] [ a [ class "link" - , attribute "tabindex" "0" - , attribute "role" "button" - , onClick (About.show model.init.version |> OverlayMessage) - ] [ Icon.fwIcon "info-circle", text " About" ] ] - , li [] [ a [ href url, target "_blank", rel "noopener" ] - [ Icon.fwIcon "bug", text " Report a bug" ] ] - ]) - ] + ] + ++ (notificationsMenuItem model.browserNotifications) + ++ [ li [] + [ a + [ class "link" + , attribute "tabindex" "0" + , attribute "role" "button" + , onClick (TTS.Enabled (not model.tts.enabled) |> TTSMessage |> LocalMessage) + ] + (if model.tts.enabled then + [ Icon.fwIcon "volume-off", text " Disable Speech" ] + else + [ Icon.fwIcon "volume-up", text " Enable Speech" ] + ) + ] + , li [] + [ a + [ class "link" + , attribute "tabindex" "0" + , attribute "role" "button" + , onClick Leave + ] + [ Icon.fwIcon "sign-out", text " Leave Game" ] + ] + , li [ class "mui-divider" ] [] + , li [] + [ a + [ class "link" + , attribute "tabindex" "0" + , attribute "role" "button" + , onClick (About.show model.init.version |> OverlayMessage) + ] + [ Icon.fwIcon "info-circle", text " About" ] + ] + , li [] + [ a [ href url, target "_blank", rel "noopener" ] + [ Icon.fwIcon "bug", text " Report a bug" ] + ] + ] + ) + ] diff --git a/client/src/MassiveDecks/Scenes/Playing.elm b/client/src/MassiveDecks/Scenes/Playing.elm index 87e0082..112a046 100644 --- a/client/src/MassiveDecks/Scenes/Playing.elm +++ b/client/src/MassiveDecks/Scenes/Playing.elm @@ -2,11 +2,8 @@ module MassiveDecks.Scenes.Playing exposing (update, view, init, subscriptions) import Random import String - import Html exposing (..) - import AnimationFrame - import MassiveDecks.API as API import MassiveDecks.API.Request as Request import MassiveDecks.Models exposing (Init) @@ -31,258 +28,314 @@ import MassiveDecks.Util as Util -} init : Init -> Model init init = - { picked = [] - , considering = Nothing - , finishedRound = Nothing - , shownPlayed = { animated = [], toAnimate = [] } - , seed = Random.initialSeed (hack init.seed) - , history = Nothing - } + { picked = [] + , considering = Nothing + , finishedRound = Nothing + , shownPlayed = { animated = [], toAnimate = [] } + , seed = Random.initialSeed (hack init.seed) + , history = Nothing + } houseRule : HouseRule.Id -> HouseRule houseRule id = - case id of - HouseRule.Reboot -> Reboot.rule + case id of + HouseRule.Reboot -> + Reboot.rule {-| We shouldn't need to do this! int flags blow up at the moment. For now, we pass a string, but we should take an int from JS in the future. -} hack : String -> Int -hack seed = String.toInt seed |> Result.withDefault 0 +hack seed = + String.toInt seed |> Result.withDefault 0 {-| Subscriptions for the playing scene. -} subscriptions : Model -> Sub ConsumerMessage subscriptions model = - if List.isEmpty model.shownPlayed.toAnimate then - Sub.none - else - AnimationFrame.diffs (\_ -> LocalMessage AnimatePlayedCards) + if List.isEmpty model.shownPlayed.toAnimate then + Sub.none + else + AnimationFrame.diffs (\_ -> LocalMessage AnimatePlayedCards) {-| Render the playing scene. -} -view : Lobby.Model -> Round -> (List (Html ConsumerMessage), List (Html ConsumerMessage)) +view : Lobby.Model -> Round -> ( List (Html ConsumerMessage), List (Html ConsumerMessage) ) view model round = - let - (header, content) = UI.view model round - in - (header |> List.map (Html.map LocalMessage), content |> List.map (Html.map LocalMessage)) + let + ( header, content ) = + UI.view model round + in + ( header |> List.map (Html.map LocalMessage), content |> List.map (Html.map LocalMessage) ) {-| Handles messages and alters the model as appropriate. -} -update : Message -> Lobby.Model -> Round -> (Model, Cmd ConsumerMessage) +update : Message -> Lobby.Model -> Round -> ( Model, Cmd ConsumerMessage ) update message lobbyModel round = - let - model = lobbyModel.playing - lobby = lobbyModel.lobby - secret = lobbyModel.secret - gameCode = lobby.gameCode - in - case message of - Pick cardId -> - let - slots = Card.slots round.call - canPlay = (List.length model.picked) < slots - playing = case round.state of - Round.P _ -> True - _ -> False - in - if playing && canPlay then - ({ model | picked = model.picked ++ [ cardId ] }, Cmd.none) - else - (model, Cmd.none) + let + model = + lobbyModel.playing - Withdraw cardId -> - ({ model | picked = List.filter ((/=) cardId) model.picked }, Cmd.none) + lobby = + lobbyModel.lobby - Play -> - ( { model | picked = [] } - , Request.send (API.play gameCode secret model.picked) playErrorHandler ErrorMessage HandUpdate - ) + secret = + lobbyModel.secret - Consider potentialWinnerIndex -> - let - speech = (case round.state of - Round.J judging -> - Util.get judging.responses potentialWinnerIndex |> Maybe.map (\fill -> (round, fill)) - _ -> - Nothing) - |> Maybe.map (\(round, callFill) -> TTS.Say (CardsUI.callText round.call callFill) |> TTSMessage |> Util.cmd) - |> Maybe.withDefault Cmd.none - in - ( { model | considering = Just potentialWinnerIndex } - , speech - ) - - Choose winnerIndex -> - ( { model | considering = Nothing } - , Request.send (API.choose gameCode secret winnerIndex) chooseErrorHandler ErrorMessage ignore - ) - - NextRound -> - ( { model | considering = Nothing - , finishedRound = Nothing - } - , Cmd.none - ) - - AnimatePlayedCards -> - let - (shownPlayed, seed) = updatePositioning model.shownPlayed model.seed - in - ( { model | seed = seed - , shownPlayed = shownPlayed - } - , Cmd.none - ) - - Skip playerIds -> - (model, Request.send (API.skip gameCode secret playerIds) skipErrorHandler ErrorMessage ignore) - - Back -> - (model, Request.send_ (API.back gameCode secret) ErrorMessage ignore) - - LobbyAndHandUpdated -> - lobbyAndHandUpdated lobbyModel round - - Redraw -> - (model, Request.send (API.redraw lobbyModel.lobby.gameCode lobbyModel.secret) redrawErrorHandler ErrorMessage HandUpdate) - - FinishRound finishedRound -> - let - cards = finishedRound.state.responses - winning = Card.winningCards cards finishedRound.state.playedByAndWinner |> Maybe.withDefault [] - speech = Card.filled finishedRound.call winning - in - ({ model | finishedRound = Just finishedRound}, TTS.Say speech |> TTSMessage |> Util.cmd) - - HistoryMessage historyMessage -> - case model.history of - Just history -> - case historyMessage of - History.ErrorMessage errorMessage -> - (model, ErrorMessage errorMessage |> Util.cmd) - - History.Close -> - ({ model | history = Nothing }, Cmd.none) - - History.LocalMessage localMessage -> + gameCode = + lobby.gameCode + in + case message of + Pick cardId -> let - (newHistory, cmd) = History.update localMessage history + slots = + Card.slots round.call + + canPlay = + (List.length model.picked) < slots + + playing = + case round.state of + Round.P _ -> + True + + _ -> + False in - ({ model | history = Just newHistory }, Cmd.map (LocalMessage << HistoryMessage) cmd) + if playing && canPlay then + ( { model | picked = model.picked ++ [ cardId ] }, Cmd.none ) + else + ( model, Cmd.none ) - Nothing -> - (model, Cmd.none) + Withdraw cardId -> + ( { model | picked = List.filter ((/=) cardId) model.picked }, Cmd.none ) - ViewHistory -> - let - (historyModel, command) = History.init lobbyModel.lobby.gameCode - in - ({ model | history = Just historyModel }, Cmd.map (LocalMessage << HistoryMessage) command) + Play -> + ( { model | picked = [] } + , Request.send (API.play gameCode secret model.picked) playErrorHandler ErrorMessage HandUpdate + ) - NoOp -> - (model, Cmd.none) + Consider potentialWinnerIndex -> + let + speech = + (case round.state of + Round.J judging -> + Util.get judging.responses potentialWinnerIndex |> Maybe.map (\fill -> ( round, fill )) + + _ -> + Nothing + ) + |> Maybe.map (\( round, callFill ) -> TTS.Say (CardsUI.callText round.call callFill) |> TTSMessage |> Util.cmd) + |> Maybe.withDefault Cmd.none + in + ( { model | considering = Just potentialWinnerIndex } + , speech + ) + + Choose winnerIndex -> + ( { model | considering = Nothing } + , Request.send (API.choose gameCode secret winnerIndex) chooseErrorHandler ErrorMessage ignore + ) + + NextRound -> + ( { model + | considering = Nothing + , finishedRound = Nothing + } + , Cmd.none + ) + + AnimatePlayedCards -> + let + ( shownPlayed, seed ) = + updatePositioning model.shownPlayed model.seed + in + ( { model + | seed = seed + , shownPlayed = shownPlayed + } + , Cmd.none + ) + + Skip playerIds -> + ( model, Request.send (API.skip gameCode secret playerIds) skipErrorHandler ErrorMessage ignore ) + + Back -> + ( model, Request.send_ (API.back gameCode secret) ErrorMessage ignore ) + + LobbyAndHandUpdated -> + lobbyAndHandUpdated lobbyModel round + + Redraw -> + ( model, Request.send (API.redraw lobbyModel.lobby.gameCode lobbyModel.secret) redrawErrorHandler ErrorMessage HandUpdate ) + + FinishRound finishedRound -> + let + cards = + finishedRound.state.responses + + winning = + Card.winningCards cards finishedRound.state.playedByAndWinner |> Maybe.withDefault [] + + speech = + Card.filled finishedRound.call winning + in + ( { model | finishedRound = Just finishedRound }, TTS.Say speech |> TTSMessage |> Util.cmd ) + + HistoryMessage historyMessage -> + case model.history of + Just history -> + case historyMessage of + History.ErrorMessage errorMessage -> + ( model, ErrorMessage errorMessage |> Util.cmd ) + + History.Close -> + ( { model | history = Nothing }, Cmd.none ) + + History.LocalMessage localMessage -> + let + ( newHistory, cmd ) = + History.update localMessage history + in + ( { model | history = Just newHistory }, Cmd.map (LocalMessage << HistoryMessage) cmd ) + + Nothing -> + ( model, Cmd.none ) + + ViewHistory -> + let + ( historyModel, command ) = + History.init lobbyModel.lobby.gameCode + in + ( { model | history = Just historyModel }, Cmd.map (LocalMessage << HistoryMessage) command ) + + NoOp -> + ( model, Cmd.none ) ignore : () -> ConsumerMessage -ignore = (\_ -> LocalMessage NoOp) +ignore = + (\_ -> LocalMessage NoOp) -lobbyAndHandUpdated : Lobby.Model -> Round -> (Model, Cmd ConsumerMessage) +lobbyAndHandUpdated : Lobby.Model -> Round -> ( Model, Cmd ConsumerMessage ) lobbyAndHandUpdated lobbyModel round = - let - lobby = lobbyModel.lobby - model = lobbyModel.playing - shownPlayed = model.shownPlayed - playedCards = case round.state of - Round.P playing -> Just playing.numberPlayed - _ -> Nothing - (newShownPlayed, seed) = case playedCards of - Just amount -> - let - toShow = amount * (Card.slots round.call) - existing = (List.length shownPlayed.animated) + (List.length shownPlayed.toAnimate) - (new, seed) = addShownPlayed (toShow - existing) model.seed - in - (ShownPlayedCards shownPlayed.animated (shownPlayed.toAnimate ++ new), seed) + let + lobby = + lobbyModel.lobby - Nothing -> - (ShownPlayedCards [] [], model.seed) + model = + lobbyModel.playing - newModel = { model | shownPlayed = newShownPlayed - , seed = seed} - in - (newModel, Cmd.none) + shownPlayed = + model.shownPlayed + + playedCards = + case round.state of + Round.P playing -> + Just playing.numberPlayed + + _ -> + Nothing + + ( newShownPlayed, seed ) = + case playedCards of + Just amount -> + let + toShow = + amount * (Card.slots round.call) + + existing = + (List.length shownPlayed.animated) + (List.length shownPlayed.toAnimate) + + ( new, seed ) = + addShownPlayed (toShow - existing) model.seed + in + ( ShownPlayedCards shownPlayed.animated (shownPlayed.toAnimate ++ new), seed ) + + Nothing -> + ( ShownPlayedCards [] [], model.seed ) + + newModel = + { model + | shownPlayed = newShownPlayed + , seed = seed + } + in + ( newModel, Cmd.none ) redrawErrorHandler : API.RedrawError -> ConsumerMessage redrawErrorHandler error = - case error of - API.NotEnoughPoints -> ErrorMessage <| Errors.New "You do not have enough points to redraw your hand." False + case error of + API.NotEnoughPoints -> + ErrorMessage <| Errors.New "You do not have enough points to redraw your hand." False chooseErrorHandler : API.ChooseError -> ConsumerMessage chooseErrorHandler error = - case error of - API.NotCzar -> ErrorMessage <| Errors.New "You can't pick a winner as you are not the card czar this round." False + case error of + API.NotCzar -> + ErrorMessage <| Errors.New "You can't pick a winner as you are not the card czar this round." False playErrorHandler : API.PlayError -> ConsumerMessage playErrorHandler error = - case error of - API.NotInRound -> - ErrorMessage <| Errors.New "You can't play as you are not in this round." False + case error of + API.NotInRound -> + ErrorMessage <| Errors.New "You can't play as you are not in this round." False - API.AlreadyPlayed -> - ErrorMessage <| Errors.New "You can't play as you have already played in this round." False + API.AlreadyPlayed -> + ErrorMessage <| Errors.New "You can't play as you have already played in this round." False - API.AlreadyJudging -> - ErrorMessage <| Errors.New "You can't play as the round is already in it's judging phase." False + API.AlreadyJudging -> + ErrorMessage <| Errors.New "You can't play as the round is already in it's judging phase." False - API.WrongNumberOfCards got expected -> - ErrorMessage <| Errors.New ("You played the wrong number of cards - you played " ++ (toString got) ++ " cards, but the call needs " ++ (toString expected) ++ "cards.") False + API.WrongNumberOfCards got expected -> + ErrorMessage <| Errors.New ("You played the wrong number of cards - you played " ++ (toString got) ++ " cards, but the call needs " ++ (toString expected) ++ "cards.") False skipErrorHandler : API.SkipError -> ConsumerMessage skipErrorHandler error = - case error of - API.NotEnoughPlayersToSkip required -> - ErrorMessage <| Errors.New ("There are not enough players in the game to skip (must have at least " ++ (toString required) ++ ").") False + case error of + API.NotEnoughPlayersToSkip required -> + ErrorMessage <| Errors.New ("There are not enough players in the game to skip (must have at least " ++ (toString required) ++ ").") False - API.PlayersNotSkippable -> - ErrorMessage <| Errors.New "The players can't be skipped as they are not inactive." False + API.PlayersNotSkippable -> + ErrorMessage <| Errors.New "The players can't be skipped as they are not inactive." False -addShownPlayed : Int -> Random.Seed -> (List ShownCard, Random.Seed) -addShownPlayed new seed = Random.step (Random.list new initialRandomPositioning) seed +addShownPlayed : Int -> Random.Seed -> ( List ShownCard, Random.Seed ) +addShownPlayed new seed = + Random.step (Random.list new initialRandomPositioning) seed -updatePositioning : ShownPlayedCards -> Random.Seed -> (ShownPlayedCards, Random.Seed) +updatePositioning : ShownPlayedCards -> Random.Seed -> ( ShownPlayedCards, Random.Seed ) updatePositioning shownPlayed seed = - let - (newAnimated, newSeed) = Random.step (Random.list (List.length shownPlayed.toAnimate) randomPositioning) seed - in - (ShownPlayedCards (shownPlayed.animated ++ newAnimated) [], newSeed) + let + ( newAnimated, newSeed ) = + Random.step (Random.list (List.length shownPlayed.toAnimate) randomPositioning) seed + in + ( ShownPlayedCards (shownPlayed.animated ++ newAnimated) [], newSeed ) initialRandomPositioning : Random.Generator ShownCard initialRandomPositioning = - Random.map3 (\r h l -> ShownCard r h l -100) - (Random.int -75 75) - (Random.int 0 50) - Random.bool + Random.map3 (\r h l -> ShownCard r h l -100) + (Random.int -75 75) + (Random.int 0 50) + Random.bool randomPositioning : Random.Generator ShownCard randomPositioning = - Random.map4 ShownCard - (Random.int -90 90) - (Random.int 25 50) - Random.bool - (Random.int -5 1) + Random.map4 ShownCard + (Random.int -90 90) + (Random.int 25 50) + Random.bool + (Random.int -5 1) diff --git a/client/src/MassiveDecks/Scenes/Playing/HouseRule.elm b/client/src/MassiveDecks/Scenes/Playing/HouseRule.elm index 6e50396..05f2d82 100644 --- a/client/src/MassiveDecks/Scenes/Playing/HouseRule.elm +++ b/client/src/MassiveDecks/Scenes/Playing/HouseRule.elm @@ -6,18 +6,18 @@ import MassiveDecks.Scenes.Lobby.Models as Lobby type alias HouseRule = - { id : Id - , icon : String - , name : String - , description : String - , actions : List Action - } + { id : Id + , icon : String + , name : String + , description : String + , actions : List Action + } type alias Action = - { icon : String - , text : String - , description : String - , onClick : Playing.Message - , enabled : Lobby.Model -> Bool - } + { icon : String + , text : String + , description : String + , onClick : Playing.Message + , enabled : Lobby.Model -> Bool + } diff --git a/client/src/MassiveDecks/Scenes/Playing/HouseRule/Available.elm b/client/src/MassiveDecks/Scenes/Playing/HouseRule/Available.elm index a37755b..11a1b66 100644 --- a/client/src/MassiveDecks/Scenes/Playing/HouseRule/Available.elm +++ b/client/src/MassiveDecks/Scenes/Playing/HouseRule/Available.elm @@ -5,4 +5,5 @@ import MassiveDecks.Scenes.Playing.HouseRule.Reboot as Reboot houseRules : List HouseRule -houseRules = [ Reboot.rule ] +houseRules = + [ Reboot.rule ] diff --git a/client/src/MassiveDecks/Scenes/Playing/HouseRule/Id.elm b/client/src/MassiveDecks/Scenes/Playing/HouseRule/Id.elm index 775d940..2bc4312 100644 --- a/client/src/MassiveDecks/Scenes/Playing/HouseRule/Id.elm +++ b/client/src/MassiveDecks/Scenes/Playing/HouseRule/Id.elm @@ -2,10 +2,11 @@ module MassiveDecks.Scenes.Playing.HouseRule.Id exposing (Id(..), toString) type Id - = Reboot + = Reboot toString : Id -> String toString id = - case id of - Reboot -> "reboot" + case id of + Reboot -> + "reboot" diff --git a/client/src/MassiveDecks/Scenes/Playing/HouseRule/Reboot.elm b/client/src/MassiveDecks/Scenes/Playing/HouseRule/Reboot.elm index d6b2f35..b431da4 100644 --- a/client/src/MassiveDecks/Scenes/Playing/HouseRule/Reboot.elm +++ b/client/src/MassiveDecks/Scenes/Playing/HouseRule/Reboot.elm @@ -9,26 +9,26 @@ import MassiveDecks.Scenes.Lobby.Models as Lobby rule : HouseRule rule = - { id = HouseRule.Reboot - , icon = "recycle" - , name = "Rebooting the Universe" - , description = "At any time, players may trade in a point to discard their hand and redraw." - , actions = [ rebootAction ] - } + { id = HouseRule.Reboot + , icon = "recycle" + , name = "Rebooting the Universe" + , description = "At any time, players may trade in a point to discard their hand and redraw." + , actions = [ rebootAction ] + } rebootAction : HouseRule.Action rebootAction = - { icon = "recycle" - , text = "Redraw" - , description = "Lose one point to discard your hand and draw a new one." - , onClick = Playing.Redraw - , enabled = checkEnabled - } + { icon = "recycle" + , text = "Redraw" + , description = "Lose one point to discard your hand and draw a new one." + , onClick = Playing.Redraw + , enabled = checkEnabled + } checkEnabled : Lobby.Model -> Bool checkEnabled lobbyModel = - Player.byId lobbyModel.secret.id lobbyModel.lobby.players - |> Maybe.map (\player -> player.score > 0) - |> Maybe.withDefault False + Player.byId lobbyModel.secret.id lobbyModel.lobby.players + |> Maybe.map (\player -> player.score > 0) + |> Maybe.withDefault False diff --git a/client/src/MassiveDecks/Scenes/Playing/Messages.elm b/client/src/MassiveDecks/Scenes/Playing/Messages.elm index 6a2d915..4d36f12 100644 --- a/client/src/MassiveDecks/Scenes/Playing/Messages.elm +++ b/client/src/MassiveDecks/Scenes/Playing/Messages.elm @@ -11,27 +11,27 @@ import MassiveDecks.Models.Card as Card {-| This type is used for all sending of messages, allowing us to send messages handled outside this scene. -} type ConsumerMessage - = HandUpdate Card.Hand - | TTSMessage TTS.Message - | ErrorMessage Errors.Message - | LocalMessage Message + = HandUpdate Card.Hand + | TTSMessage TTS.Message + | ErrorMessage Errors.Message + | LocalMessage Message {-| The messages used in the start screen. -} type Message - = LobbyAndHandUpdated - | Pick String - | Withdraw String - | Play - | Consider Int - | Choose Int - | NextRound - | AnimatePlayedCards - | Skip (List Player.Id) - | Back - | Redraw - | FinishRound Round.FinishedRound - | ViewHistory - | HistoryMessage History.ConsumerMessage - | NoOp + = LobbyAndHandUpdated + | Pick String + | Withdraw String + | Play + | Consider Int + | Choose Int + | NextRound + | AnimatePlayedCards + | Skip (List Player.Id) + | Back + | Redraw + | FinishRound Round.FinishedRound + | ViewHistory + | HistoryMessage History.ConsumerMessage + | NoOp diff --git a/client/src/MassiveDecks/Scenes/Playing/Models.elm b/client/src/MassiveDecks/Scenes/Playing/Models.elm index 41fdcba..3e05f05 100644 --- a/client/src/MassiveDecks/Scenes/Playing/Models.elm +++ b/client/src/MassiveDecks/Scenes/Playing/Models.elm @@ -1,7 +1,6 @@ module MassiveDecks.Scenes.Playing.Models exposing (Model, ShownPlayedCards, ShownCard) import Random - import MassiveDecks.Models.Game.Round as Round import MassiveDecks.Scenes.History.Models as History @@ -9,24 +8,24 @@ import MassiveDecks.Scenes.History.Models as History {-| The state of the lobby. -} type alias Model = - { picked : List String - , considering : Maybe Int - , finishedRound : Maybe Round.FinishedRound - , shownPlayed : ShownPlayedCards - , seed : Random.Seed - , history : Maybe History.Model - } + { picked : List String + , considering : Maybe Int + , finishedRound : Maybe Round.FinishedRound + , shownPlayed : ShownPlayedCards + , seed : Random.Seed + , history : Maybe History.Model + } type alias ShownPlayedCards = - { animated : List (ShownCard) - , toAnimate : List (ShownCard) - } + { animated : List ShownCard + , toAnimate : List ShownCard + } type alias ShownCard = - { rotation : Int - , horizontalPos : Int - , isLeft : Bool - , verticalPos : Int - } + { rotation : Int + , horizontalPos : Int + , isLeft : Bool + , verticalPos : Int + } diff --git a/client/src/MassiveDecks/Scenes/Playing/UI.elm b/client/src/MassiveDecks/Scenes/Playing/UI.elm index 1030421..b49979d 100644 --- a/client/src/MassiveDecks/Scenes/Playing/UI.elm +++ b/client/src/MassiveDecks/Scenes/Playing/UI.elm @@ -4,7 +4,6 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) import Html.Keyed as Keyed - import MassiveDecks.Components.Icon as Icon import MassiveDecks.Models.Game as Game import MassiveDecks.Models.Game.Round as Round exposing (Round) @@ -20,449 +19,596 @@ import MassiveDecks.Scenes.Playing.HouseRule.Available exposing (houseRules) import MassiveDecks.Util as Util -view : Lobby.Model -> Round -> (List (Html Message), List (Html Message)) +view : Lobby.Model -> Round -> ( List (Html Message), List (Html Message) ) view lobbyModel round = - let - model = lobbyModel.playing - lobby = lobbyModel.lobby + let + model = + lobbyModel.playing - (header, content) = case model.finishedRound of - Just round -> - winnerHeaderAndContents round lobby.players + lobby = + lobbyModel.lobby - Nothing -> - ([ Icon.icon "gavel", text (" " ++ (czarName lobby.players round.czar)) ], roundContents lobbyModel round) + ( header, content ) = + case model.finishedRound of + Just round -> + winnerHeaderAndContents round lobby.players - timedOut = Round.afterTimeLimit round.state - judging = case round.state of - Round.J _ -> True - _ -> False - in - case model.history of - Nothing -> - (header, List.concat [ infoBar lobby lobbyModel.secret - , content - , [ warningDrawer (List.concat [ skippingNotice lobby.players lobbyModel.secret.id - , timeoutNotice lobbyModel.secret.id lobby.players judging timedOut - , disconnectedNotice lobby.players - ]) - ] - ]) - Just history -> - ([], [ History.view history lobbyModel.lobby.players |> Html.map HistoryMessage ]) + Nothing -> + ( [ Icon.icon "gavel", text (" " ++ (czarName lobby.players round.czar)) ], roundContents lobbyModel round ) + + timedOut = + Round.afterTimeLimit round.state + + judging = + case round.state of + Round.J _ -> + True + + _ -> + False + in + case model.history of + Nothing -> + ( header + , List.concat + [ infoBar lobby lobbyModel.secret + , content + , [ warningDrawer + (List.concat + [ skippingNotice lobby.players lobbyModel.secret.id + , timeoutNotice lobbyModel.secret.id lobby.players judging timedOut + , disconnectedNotice lobby.players + ] + ) + ] + ] + ) + + Just history -> + ( [], [ History.view history lobbyModel.lobby.players |> Html.map HistoryMessage ] ) gameMenu : Lobby.Model -> Html Message gameMenu lobbyModel = - let - enabled = List.filter (\rule -> List.member rule.id lobbyModel.lobby.config.houseRules) houseRules - in - div [ class "action-menu mui-dropdown"] - [ button [ class "mui-btn mui-btn--small mui-btn--fab" - , title "Game actions." - , attribute "data-mui-toggle" "dropdown" + let + enabled = + List.filter (\rule -> List.member rule.id lobbyModel.lobby.config.houseRules) houseRules + in + div [ class "action-menu mui-dropdown" ] + [ button + [ class "mui-btn mui-btn--small mui-btn--fab" + , title "Game actions." + , attribute "data-mui-toggle" "dropdown" + ] + [ Icon.icon "bars" ] + , ul [ class "mui-dropdown__menu mui-dropdown__menu--right" ] + ([ li [] + [ a + [ classList [ ( "link", True ) ] + , title "View previous rounds from the game." + , attribute "tabindex" "0" + , attribute "role" "button" + , onClick ViewHistory + ] + [ Icon.fwIcon "history", text " ", text "Game History" ] + ] ] - [ Icon.icon "bars" ] - , ul [ class "mui-dropdown__menu mui-dropdown__menu--right" ] - ( [ li [] [ a [ classList [ ("link", True) ] - , title "View previous rounds from the game." - , attribute "tabindex" "0" - , attribute "role" "button" - , onClick ViewHistory - ] - [ Icon.fwIcon "history", text " ", text "Game History" ] - ] - ] ++ (List.concatMap (gameMenuItems lobbyModel) enabled) - ) - ] + ++ (List.concatMap (gameMenuItems lobbyModel) enabled) + ) + ] gameMenuItems : Lobby.Model -> HouseRule -> List (Html Message) -gameMenuItems lobbyModel rule = List.map (gameMenuItem lobbyModel rule) rule.actions +gameMenuItems lobbyModel rule = + List.map (gameMenuItem lobbyModel rule) rule.actions gameMenuItem : Lobby.Model -> HouseRule -> HouseRule.Action -> Html Message gameMenuItem lobbyModel rule action = - let - enabled = action.enabled lobbyModel - message = if enabled then action.onClick else NoOp - in - li [] [ a [ classList [ ("link", True), ("disabled", not enabled) ] - , title action.description - , attribute "tabindex" "0" - , attribute "role" "button" - , onClick message - ] - [ Icon.fwIcon action.icon, text " ", text action.text ] - ] + let + enabled = + action.enabled lobbyModel + + message = + if enabled then + action.onClick + else + NoOp + in + li [] + [ a + [ classList [ ( "link", True ), ( "disabled", not enabled ) ] + , title action.description + , attribute "tabindex" "0" + , attribute "role" "button" + , onClick message + ] + [ Icon.fwIcon action.icon, text " ", text action.text ] + ] roundContents : Lobby.Model -> Round -> List (Html Message) roundContents lobbyModel round = - let - lobby = lobbyModel.lobby - hand = lobbyModel.hand.hand - model = lobbyModel.playing - picked = getAllById model.picked hand - id = lobbyModel.secret.id - isCzar = round.czar == id - canPlay = List.filter (\player -> player.id == id) lobby.players - |> List.all (\player -> player.status == Player.NotPlayed) + let + lobby = + lobbyModel.lobby - callFill = case round.state of - Round.P _ -> picked - Round.J judging -> Maybe.withDefault [] (model.considering |> Maybe.andThen (Util.get judging.responses)) - Round.F _ -> [] + hand = + lobbyModel.hand.hand - pickedOrChosen = case round.state of - Round.P _ -> - pickedView picked (Card.slots round.call) (model.shownPlayed.animated ++ model.shownPlayed.toAnimate) + model = + lobbyModel.playing - Round.J judging -> - case model.considering of - Just considering -> - case Util.get judging.responses considering of - Just consideringCards -> [ consideringView considering consideringCards isCzar ] - Nothing -> [] - Nothing -> [] + picked = + getAllById model.picked hand - Round.F _ -> - [] + id = + lobbyModel.secret.id - playedOrHand = case round.state of - Round.P _ -> handView model.picked (not canPlay) hand - Round.J judging -> playedView isCzar judging.responses - Round.F _ -> div [] [] - in - [ playArea - ([ div [ class "round-area" ] (List.concat [ [ CardsUI.call round.call callFill ], pickedOrChosen ]) - , playedOrHand - , gameMenu lobbyModel - ]) - ] + isCzar = + round.czar == id + + canPlay = + List.filter (\player -> player.id == id) lobby.players + |> List.all (\player -> player.status == Player.NotPlayed) + + callFill = + case round.state of + Round.P _ -> + picked + + Round.J judging -> + Maybe.withDefault [] (model.considering |> Maybe.andThen (Util.get judging.responses)) + + Round.F _ -> + [] + + pickedOrChosen = + case round.state of + Round.P _ -> + pickedView picked (Card.slots round.call) (model.shownPlayed.animated ++ model.shownPlayed.toAnimate) + + Round.J judging -> + case model.considering of + Just considering -> + case Util.get judging.responses considering of + Just consideringCards -> + [ consideringView considering consideringCards isCzar ] + + Nothing -> + [] + + Nothing -> + [] + + Round.F _ -> + [] + + playedOrHand = + case round.state of + Round.P _ -> + handView model.picked (not canPlay) hand + + Round.J judging -> + playedView isCzar judging.responses + + Round.F _ -> + div [] [] + in + [ playArea + ([ div [ class "round-area" ] (List.concat [ [ CardsUI.call round.call callFill ], pickedOrChosen ]) + , playedOrHand + , gameMenu lobbyModel + ] + ) + ] getAllById : List String -> List Card.Response -> List Card.Response getAllById ids cards = - List.filterMap (getById cards) ids + List.filterMap (getById cards) ids getById : List Card.Response -> String -> Maybe Card.Response -getById cards id = List.filter (\card -> card.id == id) cards |> List.head +getById cards id = + List.filter (\card -> card.id == id) cards |> List.head consideringView : Int -> List Card.Response -> Bool -> Html Message consideringView considering consideringCards isCzar = - let - extra = if isCzar then [ ("!!button", chooseButton considering) ] else [] - in - div [] ([ Keyed.ol [ class "considering" ] ((List.map (\card -> (card.id, li [] [ (playedResponse card) ])) consideringCards) ++ extra) ]) + let + extra = + if isCzar then + [ ( "!!button", chooseButton considering ) ] + else + [] + in + div [] ([ Keyed.ol [ class "considering" ] ((List.map (\card -> ( card.id, li [] [ (playedResponse card) ] )) consideringCards) ++ extra) ]) -winnerHeaderAndContents : Round.FinishedRound -> List Player -> (List (Html Message), List (Html Message)) +winnerHeaderAndContents : Round.FinishedRound -> List Player -> ( List (Html Message), List (Html Message) ) winnerHeaderAndContents round players = - let - cards = round.state.responses - winning = Card.winningCards cards round.state.playedByAndWinner |> Maybe.withDefault [] - winner = Maybe.map .name (Util.get players round.state.playedByAndWinner.winner) |> Maybe.withDefault "" - in - ( [ Icon.icon "trophy", text (" " ++ winner) ] - , [ div [ class "winner mui-panel" ] - [ h1 [] [ Icon.icon "trophy" ] - , h2 [] [ text (" " ++ Card.filled round.call winning) ] - , h3 [] [ text ("- " ++ winner) ] - ] - , button [ id "next-round-button", class "mui-btn mui-btn--primary mui-btn--raised", onClick NextRound ] - [ text "Next Round" ] - ] - ) + let + cards = + round.state.responses + + winning = + Card.winningCards cards round.state.playedByAndWinner |> Maybe.withDefault [] + + winner = + Maybe.map .name (Util.get players round.state.playedByAndWinner.winner) |> Maybe.withDefault "" + in + ( [ Icon.icon "trophy", text (" " ++ winner) ] + , [ div [ class "winner mui-panel" ] + [ h1 [] [ Icon.icon "trophy" ] + , h2 [] [ text (" " ++ Card.filled round.call winning) ] + , h3 [] [ text ("- " ++ winner) ] + ] + , button [ id "next-round-button", class "mui-btn mui-btn--primary mui-btn--raised", onClick NextRound ] + [ text "Next Round" ] + ] + ) czarName : List Player -> Player.Id -> String czarName players czarId = - (List.filter (\player -> player.id == czarId) players) |> List.head |> Maybe.map .name |> Maybe.withDefault "" + (List.filter (\player -> player.id == czarId) players) |> List.head |> Maybe.map .name |> Maybe.withDefault "" playArea : List (Html Message) -> Html Message -playArea contents = div [ class "play-area" ] contents +playArea contents = + div [ class "play-area" ] contents -response : List String -> Bool -> Card.Response -> (String, Html Message) +response : List String -> Bool -> Card.Response -> ( String, Html Message ) response picked disabled response = - let - isPicked = List.member response.id picked - clickHandler = if isPicked || disabled then [] else [ onClick (Pick response.id) ] - in - (response.id, CardsUI.response isPicked clickHandler response) + let + isPicked = + List.member response.id picked + + clickHandler = + if isPicked || disabled then + [] + else + [ onClick (Pick response.id) ] + in + ( response.id, CardsUI.response isPicked clickHandler response ) blankResponse : ShownCard -> Html Message -blankResponse shownCard = div [ class "card mui-panel", positioning shownCard ] [] +blankResponse shownCard = + div [ class "card mui-panel", positioning shownCard ] [] positioning : ShownCard -> Html.Attribute msg positioning shownCard = - let - horizontalDirection = if shownCard.isLeft then "left" else "right" - in - style - [ ("transform", "rotate(" ++ (toString shownCard.rotation) ++ "deg)") - , (horizontalDirection, (toString shownCard.horizontalPos) ++ "%") - , ("top", (toString shownCard.verticalPos) ++ "%") - ] + let + horizontalDirection = + if shownCard.isLeft then + "left" + else + "right" + in + style + [ ( "transform", "rotate(" ++ (toString shownCard.rotation) ++ "deg)" ) + , ( horizontalDirection, (toString shownCard.horizontalPos) ++ "%" ) + , ( "top", (toString shownCard.verticalPos) ++ "%" ) + ] -handRender : Bool -> List (String, Html Message) -> Html Message +handRender : Bool -> List ( String, Html Message ) -> Html Message handRender disabled contents = - let - classes = "hand mui--divider-top" ++ if disabled then " disabled" else "" - in - Keyed.ul [ class classes ] (List.map (\(key, item) -> (key, li [] [ item ])) contents) + let + classes = + "hand mui--divider-top" + ++ if disabled then + " disabled" + else + "" + in + Keyed.ul [ class classes ] (List.map (\( key, item ) -> ( key, li [] [ item ] )) contents) handView : List String -> Bool -> List Card.Response -> Html Message handView picked disabled responses = - handRender disabled (List.map (response picked disabled) responses) + handRender disabled (List.map (response picked disabled) responses) -pickedResponse : Card.Response -> (String, Html Message) +pickedResponse : Card.Response -> ( String, Html Message ) pickedResponse response = - let - item = li [] - [ div [ class "card response mui-panel" ] [ div [ class "response-text" ] - [ text (Util.firstLetterToUpper response.text) - , text "." - ] - , withdrawButton response.id - ] - ] - in - (response.id, item) + let + item = + li [] + [ div [ class "card response mui-panel" ] + [ div [ class "response-text" ] + [ text (Util.firstLetterToUpper response.text) + , text "." + ] + , withdrawButton response.id + ] + ] + in + ( response.id, item ) -pickedView : List Card.Response -> Int -> List (ShownCard) -> List (Html Message) +pickedView : List Card.Response -> Int -> List ShownCard -> List (Html Message) pickedView picked slots shownPlayed = - let - numberPicked = List.length picked - pb = if (numberPicked < slots) then [] else [ playButton ] - in - [ div [ class "picked" ] - ([ Keyed.ol [] (List.map pickedResponse picked) ] ++ pb) - , div [ class "others-picked" ] (List.map blankResponse shownPlayed) - ] + let + numberPicked = + List.length picked + + pb = + if (numberPicked < slots) then + [] + else + [ playButton ] + in + [ div [ class "picked" ] + ([ Keyed.ol [] (List.map pickedResponse picked) ] ++ pb) + , div [ class "others-picked" ] (List.map blankResponse shownPlayed) + ] withdrawButton : String -> Html Message -withdrawButton id = button - [ class "withdraw-button mui-btn mui-btn--small mui-btn--danger mui-btn--fab" - , title "Take back this response." - , onClick (Withdraw id) ] - [ Icon.icon "times" ] +withdrawButton id = + button + [ class "withdraw-button mui-btn mui-btn--small mui-btn--danger mui-btn--fab" + , title "Take back this response." + , onClick (Withdraw id) + ] + [ Icon.icon "times" ] playButton : Html Message -playButton = button - [ class "play-button mui-btn mui-btn--small mui-btn--accent mui-btn--fab", title "Play these responses.", onClick Play ] - [ Icon.icon "check" ] +playButton = + button + [ class "play-button mui-btn mui-btn--small mui-btn--accent mui-btn--fab", title "Play these responses.", onClick Play ] + [ Icon.icon "check" ] playedView : Bool -> List Card.PlayedCards -> Html Message playedView isCzar responses = - ol [ class "played mui--divider-top" ] - (List.indexedMap (\index pc -> li [] [ (playedCards isCzar index pc) ]) responses) + ol [ class "played mui--divider-top" ] + (List.indexedMap (\index pc -> li [] [ (playedCards isCzar index pc) ]) responses) playedCards : Bool -> Int -> Card.PlayedCards -> Html Message playedCards isCzar playedId cards = ol - [ onClick (Consider playedId) ] - (List.map (\card -> li [] [ (playedResponse card) ]) cards) + [ onClick (Consider playedId) ] + (List.map (\card -> li [] [ (playedResponse card) ]) cards) playedResponse : Card.Response -> Html Message playedResponse response = - div [ class "card response mui-panel" ] - [ div [ class "response-text" ] - [ text (Util.firstLetterToUpper response.text), text "." ] ] + div [ class "card response mui-panel" ] + [ div [ class "response-text" ] + [ text (Util.firstLetterToUpper response.text), text "." ] + ] chooseButton : Int -> Html Message chooseButton playedId = - button [ class "choose-button mui-btn mui-btn--small mui-btn--accent mui-btn--fab", onClick (Choose playedId) ] - [ Icon.icon "trophy" ] + button [ class "choose-button mui-btn mui-btn--small mui-btn--accent mui-btn--fab", onClick (Choose playedId) ] + [ Icon.icon "trophy" ] infoBar : Game.Lobby -> Player.Secret -> List (Html Message) infoBar lobby secret = - let - content = statusInfo lobby.players secret.id |> Util.or (stateInfo lobby.game) - in - case content of - Just message -> - [ div [ id "info-bar", class "mui--z1" ] - [ Icon.icon "info-circle" - , text " " - , text message - ] - ] - Nothing -> - [] + let + content = + statusInfo lobby.players secret.id |> Util.or (stateInfo lobby.game) + in + case content of + Just message -> + [ div [ id "info-bar", class "mui--z1" ] + [ Icon.icon "info-circle" + , text " " + , text message + ] + ] + + Nothing -> + [] statusInfo : List Player -> Player.Id -> Maybe String statusInfo players id = - case players |> Util.find (\player -> player.id == id) |> Maybe.map .status of - Just status -> - case status of - Player.Skipping -> - Nothing {- There is a warning for this instead. -} - Player.Neutral -> - Just "You joined while this round was already in play, you will be able to play next round." - Player.Czar -> - Just "As card czar for this round - you don't play into the round, you pick the winner." - _ -> - Nothing - Nothing -> - Nothing + case players |> Util.find (\player -> player.id == id) |> Maybe.map .status of + Just status -> + case status of + Player.Skipping -> + Nothing + + {- There is a warning for this instead. -} + Player.Neutral -> + Just "You joined while this round was already in play, you will be able to play next round." + + Player.Czar -> + Just "As card czar for this round - you don't play into the round, you pick the winner." + + _ -> + Nothing + + Nothing -> + Nothing stateInfo : Game.State -> Maybe String stateInfo state = - case state of - Game.Playing round -> - case round.state of - Round.J _ -> - Just "The card czar is now picking a winner." + case state of + Game.Playing round -> + case round.state of + Round.J _ -> + Just "The card czar is now picking a winner." + + _ -> + Nothing _ -> - Nothing - _ -> - Nothing + Nothing warningDrawer : List (Html Message) -> Html Message warningDrawer contents = - let - hidden = List.isEmpty contents - classes = - [ ("hidden", hidden) - ] - in - div [ id "warning-drawer", classList classes ] - [ button [ attribute "onClick" "toggleWarningDrawer()" - , class "toggle mui-btn mui-btn--small mui-btn--fab" - , title "Warning notices." - ] [ Icon.icon "exclamation-triangle" ] - , div [ class "top" ] [] - , div [ class "contents" ] contents - ] + let + hidden = + List.isEmpty contents + + classes = + [ ( "hidden", hidden ) + ] + in + div [ id "warning-drawer", classList classes ] + [ button + [ attribute "onClick" "toggleWarningDrawer()" + , class "toggle mui-btn mui-btn--small mui-btn--fab" + , title "Warning notices." + ] + [ Icon.icon "exclamation-triangle" ] + , div [ class "top" ] [] + , div [ class "contents" ] contents + ] skippingNotice : List Player -> Player.Id -> List (Html Message) skippingNotice players id = - let - status = players |> Util.find (\player -> player.id == id) |> Maybe.map .status - renderSkippingNoticeIfSkipping = (\status -> - case status of - Player.Skipping -> - renderSkippingNotice - _ -> - []) - in - Maybe.map renderSkippingNoticeIfSkipping status |> Maybe.withDefault [] + let + status = + players |> Util.find (\player -> player.id == id) |> Maybe.map .status + + renderSkippingNoticeIfSkipping = + (\status -> + case status of + Player.Skipping -> + renderSkippingNotice + + _ -> + [] + ) + in + Maybe.map renderSkippingNoticeIfSkipping status |> Maybe.withDefault [] renderSkippingNotice : List (Html Message) renderSkippingNotice = - [ div [ class "notice" ] - [ h3 [] [ Icon.icon "fast-forward" ] - , span [] [ text "You are currently being skipped because you took too long to play." ] - , div [ class "actions" ] - [ button [ class "mui-btn mui-btn--small" - , onClick Back - , title "Rejoin the game." - ] - [ Icon.icon "sign-in", text " Rejoin" ] - ] + [ div [ class "notice" ] + [ h3 [] [ Icon.icon "fast-forward" ] + , span [] [ text "You are currently being skipped because you took too long to play." ] + , div [ class "actions" ] + [ button + [ class "mui-btn mui-btn--small" + , onClick Back + , title "Rejoin the game." + ] + [ Icon.icon "sign-in", text " Rejoin" ] + ] + ] ] - ] timeoutNotice : Player.Id -> List Player -> Bool -> Bool -> List (Html Message) timeoutNotice playerId players judging timeout = - let - description = if judging then "picked a winnner for the round" else "played into the round" - requiredStatus = if judging then Player.Czar else Player.NotPlayed - timedOutPlayers = List.filter (\player -> player.status == requiredStatus) players - timedOutNames = Util.joinWithAnd (List.map .name timedOutPlayers) - timedOutIds = List.map .id timedOutPlayers - includesPlayer = List.member playerId timedOutIds - in - if timeout then - Maybe.map (renderTimeoutNotice includesPlayer description timedOutIds (Util.pluralHas timedOutPlayers)) timedOutNames - |> Maybe.map (\item -> [ item ]) - |> Maybe.withDefault [] - else - [] + let + description = + if judging then + "picked a winnner for the round" + else + "played into the round" + + requiredStatus = + if judging then + Player.Czar + else + Player.NotPlayed + + timedOutPlayers = + List.filter (\player -> player.status == requiredStatus) players + + timedOutNames = + Util.joinWithAnd (List.map .name timedOutPlayers) + + timedOutIds = + List.map .id timedOutPlayers + + includesPlayer = + List.member playerId timedOutIds + in + if timeout then + Maybe.map (renderTimeoutNotice includesPlayer description timedOutIds (Util.pluralHas timedOutPlayers)) timedOutNames + |> Maybe.map (\item -> [ item ]) + |> Maybe.withDefault [] + else + [] renderTimeoutNotice : Bool -> String -> List Player.Id -> String -> String -> Html Message renderTimeoutNotice includesPlayer description ids has names = - if includesPlayer then - div [ class "notice" ] - [ h3 [] [ Icon.icon "exclamation-circle" ] - , span [] [ text "The time has run out for you to have " - , text description - , text " and you can now be skipped." - ] - , div [ class "actions" ] [] - ] - else - div [ class "notice" ] - [ h3 [] [ Icon.icon "minus-circle" ] - , span [] [ text names - , text " " - , text has - , text " not " - , text description - , text " before the round timer ran out." - ] - , div [ class "actions" ] - [ button [ class "mui-btn mui-btn--small" - , onClick (Skip ids) - , title "They will be removed from this round, and won't be in future rounds until they come back." - ] - [ Icon.icon "fast-forward", text " Skip" ] - ] - ] + if includesPlayer then + div [ class "notice" ] + [ h3 [] [ Icon.icon "exclamation-circle" ] + , span [] + [ text "The time has run out for you to have " + , text description + , text " and you can now be skipped." + ] + , div [ class "actions" ] [] + ] + else + div [ class "notice" ] + [ h3 [] [ Icon.icon "minus-circle" ] + , span [] + [ text names + , text " " + , text has + , text " not " + , text description + , text " before the round timer ran out." + ] + , div [ class "actions" ] + [ button + [ class "mui-btn mui-btn--small" + , onClick (Skip ids) + , title "They will be removed from this round, and won't be in future rounds until they come back." + ] + [ Icon.icon "fast-forward", text " Skip" ] + ] + ] disconnectedNotice : List Player -> List (Html Message) disconnectedNotice players = - let - disconnected = List.filter (\player -> player.disconnected && (not (player.status == Player.Skipping))) players - disconnectedNames = Util.joinWithAnd (List.map .name disconnected) - disconnectedIds = List.map .id disconnected - in - Maybe.map (renderDisconnectedNotice disconnectedIds (Util.pluralHas disconnected)) disconnectedNames - |> Maybe.map (\item -> [ item ]) - |> Maybe.withDefault [] + let + disconnected = + List.filter (\player -> player.disconnected && (not (player.status == Player.Skipping))) players + + disconnectedNames = + Util.joinWithAnd (List.map .name disconnected) + + disconnectedIds = + List.map .id disconnected + in + Maybe.map (renderDisconnectedNotice disconnectedIds (Util.pluralHas disconnected)) disconnectedNames + |> Maybe.map (\item -> [ item ]) + |> Maybe.withDefault [] renderDisconnectedNotice : List Player.Id -> String -> String -> Html Message renderDisconnectedNotice ids has disconnectedNames = - div [ class "notice" ] - [ h3 [] [ Icon.icon "minus-circle" ] - , span [] [ text disconnectedNames - , text " " - , text has - , text " disconnected from the game." - ] - , div [ class "actions" ] - [ button [ class "mui-btn mui-btn--small" - , onClick (Skip ids) - , title "They will be removed from this round, and won't be in future rounds until they reconnect." - ] - [ Icon.icon "fast-forward", text " Skip" ] + div [ class "notice" ] + [ h3 [] [ Icon.icon "minus-circle" ] + , span [] + [ text disconnectedNames + , text " " + , text has + , text " disconnected from the game." ] - ] + , div [ class "actions" ] + [ button + [ class "mui-btn mui-btn--small" + , onClick (Skip ids) + , title "They will be removed from this round, and won't be in future rounds until they reconnect." + ] + [ Icon.icon "fast-forward", text " Skip" ] + ] + ] diff --git a/client/src/MassiveDecks/Scenes/Playing/UI/Cards.elm b/client/src/MassiveDecks/Scenes/Playing/UI/Cards.elm index 1032fe0..51dfc3d 100644 --- a/client/src/MassiveDecks/Scenes/Playing/UI/Cards.elm +++ b/client/src/MassiveDecks/Scenes/Playing/UI/Cards.elm @@ -1,62 +1,85 @@ module MassiveDecks.Scenes.Playing.UI.Cards exposing (call, callText, response) import String - import Html exposing (..) import Html.Attributes exposing (..) - import MassiveDecks.Models.Card as Card import MassiveDecks.Util as Util - call : Card.Call -> List Card.Response -> Html msg call call picked = - let - responseFirst = call.parts |> List.head |> Maybe.map ((==) "") |> Maybe.withDefault False - pickedText = List.map .text picked - (parts, responses) = if responseFirst then - (call.parts, Util.mapFirst Util.firstLetterToUpper pickedText) - else - (Util.mapFirst Util.firstLetterToUpper call.parts, pickedText) - spanned = List.map (\part -> span [] [ text part ]) call.parts - withSlots = Util.interleave (slots (Card.slots call) "" responses) spanned - callContents = if responseFirst then List.tail withSlots |> Maybe.withDefault withSlots else withSlots - in - div [ class "card call mui-panel" ] [ div [ class "call-text" ] callContents ] + let + responseFirst = + call.parts |> List.head |> Maybe.map ((==) "") |> Maybe.withDefault False + + pickedText = + List.map .text picked + + ( parts, responses ) = + if responseFirst then + ( call.parts, Util.mapFirst Util.firstLetterToUpper pickedText ) + else + ( Util.mapFirst Util.firstLetterToUpper call.parts, pickedText ) + + spanned = + List.map (\part -> span [] [ text part ]) call.parts + + withSlots = + Util.interleave (slots (Card.slots call) "" responses) spanned + + callContents = + if responseFirst then + List.tail withSlots |> Maybe.withDefault withSlots + else + withSlots + in + div [ class "card call mui-panel" ] [ div [ class "call-text" ] callContents ] callText : Card.Call -> List Card.Response -> String callText call picked = - let - responseFirst = call.parts |> List.head |> Maybe.map ((==) "") |> Maybe.withDefault False - pickedText = List.map .text picked - (parts, responses) = if responseFirst then - (call.parts, Util.mapFirst Util.firstLetterToUpper pickedText) - else - (Util.mapFirst Util.firstLetterToUpper call.parts, pickedText) - extra = (Card.slots call) - List.length picked - withSlots = Util.interleave (List.concat [pickedText, List.repeat extra "blank"]) call.parts - in - String.join " " withSlots + let + responseFirst = + call.parts |> List.head |> Maybe.map ((==) "") |> Maybe.withDefault False + + pickedText = + List.map .text picked + + ( parts, responses ) = + if responseFirst then + ( call.parts, Util.mapFirst Util.firstLetterToUpper pickedText ) + else + ( Util.mapFirst Util.firstLetterToUpper call.parts, pickedText ) + + extra = + (Card.slots call) - List.length picked + + withSlots = + Util.interleave (List.concat [ pickedText, List.repeat extra "blank" ]) call.parts + in + String.join " " withSlots slot : String -> Html msg -slot value = (span [ class "slot" ] [ text value ]) +slot value = + (span [ class "slot" ] [ text value ]) slots : Int -> String -> List String -> List (Html msg) slots count placeholder picked = - let - extra = count - List.length picked - in - List.concat [picked, List.repeat extra placeholder] |> List.map slot + let + extra = + count - List.length picked + in + List.concat [ picked, List.repeat extra placeholder ] |> List.map slot response : Bool -> List (Attribute msg) -> Card.Response -> Html msg response picked attributes response = - let - classes = [ classList [ ("card", True), ("response", True), ("mui-panel", True), ("picked", picked) ] ] - in - div (List.concat [ classes, attributes ]) - [ div [ class "response-text" ] [ text (Util.firstLetterToUpper response.text), text "." ] ] + let + classes = + [ classList [ ( "card", True ), ( "response", True ), ( "mui-panel", True ), ( "picked", picked ) ] ] + in + div (List.concat [ classes, attributes ]) + [ div [ class "response-text" ] [ text (Util.firstLetterToUpper response.text), text "." ] ] diff --git a/client/src/MassiveDecks/Scenes/Start.elm b/client/src/MassiveDecks/Scenes/Start.elm index ea0d419..dd7cde1 100644 --- a/client/src/MassiveDecks/Scenes/Start.elm +++ b/client/src/MassiveDecks/Scenes/Start.elm @@ -1,11 +1,8 @@ module MassiveDecks.Scenes.Start exposing (update, urlUpdate, view, init, subscriptions) import String - import Html exposing (..) - import Navigation - import MassiveDecks.Models exposing (Init, Path, pathFromLocation) import MassiveDecks.Models.Game as Game import MassiveDecks.Components.Tabs as Tabs @@ -26,266 +23,317 @@ import MassiveDecks.Util as Util {-| Create the initial model for the start screen. -} -init : Init -> Navigation.Location -> (Model, Cmd Message) +init : Init -> Navigation.Location -> ( Model, Cmd Message ) init init location = - let - path = pathFromLocation location - tab = if path.gameCode |> Maybe.withDefault "" |> String.isEmpty then Create else Join - in - ( { lobby = Nothing - , init = init - , path = path - , nameInput = Input.init Name "name-input" [ text "Your name in the game." ] "" "Nickname" (Util.cmd SubmitCurrentTab) InputMessage - , gameCodeInput = Input.init GameCode "game-code-input" [ text "The code for the game to join." ] (path.gameCode |> Maybe.withDefault "") "" (Util.cmd JoinLobbyAsNewPlayer) InputMessage - , errors = Errors.init - , overlay = Overlay.init OverlayMessage - , buttonsEnabled = True - , tabs = Tabs.init [ Tabs.Tab Create [ text "Create" ], Tabs.Tab Join [ text "Join" ] ] tab TabsMessage - , storage = init.existingGames - } - , Maybe.map (TryExistingGame >> Util.cmd) path.gameCode |> Maybe.withDefault Cmd.none) + let + path = + pathFromLocation location + + tab = + if path.gameCode |> Maybe.withDefault "" |> String.isEmpty then + Create + else + Join + in + ( { lobby = Nothing + , init = init + , path = path + , nameInput = Input.init Name "name-input" [ text "Your name in the game." ] "" "Nickname" (Util.cmd SubmitCurrentTab) InputMessage + , gameCodeInput = Input.init GameCode "game-code-input" [ text "The code for the game to join." ] (path.gameCode |> Maybe.withDefault "") "" (Util.cmd JoinLobbyAsNewPlayer) InputMessage + , errors = Errors.init + , overlay = Overlay.init OverlayMessage + , buttonsEnabled = True + , tabs = Tabs.init [ Tabs.Tab Create [ text "Create" ], Tabs.Tab Join [ text "Join" ] ] tab TabsMessage + , storage = init.existingGames + } + , Maybe.map (TryExistingGame >> Util.cmd) path.gameCode |> Maybe.withDefault Cmd.none + ) {-| Subscriptions for the start screen. -} subscriptions : Model -> Sub Message subscriptions model = - case model.lobby of - Nothing -> - Sub.none + case model.lobby of + Nothing -> + Sub.none - Just lobby -> - Lobby.subscriptions lobby |> Sub.map LobbyMessage + Just lobby -> + Lobby.subscriptions lobby |> Sub.map LobbyMessage {-| Render the start scene. -} view : Model -> Html Message view model = - let - contents = case model.lobby of - Nothing -> - UI.view model + let + contents = + case model.lobby of + Nothing -> + UI.view model - Just lobby -> - Html.map LobbyMessage (Lobby.view lobby) - in - div [] - ([ contents - , Errors.view { url = model.init.url, version = model.init.version } model.errors |> Html.map ErrorMessage - ] ++ Overlay.view model.overlay) + Just lobby -> + Html.map LobbyMessage (Lobby.view lobby) + in + div [] + ([ contents + , Errors.view { url = model.init.url, version = model.init.version } model.errors |> Html.map ErrorMessage + ] + ++ Overlay.view model.overlay + ) {-| Handles changes to the url. -} -urlUpdate : Path -> Model -> (Model, Cmd Message) +urlUpdate : Path -> Model -> ( Model, Cmd Message ) urlUpdate path model = - let - noGameCode = case path.gameCode of - Just _ -> False - Nothing -> True - setInput = - path.gameCode |> Maybe.map (\gameCode -> (GameCode, Input.SetDefaultValue gameCode) |> InputMessage |> Util.cmd) - in - { model | path = path - , lobby = if noGameCode then Nothing else model.lobby - , buttonsEnabled = True } ! - [ (if noGameCode then Cmd.none else Tabs.SetTab Join |> TabsMessage |> Util.cmd) - , setInput - |> Maybe.withDefault Cmd.none - , path.gameCode - |> Maybe.map (\gc -> Title.set ("Game " ++ gc ++ " - " ++ title)) - |> Maybe.withDefault (Title.set title) - , path.gameCode - |> Maybe.map (TryExistingGame >> Util.cmd) - |> Maybe.withDefault Cmd.none - ] + let + noGameCode = + case path.gameCode of + Just _ -> + False + + Nothing -> + True + + setInput = + path.gameCode |> Maybe.map (\gameCode -> ( GameCode, Input.SetDefaultValue gameCode ) |> InputMessage |> Util.cmd) + in + { model + | path = path + , lobby = + if noGameCode then + Nothing + else + model.lobby + , buttonsEnabled = True + } + ! [ (if noGameCode then + Cmd.none + else + Tabs.SetTab Join |> TabsMessage |> Util.cmd + ) + , setInput + |> Maybe.withDefault Cmd.none + , path.gameCode + |> Maybe.map (\gc -> Title.set ("Game " ++ gc ++ " - " ++ title)) + |> Maybe.withDefault (Title.set title) + , path.gameCode + |> Maybe.map (TryExistingGame >> Util.cmd) + |> Maybe.withDefault Cmd.none + ] {-| Handles messages and alters the model as appropriate. -} -update : Message -> Model -> (Model, Cmd Message) +update : Message -> Model -> ( Model, Cmd Message ) update message model = - case message of - ErrorMessage message -> - let - (newErrors, cmd) = Errors.update message model.errors - in - ({ model | errors = newErrors }, Cmd.map ErrorMessage cmd) + case message of + ErrorMessage message -> + let + ( newErrors, cmd ) = + Errors.update message model.errors + in + ( { model | errors = newErrors }, Cmd.map ErrorMessage cmd ) - PathChange path -> - urlUpdate path model + PathChange path -> + urlUpdate path model - TabsMessage tabsMessage -> - ({ model | tabs = (Tabs.update tabsMessage model.tabs) }, Cmd.none) + TabsMessage tabsMessage -> + ( { model | tabs = (Tabs.update tabsMessage model.tabs) }, Cmd.none ) - ClearExistingGame existingGame -> - { model | storage = Storage.leave existingGame model.storage } ! - [ Overlay "info-circle" "Game over." [ text ("The game " ++ existingGame.gameCode ++ " has ended.") ] - |> Overlay.Show - |> OverlayMessage - |> Util.cmd - , Storage.Store |> StorageMessage |> Util.cmd - , Navigation.newUrl model.init.url - ] - - TryExistingGame gameCode -> - let - existing = List.filter (.gameCode >> ((==) gameCode)) model.storage |> List.head - cmd = - Maybe.map (\existing -> JoinLobbyAsExistingPlayer existing.secret existing.gameCode |> Util.cmd) existing - |> Maybe.withDefault (Navigation.modifyUrl model.init.url) - in - (model, cmd) - - CreateLobby -> - ( { model | buttonsEnabled = False } - , Request.send_ - (API.createLobby model.nameInput.value) - ErrorMessage - (\gameCodeAndSecret -> StoreCredentialsAndMoveToLobby gameCodeAndSecret.gameCode gameCodeAndSecret.secret)) - - SubmitCurrentTab -> - case model.tabs.current of - Create -> - (model, Util.cmd CreateLobby) - - Join -> - (model, Util.cmd JoinLobbyAsNewPlayer) - - SetButtonsEnabled enabled -> - ({ model | buttonsEnabled = enabled }, Cmd.none) - - JoinLobbyAsNewPlayer -> - ({ model | buttonsEnabled = False }, Util.cmd (JoinGivenLobbyAsNewPlayer model.gameCodeInput.value)) - - JoinGivenLobbyAsNewPlayer gameCode -> - case List.filter (.gameCode >> ((==) gameCode)) model.storage |> List.head of - Nothing -> - model ! - [ Request.send (API.newPlayer gameCode model.nameInput.value) - newPlayerErrorHandler - ErrorMessage - (StoreCredentialsAndMoveToLobby gameCode) - ] - - Just _ -> - model ! - [ MoveToLobby gameCode |> Util.cmd - , UI.alreadyInGameOverlay - |> Overlay.Show - |> OverlayMessage - |> Util.cmd - ] - - StoreCredentialsAndMoveToLobby gameCode secret -> - { model | storage = Storage.join (Game.GameCodeAndSecret gameCode secret) model.storage } ! - [ Storage.Store |> StorageMessage |> Util.cmd - , MoveToLobby gameCode |> Util.cmd - ] - - MoveToLobby gameCode -> - model ! [ Navigation.newUrl (model.init.url ++ "#" ++ gameCode) ] - - JoinLobbyAsExistingPlayer secret gameCode -> - model ! - [ Request.send (API.getLobbyAndHand gameCode secret) - (getLobbyAndHandErrorHandler (Game.GameCodeAndSecret gameCode secret)) - ErrorMessage - (JoinLobby secret) - ] - - JoinLobby secret lobbyAndHand -> - let - (lobby, cmd) = Lobby.init model.init lobbyAndHand secret - in - { model | lobby = Just lobby } ! - [ cmd |> Cmd.map LobbyMessage - ] - - InputMessage message -> - let - (nameInput, nameCmd) = Input.update message model.nameInput - (gameCodeInput, gameCodeCmd) = Input.update message model.gameCodeInput - in - ({ model | nameInput = nameInput - , gameCodeInput = gameCodeInput - }, Cmd.batch [ nameCmd, gameCodeCmd ]) - - OverlayMessage overlayMessage -> - ({ model | overlay = Overlay.update overlayMessage model.overlay }, Cmd.none) - - StorageMessage storageMessage -> - let - (storageModel, cmd) = Storage.update storageMessage model.storage - in - ({ model | storage = storageModel }, cmd |> Cmd.map StorageMessage) - - LobbyMessage message -> - case message of - Lobby.ErrorMessage message -> - (model, Util.cmd (ErrorMessage message)) - - Lobby.OverlayMessage message -> - (model, Util.cmd (OverlayMessage (Overlay.map (Lobby.LocalMessage >> LobbyMessage) message))) - - Lobby.Leave -> - let - (leave, storage) = case model.lobby of - Nothing -> - ([], model.storage) - - Just lobby -> - ( [ Request.send_ (API.leave lobby.lobby.gameCode lobby.secret) ErrorMessage (\_ -> NoOp) + ClearExistingGame existingGame -> + { model | storage = Storage.leave existingGame model.storage } + ! [ Overlay "info-circle" "Game over." [ text ("The game " ++ existingGame.gameCode ++ " has ended.") ] + |> Overlay.Show + |> OverlayMessage + |> Util.cmd , Storage.Store |> StorageMessage |> Util.cmd + , Navigation.newUrl model.init.url ] - , Storage.leave (Game.GameCodeAndSecret lobby.lobby.gameCode lobby.secret) model.storage + + TryExistingGame gameCode -> + let + existing = + List.filter (.gameCode >> ((==) gameCode)) model.storage |> List.head + + cmd = + Maybe.map (\existing -> JoinLobbyAsExistingPlayer existing.secret existing.gameCode |> Util.cmd) existing + |> Maybe.withDefault (Navigation.modifyUrl model.init.url) + in + ( model, cmd ) + + CreateLobby -> + ( { model | buttonsEnabled = False } + , Request.send_ + (API.createLobby model.nameInput.value) + ErrorMessage + (\gameCodeAndSecret -> StoreCredentialsAndMoveToLobby gameCodeAndSecret.gameCode gameCodeAndSecret.secret) + ) + + SubmitCurrentTab -> + case model.tabs.current of + Create -> + ( model, Util.cmd CreateLobby ) + + Join -> + ( model, Util.cmd JoinLobbyAsNewPlayer ) + + SetButtonsEnabled enabled -> + ( { model | buttonsEnabled = enabled }, Cmd.none ) + + JoinLobbyAsNewPlayer -> + ( { model | buttonsEnabled = False }, Util.cmd (JoinGivenLobbyAsNewPlayer model.gameCodeInput.value) ) + + JoinGivenLobbyAsNewPlayer gameCode -> + case List.filter (.gameCode >> ((==) gameCode)) model.storage |> List.head of + Nothing -> + model + ! [ Request.send (API.newPlayer gameCode model.nameInput.value) + newPlayerErrorHandler + ErrorMessage + (StoreCredentialsAndMoveToLobby gameCode) + ] + + Just _ -> + model + ! [ MoveToLobby gameCode |> Util.cmd + , UI.alreadyInGameOverlay + |> Overlay.Show + |> OverlayMessage + |> Util.cmd + ] + + StoreCredentialsAndMoveToLobby gameCode secret -> + { model | storage = Storage.join (Game.GameCodeAndSecret gameCode secret) model.storage } + ! [ Storage.Store |> StorageMessage |> Util.cmd + , MoveToLobby gameCode |> Util.cmd + ] + + MoveToLobby gameCode -> + model ! [ Navigation.newUrl (model.init.url ++ "#" ++ gameCode) ] + + JoinLobbyAsExistingPlayer secret gameCode -> + model + ! [ Request.send (API.getLobbyAndHand gameCode secret) + (getLobbyAndHandErrorHandler (Game.GameCodeAndSecret gameCode secret)) + ErrorMessage + (JoinLobby secret) + ] + + JoinLobby secret lobbyAndHand -> + let + ( lobby, cmd ) = + Lobby.init model.init lobbyAndHand secret + in + { model | lobby = Just lobby } + ! [ cmd |> Cmd.map LobbyMessage + ] + + InputMessage message -> + let + ( nameInput, nameCmd ) = + Input.update message model.nameInput + + ( gameCodeInput, gameCodeCmd ) = + Input.update message model.gameCodeInput + in + ( { model + | nameInput = nameInput + , gameCodeInput = gameCodeInput + } + , Cmd.batch [ nameCmd, gameCodeCmd ] ) - in - { model | lobby = Nothing - , buttonsEnabled = True - , storage = storage - } ! - ([ Navigation.newUrl model.init.url - ] ++ leave) - Lobby.LocalMessage message -> - case model.lobby of - Nothing -> - (model, Cmd.none) + OverlayMessage overlayMessage -> + ( { model | overlay = Overlay.update overlayMessage model.overlay }, Cmd.none ) - Just lobby -> - let - (newLobby, cmd) = Lobby.update message lobby - in - ({ model | lobby = Just newLobby }, Cmd.map LobbyMessage cmd) + StorageMessage storageMessage -> + let + ( storageModel, cmd ) = + Storage.update storageMessage model.storage + in + ( { model | storage = storageModel }, cmd |> Cmd.map StorageMessage ) - Batch messages -> - (model, messages |> List.map Util.cmd |> Cmd.batch) + LobbyMessage message -> + case message of + Lobby.ErrorMessage message -> + ( model, Util.cmd (ErrorMessage message) ) - NoOp -> - (model, Cmd.none) + Lobby.OverlayMessage message -> + ( model, Util.cmd (OverlayMessage (Overlay.map (Lobby.LocalMessage >> LobbyMessage) message)) ) + + Lobby.Leave -> + let + ( leave, storage ) = + case model.lobby of + Nothing -> + ( [], model.storage ) + + Just lobby -> + ( [ Request.send_ (API.leave lobby.lobby.gameCode lobby.secret) ErrorMessage (\_ -> NoOp) + , Storage.Store |> StorageMessage |> Util.cmd + ] + , Storage.leave (Game.GameCodeAndSecret lobby.lobby.gameCode lobby.secret) model.storage + ) + in + { model + | lobby = Nothing + , buttonsEnabled = True + , storage = storage + } + ! ([ Navigation.newUrl model.init.url + ] + ++ leave + ) + + Lobby.LocalMessage message -> + case model.lobby of + Nothing -> + ( model, Cmd.none ) + + Just lobby -> + let + ( newLobby, cmd ) = + Lobby.update message lobby + in + ( { model | lobby = Just newLobby }, Cmd.map LobbyMessage cmd ) + + Batch messages -> + ( model, messages |> List.map Util.cmd |> Cmd.batch ) + + NoOp -> + ( model, Cmd.none ) title : String -title = "Massive Decks" +title = + "Massive Decks" newPlayerErrorHandler : API.NewPlayerError -> Message newPlayerErrorHandler error = - let - errorMessage = case error of - API.NameInUse -> (Name, Just "This name is already in use in this game, try something else." |> Input.Error) |> InputMessage - API.NewPlayerLobbyNotFound -> (GameCode, Just "This game doesn't exist - check you have the right code." |> Input.Error) |> InputMessage - in - Batch [ SetButtonsEnabled True, errorMessage ] + let + errorMessage = + case error of + API.NameInUse -> + ( Name, Just "This name is already in use in this game, try something else." |> Input.Error ) |> InputMessage + + API.NewPlayerLobbyNotFound -> + ( GameCode, Just "This game doesn't exist - check you have the right code." |> Input.Error ) |> InputMessage + in + Batch [ SetButtonsEnabled True, errorMessage ] getLobbyAndHandErrorHandler : Game.GameCodeAndSecret -> API.GetLobbyAndHandError -> Message getLobbyAndHandErrorHandler gameCodeAndSecret error = - let - errorMessage = case error of - API.LobbyNotFound -> ClearExistingGame gameCodeAndSecret - API.SecretWrongOrNotAPlayer -> ClearExistingGame gameCodeAndSecret - in - Batch [ SetButtonsEnabled True, errorMessage ] + let + errorMessage = + case error of + API.LobbyNotFound -> + ClearExistingGame gameCodeAndSecret + + API.SecretWrongOrNotAPlayer -> + ClearExistingGame gameCodeAndSecret + in + Batch [ SetButtonsEnabled True, errorMessage ] diff --git a/client/src/MassiveDecks/Scenes/Start/Messages.elm b/client/src/MassiveDecks/Scenes/Start/Messages.elm index 236d19d..b00670e 100644 --- a/client/src/MassiveDecks/Scenes/Start/Messages.elm +++ b/client/src/MassiveDecks/Scenes/Start/Messages.elm @@ -14,37 +14,37 @@ import MassiveDecks.Models.Player as Player {-| The messages used in the start screen. -} type Message - = SubmitCurrentTab - | PathChange Path - | CreateLobby - | SetButtonsEnabled Bool - | JoinLobbyAsNewPlayer - | JoinGivenLobbyAsNewPlayer String - | JoinLobbyAsExistingPlayer Player.Secret String - | StoreCredentialsAndMoveToLobby String Player.Secret - | MoveToLobby String - | JoinLobby Player.Secret Game.LobbyAndHand - | TryExistingGame String - | ClearExistingGame Game.GameCodeAndSecret - | InputMessage (Input.Message InputId) - | LobbyMessage Lobby.ConsumerMessage - | ErrorMessage Errors.Message - | OverlayMessage (Overlay.Message Message) - | TabsMessage (Tabs.Message Tab) - | StorageMessage (Storage.Message) - | Batch (List Message) - | NoOp + = SubmitCurrentTab + | PathChange Path + | CreateLobby + | SetButtonsEnabled Bool + | JoinLobbyAsNewPlayer + | JoinGivenLobbyAsNewPlayer String + | JoinLobbyAsExistingPlayer Player.Secret String + | StoreCredentialsAndMoveToLobby String Player.Secret + | MoveToLobby String + | JoinLobby Player.Secret Game.LobbyAndHand + | TryExistingGame String + | ClearExistingGame Game.GameCodeAndSecret + | InputMessage (Input.Message InputId) + | LobbyMessage Lobby.ConsumerMessage + | ErrorMessage Errors.Message + | OverlayMessage (Overlay.Message Message) + | TabsMessage (Tabs.Message Tab) + | StorageMessage Storage.Message + | Batch (List Message) + | NoOp {-| IDs for the inputs to differentiate between them in messages. -} type InputId - = Name - | GameCode + = Name + | GameCode {-| Tabs for the start page. -} type Tab - = Create - | Join + = Create + | Join diff --git a/client/src/MassiveDecks/Scenes/Start/Models.elm b/client/src/MassiveDecks/Scenes/Start/Models.elm index 2fd5bb2..22c4e48 100644 --- a/client/src/MassiveDecks/Scenes/Start/Models.elm +++ b/client/src/MassiveDecks/Scenes/Start/Models.elm @@ -13,14 +13,14 @@ import MassiveDecks.Scenes.Start.Messages exposing (Message, InputId, Tab) {-| The state of the start screen. -} type alias Model = - { lobby : Maybe Lobby.Model - , init : Init - , path : Path - , nameInput : Input.Model InputId Message - , gameCodeInput : Input.Model InputId Message - , errors : Errors.Model - , overlay : Overlay.Model Message - , buttonsEnabled : Bool - , tabs : Tabs.Model Tab Message - , storage : Storage.Model - } + { lobby : Maybe Lobby.Model + , init : Init + , path : Path + , nameInput : Input.Model InputId Message + , gameCodeInput : Input.Model InputId Message + , errors : Errors.Model + , overlay : Overlay.Model Message + , buttonsEnabled : Bool + , tabs : Tabs.Model Tab Message + , storage : Storage.Model + } diff --git a/client/src/MassiveDecks/Scenes/Start/UI.elm b/client/src/MassiveDecks/Scenes/Start/UI.elm index f8021d9..0718fc7 100644 --- a/client/src/MassiveDecks/Scenes/Start/UI.elm +++ b/client/src/MassiveDecks/Scenes/Start/UI.elm @@ -1,12 +1,10 @@ module MassiveDecks.Scenes.Start.UI exposing (view, alreadyInGameOverlay) import String - import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) import Html.Keyed as Keyed - import MassiveDecks.Models.Game as Game import MassiveDecks.Components.Tabs as Tabs import MassiveDecks.Components.Icon as Icon @@ -20,101 +18,126 @@ import MassiveDecks.Scenes.Lobby.Messages as Lobby alreadyInGameOverlay : Overlay Message alreadyInGameOverlay = - Overlay - "info-circle" - "Already in game." - [ p [] [ text "You are already in this game, so you have joined as an existing player." ] - , p [] [ text "If you want to join as a new player, please " - , a [ class "link" - , title "Leave the game." - , attribute "tabindex" "0" - , attribute "role" "button" - , onClick (Batch [ Lobby.Leave |> LobbyMessage - , Overlay.Hide |> OverlayMessage - ]) - ] - [ text "leave the game" ] - , text " first." - ] - ] + Overlay + "info-circle" + "Already in game." + [ p [] [ text "You are already in this game, so you have joined as an existing player." ] + , p [] + [ text "If you want to join as a new player, please " + , a + [ class "link" + , title "Leave the game." + , attribute "tabindex" "0" + , attribute "role" "button" + , onClick + (Batch + [ Lobby.Leave |> LobbyMessage + , Overlay.Hide |> OverlayMessage + ] + ) + ] + [ text "leave the game" ] + , text " first." + ] + ] {-| Render the start screen. -} view : Model -> Html Message view model = - let - nameEntered = not (String.isEmpty model.nameInput.value) - gameCodeEntered = not (String.isEmpty model.gameCodeInput.value) - versionInfo = if String.isEmpty model.init.version then [] else [ text " Version ", text model.init.version ] - in - div [ id "start-screen" ] - [ div [ id "start-screen-content", class "mui-panel" ] - ([ h1 [ class "mui--divider-bottom" ] [ text "Massive Decks" ] - ] ++ (existingGames model.storage) - ++ [ Input.view model.nameInput - ] ++ (Tabs.view (renderTab nameEntered gameCodeEntered model) model.tabs) - ++ [ a [ class "about-link mui--divider-top link" - , attribute "tabindex" "0" - , attribute "role" "button" - , onClick (About.show model.init.version |> OverlayMessage) - ] - [ Icon.icon "question-circle" , text " About" ] - , div [ id "forkongithub" ] [ div [] [ a [ href "https://github.com/lattyware/massivedecks", target "_blank", rel "noopener" ] - [ Icon.icon "github", text " Fork me on GitHub" ] ] ] - ]) - , footer [] - [ a [ href "https://github.com/Lattyware/massivedecks" ] - [ img [ src "images/icon.svg", alt "The Massive Decks logo.", title "Massive Decks" ] [] ] - , p [] versionInfo + let + nameEntered = + not (String.isEmpty model.nameInput.value) + + gameCodeEntered = + not (String.isEmpty model.gameCodeInput.value) + + versionInfo = + if String.isEmpty model.init.version then + [] + else + [ text " Version ", text model.init.version ] + in + div [ id "start-screen" ] + [ div [ id "start-screen-content", class "mui-panel" ] + ([ h1 [ class "mui--divider-bottom" ] [ text "Massive Decks" ] ] - ] + ++ (existingGames model.storage) + ++ [ Input.view model.nameInput + ] + ++ (Tabs.view (renderTab nameEntered gameCodeEntered model) model.tabs) + ++ [ a + [ class "about-link mui--divider-top link" + , attribute "tabindex" "0" + , attribute "role" "button" + , onClick (About.show model.init.version |> OverlayMessage) + ] + [ Icon.icon "question-circle", text " About" ] + , div [ id "forkongithub" ] + [ div [] + [ a [ href "https://github.com/lattyware/massivedecks", target "_blank", rel "noopener" ] + [ Icon.icon "github", text " Fork me on GitHub" ] + ] + ] + ] + ) + , footer [] + [ a [ href "https://github.com/Lattyware/massivedecks" ] + [ img [ src "images/icon.svg", alt "The Massive Decks logo.", title "Massive Decks" ] [] ] + , p [] versionInfo + ] + ] + renderTab : Bool -> Bool -> Model -> Tab -> List (Html Message) renderTab nameEntered gameCodeEntered model tab = - case tab of - Create -> - [ createLobbyButton (nameEntered && model.buttonsEnabled) ] + case tab of + Create -> + [ createLobbyButton (nameEntered && model.buttonsEnabled) ] - Join -> - [ Input.view model.gameCodeInput - , joinLobbyButton (nameEntered && gameCodeEntered && model.buttonsEnabled) - ] + Join -> + [ Input.view model.gameCodeInput + , joinLobbyButton (nameEntered && gameCodeEntered && model.buttonsEnabled) + ] existingGames : List Game.GameCodeAndSecret -> List (Html msg) existingGames games = - if List.isEmpty games then - [] - else - [ div [ class "rejoin mui--divider-bottom" ] - [ span [] [ text "You can rejoin " ] - , Keyed.ul [] (List.map existingGame games) - ] - ] + if List.isEmpty games then + [] + else + [ div [ class "rejoin mui--divider-bottom" ] + [ span [] [ text "You can rejoin " ] + , Keyed.ul [] (List.map existingGame games) + ] + ] -existingGame : Game.GameCodeAndSecret -> (String, Html msg) + +existingGame : Game.GameCodeAndSecret -> ( String, Html msg ) existingGame game = - (game.gameCode, li [] [ a [ href ("#" ++ game.gameCode) ] [ text ("Game \"" ++ game.gameCode ++ "\"") ] ]) + ( game.gameCode, li [] [ a [ href ("#" ++ game.gameCode) ] [ text ("Game \"" ++ game.gameCode ++ "\"") ] ] ) {-| A button to join an existing lobby. -} joinLobbyButton : Bool -> Html Message joinLobbyButton enabled = - button [ class "mui-btn mui-btn--large mui-btn--primary" - , onClick JoinLobbyAsNewPlayer - , disabled (not enabled) - ] - [ text "Join Game" ] + button + [ class "mui-btn mui-btn--large mui-btn--primary" + , onClick JoinLobbyAsNewPlayer + , disabled (not enabled) + ] + [ text "Join Game" ] {-| A button to create a new lobby. -} createLobbyButton : Bool -> Html Message createLobbyButton enabled = - button [ class "mui-btn mui-btn--large mui-btn--primary" - , onClick CreateLobby - , disabled (not enabled) - ] - [ text "Create Game" ] + button + [ class "mui-btn mui-btn--large mui-btn--primary" + , onClick CreateLobby + , disabled (not enabled) + ] + [ text "Create Game" ] diff --git a/client/src/MassiveDecks/Util.elm b/client/src/MassiveDecks/Util.elm index a930f41..b1db7e0 100644 --- a/client/src/MassiveDecks/Util.elm +++ b/client/src/MassiveDecks/Util.elm @@ -5,7 +5,6 @@ import Task exposing (Task) import String import Process import Time exposing (Time) - import Html exposing (..) import Html.Keyed as Keyed import Html.Events exposing (..) @@ -15,148 +14,198 @@ import Html.Events exposing (..) requires a method, but it'll never get called. -} impossible : Never -> a -impossible n = impossible n +impossible n = + impossible n {-| Add an item to a list if the value is not nothing. -} andMaybe : Maybe a -> List a -> List a -andMaybe maybeExtra values = List.append values (Maybe.map (\value -> [ value ]) maybeExtra |> Maybe.withDefault []) +andMaybe maybeExtra values = + List.append values (Maybe.map (\value -> [ value ]) maybeExtra |> Maybe.withDefault []) or : Maybe a -> Maybe a -> Maybe a -or a b = case a of - Just _ -> a - Nothing -> b +or a b = + case a of + Just _ -> + a + + Nothing -> + b {-| Give the first value from the list that matches the given condition. If none do, return `Nothing`. -} find : (a -> Bool) -> List a -> Maybe a -find check items - = List.filter check items - |> List.head +find check items = + List.filter check items + |> List.head {-| Take two lists and inteleave them into each other. The first element will come from the second list. -} interleave : List a -> List a -> List a interleave list1 list2 = - case list1 of - [] -> - list2 - - x :: xs -> - case list2 of + case list1 of [] -> - list1 + list2 - y :: ys -> - y :: x :: interleave xs ys + x :: xs -> + case list2 of + [] -> + list1 + + y :: ys -> + y :: x :: interleave xs ys {-| An url to a lobby from the base url and the lobby id. -} lobbyUrl : String -> String -> String -lobbyUrl url lobbyId = url ++ "#" ++ lobbyId +lobbyUrl url lobbyId = + url ++ "#" ++ lobbyId {-| Create a command that just sends the given message instantly. -} cmd : msg -> Cmd msg -cmd message = Task.perform identity (Task.succeed message) +cmd message = + Task.perform identity (Task.succeed message) {-| Chains two updates together to produce a single update. -} -(:>) : (model -> (model, Cmd msg)) -> (model -> (model, Cmd msg)) -> model -> (model, Cmd msg) +(:>) : (model -> ( model, Cmd msg )) -> (model -> ( model, Cmd msg )) -> model -> ( model, Cmd msg ) (:>) a b model = - let - (aModel, aMsg) = a model - (bModel, bMsg) = b aModel - in - bModel ! [ aMsg, bMsg ] + let + ( aModel, aMsg ) = + a model + + ( bModel, bMsg ) = + b aModel + in + bModel ! [ aMsg, bMsg ] {-| Reduce the list to the given indices, and give those indicies with the elements. -} -getAllWithIndex : List a -> List Int -> List (Int, a) +getAllWithIndex : List a -> List Int -> List ( Int, a ) getAllWithIndex list indices = - getAll (List.indexedMap (,) list) indices + getAll (List.indexedMap (,) list) indices {-| Reduce the list to the given indices. -} getAll : List a -> List Int -> List a getAll list indices = - List.filterMap (get list) indices + List.filterMap (get list) indices {-| Get the element at the given index, or nothing. -} get : List a -> Int -> Maybe a -get list index = case List.drop index list of - [] -> Nothing - (item :: _) -> Just item +get list index = + case List.drop index list of + [] -> + Nothing + + item :: _ -> + Just item {-| Make the first character of the string uppercase. -} firstLetterToUpper : String -> String -firstLetterToUpper str = (String.toUpper (String.left 1 str)) ++ (String.dropLeft 1 str) +firstLetterToUpper str = + (String.toUpper (String.left 1 str)) ++ (String.dropLeft 1 str) {-| map over the first element of a list only, returning the rest as-is. -} mapFirst : (a -> a) -> List a -> List a -mapFirst f xs = List.indexedMap (\index x -> if index == 0 then f x else x) xs +mapFirst f xs = + List.indexedMap + (\index x -> + if index == 0 then + f x + else + x + ) + xs {-| Get "has" or "have" as appropriate for the given number of items. -} pluralHas : List a -> String -pluralHas items = case List.length items of - 1 -> "has" - _ -> "have" +pluralHas items = + case List.length items of + 1 -> + "has" + + _ -> + "have" {-| Join the given strings together with commas and spacing, as in a list, adding an 'and' between the last two elements. -} joinWithAnd : List String -> Maybe String -joinWithAnd items = case items of - [] -> Nothing - head :: [] -> Just head - first :: second :: [] -> Just (first ++ " and " ++ second) - head :: rest -> Just (head ++ ", " ++ (joinWithAnd rest |> Maybe.withDefault "")) +joinWithAnd items = + case items of + [] -> + Nothing + + head :: [] -> + Just head + + first :: second :: [] -> + Just (first ++ " and " ++ second) + + head :: rest -> + Just (head ++ ", " ++ (joinWithAnd rest |> Maybe.withDefault "")) {-| Apply every function in the list to the given element. -} apply : List (a -> b) -> a -> List b -apply fs value = List.map (\f -> f value) fs +apply fs value = + List.map (\f -> f value) fs {-| Perform a task after a given period of time. -} after : Time -> Task x a -> Task x a after waitFor task = - Process.sleep waitFor |> Task.andThen (\_ -> task) + Process.sleep waitFor |> Task.andThen (\_ -> task) + {-| Check if a Maybe is Nothing. -} isNothing : Maybe a -> Bool isNothing m = - case m of - Just _ -> False - Nothing -> True + case m of + Just _ -> + False + + Nothing -> + True {-| Add an event handler for keyboard key presses. -} onKeyDown : String -> msg -> msg -> Attribute msg onKeyDown key message noOp = - on "keydown" (Json.at [ "key" ] Json.string |> Json.map (\pressed -> if pressed == key then message else noOp)) + on "keydown" + (Json.at [ "key" ] Json.string + |> Json.map + (\pressed -> + if pressed == key then + message + else + noOp + ) + ) {-| Perform an action on click, only if the id of the clicked element matches (i.e: only on click for a given element @@ -164,13 +213,25 @@ in the tree). -} onClickIfId : String -> msg -> msg -> Attribute msg onClickIfId targetId message noOp = - on "click" (ifIdDecoder |> Json.map (\clickedId -> if clickedId == targetId then message else noOp)) + on "click" + (ifIdDecoder + |> Json.map + (\clickedId -> + if clickedId == targetId then + message + else + noOp + ) + ) + ifIdDecoder : Json.Decoder String -ifIdDecoder = Json.at [ "target", "id" ] Json.string +ifIdDecoder = + Json.at [ "target", "id" ] Json.string {-| Create a tbody where each row is keyed. -} -tbody : List (Attribute msg) -> List (String, Html msg) -> Html msg -tbody = Keyed.node "tbody" +tbody : List (Attribute msg) -> List ( String, Html msg ) -> Html msg +tbody = + Keyed.node "tbody"