diff --git a/client/src/MassiveDecks.elm b/client/src/MassiveDecks.elm index b505d05..814a540 100644 --- a/client/src/MassiveDecks.elm +++ b/client/src/MassiveDecks.elm @@ -1,26 +1,23 @@ module MassiveDecks exposing (main) -import String - import Navigation -import MassiveDecks.Models exposing (Init, Path) +import MassiveDecks.Models exposing (Init, Path, pathFromLocation) import MassiveDecks.Scenes.Start as Start +import MassiveDecks.Scenes.Start.Messages as Start +import MassiveDecks.Scenes.Start.Models as Start {-| The main application loop setup. -} -main : Program Init +main : Program Init Start.Model Start.Message main = Navigation.programWithFlags - (Navigation.makeParser pathParser) + locationToMessage { init = Start.init , update = Start.update - , urlUpdate = Start.urlUpdate , subscriptions = Start.subscriptions , view = Start.view } -pathParser : Navigation.Location -> Path -pathParser location = - { gameCode = Maybe.map snd (String.uncons location.hash) - } +locationToMessage : Navigation.Location -> Start.Message +locationToMessage location = pathFromLocation location |> Start.PathChange diff --git a/client/src/MassiveDecks/API.elm b/client/src/MassiveDecks/API.elm index 4fe50ea..d6fd11b 100644 --- a/client/src/MassiveDecks/API.elm +++ b/client/src/MassiveDecks/API.elm @@ -1,6 +1,6 @@ module MassiveDecks.API exposing (..) -import Json.Decode as Decode exposing ((:=)) +import Json.Decode as Decode import Json.Encode as Encode import MassiveDecks.API.Request exposing (..) @@ -138,7 +138,7 @@ newGame gameCode secret = "newGame" [] [ ((400, "game-in-progress"), Decode.succeed GameInProgress) - , ((400, "not-enough-players"), Decode.object1 NotEnoughPlayers ("required" := Decode.int)) + , ((400, "not-enough-players"), Decode.map NotEnoughPlayers (Decode.field "required" Decode.int)) ] handDecoder gameCode @@ -189,7 +189,7 @@ play gameCode secret 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.object2 WrongNumberOfCards ("got" := Decode.int) ("expected" := Decode.int)) + , ((400, "wrong-number-of-cards-played"), Decode.map2 WrongNumberOfCards (Decode.field "got" Decode.int) (Decode.field "expected" Decode.int)) ] handDecoder gameCode @@ -213,7 +213,7 @@ skip gameCode secret players = commandRequest "skip" [ ("players", Encode.list (List.map Encode.int players)) ] - [ ((400, "not-enough-players"), Decode.object1 NotEnoughPlayersToSkip ("required" := Decode.int)) + [ ((400, "not-enough-players"), Decode.map NotEnoughPlayersToSkip (Decode.field "required" Decode.int)) , ((400, "players-must-be-skippable"), Decode.succeed PlayersNotSkippable) ] (Decode.succeed ()) diff --git a/client/src/MassiveDecks/API/Request.elm b/client/src/MassiveDecks/API/Request.elm index 599d7cb..15fcfb3 100644 --- a/client/src/MassiveDecks/API/Request.elm +++ b/client/src/MassiveDecks/API/Request.elm @@ -1,11 +1,9 @@ -module MassiveDecks.API.Request exposing (send, send', request, Request, KnownError, Error(..)) +module MassiveDecks.API.Request exposing (send, send_, request, Request, KnownError, Error(..)) -import Json.Encode exposing (encode) import Json.Decode as Json -import Task import Dict exposing (Dict) -import Http exposing (Value(..)) +import Http import MassiveDecks.Components.Errors as Errors import MassiveDecks.Util as Util @@ -18,35 +16,61 @@ onSpecificError - How to handle any errors specific to the request. onGeneralError - How to handle any general errors. onSuccess - How to handle success. -If the request has no specific errors, use `send'` instead. +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 - errorToMessage = errorHandler onSpecificError onGeneralError - task = Http.send Http.defaultSettings - { verb = request.verb + req = Http.request + { method = request.method + , headers = [] , url = request.url - , headers = if request.body == Nothing then [] else jsonContentType , body = case request.body of - Just json -> jsonBody json - Nothing -> Http.empty - } |> Task.map (handleResponse request.errors request.resultDecoder) - errorMapped = (Task.mapError Communication task) `Task.andThen` Task.fromResult + Just json -> Http.jsonBody json + Nothing -> Http.emptyBody + , expect = Http.expectStringResponse (handleResponse request.resultDecoder request.errors) + , timeout = Nothing + , withCredentials = False + } in - Task.perform errorToMessage onSuccess errorMapped + 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) + + +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 {-| 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 Never result -> (Errors.Message -> message) -> (result -> message) -> Cmd message +send_ request onGeneralError onSuccess = send request Util.impossible onGeneralError onSuccess {-| A request to the API. -} type alias Request specificError result = - { verb : String + { method : String , url : String , body : Maybe Json.Value , errors : KnownErrors specificError @@ -72,19 +96,14 @@ type alias KnownErrors specificError = Dict (Int, String) (Json.Decoder specific {-| The top level of potential errors from an API request. -} type Error specificError - = Communication Http.RawError - | Malformed String + = General Http.Error | Known specificError - | Unknown Int String + | Unknown (Http.Response String) -{-| Handle an error, turning it into a message. --} -errorHandler : (specificErrors -> msg) -> (Errors.Message -> msg) -> Error specificErrors -> msg -errorHandler knownHandler errorMessageWrapper error = - case error of - Known specificError -> knownHandler specificError - _ -> genericErrorHandler error |> errorMessageWrapper +type ErrorOrResult specificError 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 @@ -93,68 +112,47 @@ 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 - Communication Http.RawTimeout -> Errors.New "Timed out trying to connect to the server." False - Communication Http.RawNetworkError -> Errors.New "There was a network error trying to connect to the server." False - Malformed explanation -> Errors.New ("The response recieved from the server was incorrect: " ++ explanation) True - Unknown code response -> Errors.New ("Recieved an unexpected response (" ++ (toString code) ++ ") from the server: " ++ response) True + 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 -handleResponse : KnownErrors specificError -> Json.Decoder message -> Http.Response -> Result (Error specificError) message -handleResponse errors resultDecoder response = - if response.status >= 200 && response.status < 300 then - handleSuccess resultDecoder response - else - handleFailure errors response |> Err + 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 -handleSuccess : Json.Decoder message -> Http.Response -> Result (Error specificError) message -handleSuccess resultDecoder response = - case response.value of - Text value -> Result.formatError Malformed (Json.decodeString resultDecoder value) - Blob blob -> Err (Malformed "Recieved binary data instead of expected JSON.") + 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 -handleFailure : KnownErrors specificError -> Http.Response -> Error specificError -handleFailure errors response = - case response.value of - Text value -> - case Json.decodeString errorKeyDecoder value of - Ok errorName -> - let - decoder = Dict.get (response.status, errorName) errors - in - case decoder of - Just decoder -> - case Json.decodeString decoder value of - Ok error -> - Known error - - Err error -> - Malformed error - - Nothing -> - Unknown response.status value - - Err error -> - Malformed error - - Blob blob -> Malformed "Recieved binary data instead of expected JSON in error." - - -{-| Specifies JSON encoded content. --} -jsonContentType : List (String, String) -jsonContentType = [ ("Content-Type", "application/json") ] - - -{-| Turns JSON into an HTTP body for a request. --} -jsonBody : Json.Value -> Http.Body -jsonBody value = encode 0 value |> Http.string + 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 + + +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) + + +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) diff --git a/client/src/MassiveDecks/Components/Errors.elm b/client/src/MassiveDecks/Components/Errors.elm index 04eccc3..7f606ff 100644 --- a/client/src/MassiveDecks/Components/Errors.elm +++ b/client/src/MassiveDecks/Components/Errors.elm @@ -2,7 +2,6 @@ module MassiveDecks.Components.Errors exposing (Message(..), Model, ApplicationI import String -import Http exposing (url) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) @@ -77,7 +76,7 @@ reportUrl applicationInfo message = 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 - url "https://github.com/Lattyware/massivedecks/issues/new" [ ( "body", full ) ] + "https://github.com/Lattyware/massivedecks/issues/new?body=" ++ full errorMessage : ApplicationInfo -> Error -> Html Message @@ -104,5 +103,5 @@ errorMessage applicationInfo error = ] , div [ class "mui-divider" ] [] , p [] [ text error.message ] - ] `Util.andMaybe` bugReportLink) + ] |> Util.andMaybe bugReportLink) ] diff --git a/client/src/MassiveDecks/Components/Input.elm b/client/src/MassiveDecks/Components/Input.elm index c16993d..099dce5 100644 --- a/client/src/MassiveDecks/Components/Input.elm +++ b/client/src/MassiveDecks/Components/Input.elm @@ -92,7 +92,7 @@ view : Model id msg -> Html msg view model = div [ class model.class ] ([ div [ class "mui-textfield" ] - ([ input [ type' "text" + ([ input [ type_ "text" , defaultValue model.value , placeholder model.placeholder , disabled (not model.enabled) @@ -100,7 +100,7 @@ view model = , 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)) + ] |> Util.andMaybe (error model.error)) ] ++ model.extra model.value) diff --git a/client/src/MassiveDecks/Components/Overlay.elm b/client/src/MassiveDecks/Components/Overlay.elm index d0dfb18..c617741 100644 --- a/client/src/MassiveDecks/Components/Overlay.elm +++ b/client/src/MassiveDecks/Components/Overlay.elm @@ -2,7 +2,6 @@ port module MassiveDecks.Components.Overlay exposing (Overlay, Model, Message(.. import Json.Decode as Json -import Html.App as Html import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) diff --git a/client/src/MassiveDecks/Models.elm b/client/src/MassiveDecks/Models.elm index 30ca566..ab3149f 100644 --- a/client/src/MassiveDecks/Models.elm +++ b/client/src/MassiveDecks/Models.elm @@ -1,5 +1,7 @@ module MassiveDecks.Models exposing (..) +import Navigation + import MassiveDecks.Models.Game exposing (GameCodeAndSecret) @@ -19,3 +21,9 @@ type alias Init = type alias Path = { gameCode : Maybe String } + + +pathFromLocation : Navigation.Location -> Path +pathFromLocation location = + { gameCode = Maybe.map Tuple.second (String.uncons location.hash) + } diff --git a/client/src/MassiveDecks/Models/Event.elm b/client/src/MassiveDecks/Models/Event.elm index a7eecc6..2ceedd3 100644 --- a/client/src/MassiveDecks/Models/Event.elm +++ b/client/src/MassiveDecks/Models/Event.elm @@ -1,6 +1,6 @@ module MassiveDecks.Models.Event exposing (Event(..), fromJson) -import Json.Decode as Json exposing ((:=)) +import Json.Decode as Json import MassiveDecks.Models.JSON.Decode exposing (..) import MassiveDecks.Models.Game as Game @@ -42,32 +42,32 @@ fromJson json = Json.decodeString eventDecoder json eventDecoder : Json.Decoder Event eventDecoder = - ("event" := Json.string) `Json.andThen` specificEventDecoder + (Json.field "event" Json.string) |> Json.andThen specificEventDecoder specificEventDecoder : String -> Json.Decoder Event specificEventDecoder name = case name of - "Sync" -> Json.object1 Sync ("lobbyAndHand" := lobbyAndHandDecoder) + "Sync" -> Json.map Sync (Json.field "lobbyAndHand" lobbyAndHandDecoder) - "PlayerJoin" -> Json.object1 PlayerJoin ("player" := playerDecoder) - "PlayerStatus" -> Json.object2 PlayerStatus ("player" := playerIdDecoder) ("status" := playerStatusDecoder) - "PlayerLeft" -> Json.object1 PlayerLeft ("player" := playerIdDecoder) - "PlayerDisconnect" -> Json.object1 PlayerDisconnect ("player" := playerIdDecoder) - "PlayerReconnect" -> Json.object1 PlayerReconnect ("player" := playerIdDecoder) - "PlayerScoreChange" -> Json.object2 PlayerScoreChange ("player" := playerIdDecoder) ("score" := Json.int) + "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) - "HandChange" -> Json.object1 HandChange ("hand" := handDecoder) + "HandChange" -> Json.map HandChange (Json.field "hand" handDecoder) - "RoundStart" -> Json.object2 RoundStart ("czar" := playerIdDecoder) ("call" := callDecoder) - "RoundPlayed" -> Json.object1 RoundPlayed ("playedCards" := Json.int) - "RoundJudging" -> Json.object1 RoundJudging ("playedCards" := Json.list (Json.list responseDecoder)) - "RoundEnd" -> Json.object1 RoundEnd ("finishedRound" := finishedRoundDecoder) + "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.object2 GameStart ("czar" := playerIdDecoder) ("call" := callDecoder) + "GameStart" -> Json.map2 GameStart (Json.field "czar" playerIdDecoder) (Json.field "call" callDecoder) "GameEnd" -> Json.succeed GameEnd - "ConfigChange" -> Json.object1 ConfigChange ("config" := configDecoder) + "ConfigChange" -> Json.map ConfigChange (Json.field "config" configDecoder) "RoundTimeLimitHit" -> Json.succeed RoundTimeLimitHit diff --git a/client/src/MassiveDecks/Models/JSON/Decode.elm b/client/src/MassiveDecks/Models/JSON/Decode.elm index c7fd8b3..51450cf 100644 --- a/client/src/MassiveDecks/Models/JSON/Decode.elm +++ b/client/src/MassiveDecks/Models/JSON/Decode.elm @@ -10,54 +10,54 @@ import MassiveDecks.Scenes.Playing.HouseRule.Id as HouseRule lobbyAndHandDecoder : Decoder Game.LobbyAndHand -lobbyAndHandDecoder = object2 Game.LobbyAndHand - ("lobby" := lobbyDecoder) - ("hand" := handDecoder) +lobbyAndHandDecoder = map2 Game.LobbyAndHand + (field "lobby" lobbyDecoder) + (field "hand" handDecoder) lobbyDecoder : Decoder Game.Lobby -lobbyDecoder = object5 Game.Lobby - ("gameCode" := string) - ("owner" := playerIdDecoder) - ("config" := configDecoder) - ("players" := (list playerDecoder)) - ("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 = object2 Game.GameCodeAndSecret - ("gameCode" := string) - ("secret" := playerSecretDecoder) +gameCodeAndSecretDecoder = map2 Game.GameCodeAndSecret + (field "gameCode" string) + (field "secret" playerSecretDecoder) deckInfoDecoder : Decoder Game.DeckInfo -deckInfoDecoder = object4 Game.DeckInfo - ("id" := string) - ("name" := string) - ("calls" := int) - ("responses" := int) +deckInfoDecoder = map4 Game.DeckInfo + (field "id" string) + (field "name" string) + (field "calls" int) + (field "responses" int) configDecoder : Decoder Game.Config -configDecoder = object3 Game.Config - ("decks" := (list deckInfoDecoder)) - ("houseRules" := (list houseRuleDecoder)) - (maybe ("password" := string)) +configDecoder = map3 Game.Config + (field "decks" (list deckInfoDecoder)) + (field "houseRules" (list houseRuleDecoder)) + (maybe (field "password" string)) handDecoder : Decoder Card.Hand -handDecoder = object1 Card.Hand - ("hand" := (list responseDecoder)) +handDecoder = map Card.Hand + (field "hand" (list responseDecoder)) playerDecoder : Decoder Player -playerDecoder = object6 Player - ("id" := playerIdDecoder) - ("name" := string) - ("status" := playerStatusDecoder) - ("score" := int) - ("disconnected" := bool) - ("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 @@ -66,77 +66,77 @@ playerStatusDecoder = customDecoder (string) (\name -> Player.nameToStatus name gameStateDecoder : Decoder Game.State gameStateDecoder = - ("gameState" := string) `andThen` (\gameState -> + (field "gameState" string |> andThen (\gameState -> case gameState of "configuring" -> succeed Game.Configuring "playing" -> - map Game.Playing ("round" := roundDecoder) + map Game.Playing (field "round" roundDecoder) "finished" -> succeed Game.Finished _ -> - fail ("Unknown game state '" ++ gameState ++ "'.")) + fail ("Unknown game state '" ++ gameState ++ "'."))) roundDecoder : Decoder Round -roundDecoder = object3 Round - ("czar" := playerIdDecoder) - ("call" := callDecoder) - ("state" := roundStateDecoder) +roundDecoder = map3 Round + (field "czar" playerIdDecoder) + (field "call" callDecoder) + (field "state" roundStateDecoder) roundStateDecoder : Decoder Round.State roundStateDecoder = - ("roundState" := string) `andThen` (\roundState -> + (field "roundState" string |> andThen (\roundState -> case roundState of "playing" -> - object2 Round.playing - ("numberPlayed" := int) - ("afterTimeLimit" := bool) + map2 Round.playing + (field "numberPlayed" int) + (field "afterTimeLimit" bool) "judging" -> - object2 Round.judging - ("cards" := list (list responseDecoder)) - ("afterTimeLimit" := bool) + map2 Round.judging + (field "cards" (list (list responseDecoder))) + (field "afterTimeLimit" bool) "finished" -> map Round.F finishedStateDecoder _ -> - fail ("Unknown round state '" ++ roundState ++ "'.")) + fail ("Unknown round state '" ++ roundState ++ "'."))) finishedStateDecoder : Decoder Round.Finished -finishedStateDecoder = object2 Round.Finished - ("cards" := list (list responseDecoder)) - ("playedByAndWinner" := playedByAndWinnerDecoder) +finishedStateDecoder = map2 Round.Finished + (field "cards" (list (list responseDecoder))) + (field "playedByAndWinner" playedByAndWinnerDecoder) finishedRoundDecoder : Decoder Round.FinishedRound -finishedRoundDecoder = object3 Round.FinishedRound - ("czar" := playerIdDecoder) - ("call" := callDecoder) - ("state" := finishedStateDecoder) +finishedRoundDecoder = map3 Round.FinishedRound + (field "czar" playerIdDecoder) + (field "call" callDecoder) + (field "state" finishedStateDecoder) playedByAndWinnerDecoder : Decoder Player.PlayedByAndWinner -playedByAndWinnerDecoder = object2 Player.PlayedByAndWinner - ("playedBy" := list (playerIdDecoder)) - ("winner" := playerIdDecoder) +playedByAndWinnerDecoder = map2 Player.PlayedByAndWinner + (field "playedBy" (list (playerIdDecoder))) + (field "winner" playerIdDecoder) callDecoder : Decoder Card.Call -callDecoder = object2 Card.Call - ("id" := string) - ("parts" := list string) +callDecoder = map2 Card.Call + (field "id" string) + (field "parts" (list string)) responseDecoder : Decoder Card.Response -responseDecoder = object2 Card.Response - ("id" := string) - ("text" := string) +responseDecoder = map2 Card.Response + (field "id" string) + (field "text" string) playerIdDecoder : Decoder Player.Id @@ -144,16 +144,26 @@ playerIdDecoder = int playerSecretDecoder : Decoder Player.Secret -playerSecretDecoder = object2 Player.Secret - ("id" := playerIdDecoder) - ("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 ++ "'.")) + ruleNameToId : String -> Maybe HouseRule.Id ruleNameToId name = 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 diff --git a/client/src/MassiveDecks/Scenes/Config.elm b/client/src/MassiveDecks/Scenes/Config.elm index 422f2bf..48d61b8 100644 --- a/client/src/MassiveDecks/Scenes/Config.elm +++ b/client/src/MassiveDecks/Scenes/Config.elm @@ -3,7 +3,6 @@ module MassiveDecks.Scenes.Config exposing (update, view, init, subscriptions) import String import Html exposing (Html) -import Html.App as Html import MassiveDecks.API as API import MassiveDecks.API.Request as Request @@ -75,16 +74,16 @@ update message lobbyModel = ({ model | deckIdInput = deckIdInput }, Cmd.map LocalMessage msg) AddAi -> - (model, Request.send' (API.newAi gameCode secret) ErrorMessage (\_ -> LocalMessage NoOp)) + (model, Request.send_ (API.newAi gameCode secret) ErrorMessage (\_ -> LocalMessage NoOp)) StartGame -> (model, Request.send (API.newGame gameCode secret) newGameErrorHandler ErrorMessage HandUpdate) EnableRule rule -> - (model, Request.send' (API.enableRule rule gameCode secret) ErrorMessage ignore) + (model, Request.send_ (API.enableRule rule gameCode secret) ErrorMessage ignore) DisableRule rule -> - (model, Request.send' (API.disableRule rule gameCode secret) ErrorMessage ignore) + (model, Request.send_ (API.disableRule rule gameCode secret) ErrorMessage ignore) NoOp -> (model, Cmd.none) diff --git a/client/src/MassiveDecks/Scenes/Config/UI.elm b/client/src/MassiveDecks/Scenes/Config/UI.elm index b4b6b76..5bfe96e 100644 --- a/client/src/MassiveDecks/Scenes/Config/UI.elm +++ b/client/src/MassiveDecks/Scenes/Config/UI.elm @@ -66,8 +66,7 @@ infoBar = , 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." ] @@ -189,8 +188,8 @@ houseRule canNotChangeConfig enabled rule = houseRuleTemplate : Bool -> String -> String -> String -> String -> String -> msg -> Html msg -houseRuleTemplate canNotChangeConfig id' title icon description buttonText message = - div [ id id', class "house-rule" ] +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 ] diff --git a/client/src/MassiveDecks/Scenes/History.elm b/client/src/MassiveDecks/Scenes/History.elm index ea70c2d..26c1cec 100644 --- a/client/src/MassiveDecks/Scenes/History.elm +++ b/client/src/MassiveDecks/Scenes/History.elm @@ -14,7 +14,7 @@ init : String -> (Model, Cmd ConsumerMessage) init gameCode = ( { rounds = Nothing } - , Request.send' (API.getHistory gameCode) ErrorMessage (LocalMessage << Load) + , Request.send_ (API.getHistory gameCode) ErrorMessage (LocalMessage << Load) ) diff --git a/client/src/MassiveDecks/Scenes/Lobby.elm b/client/src/MassiveDecks/Scenes/Lobby.elm index 3955b0b..d76eea2 100644 --- a/client/src/MassiveDecks/Scenes/Lobby.elm +++ b/client/src/MassiveDecks/Scenes/Lobby.elm @@ -361,16 +361,13 @@ updateLobbyAndHand lobbyAndHand model = notificationChange : Model -> Maybe Notification -> (Model, Cmd ConsumerMessage) notificationChange model notification = let - newNotification = Maybe.oneOf - [ notification - , model.notification - ] + 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 Util.impossible (LocalMessage << DismissNotification) dismiss + Task.perform (LocalMessage << DismissNotification) dismiss Nothing -> Cmd.none diff --git a/client/src/MassiveDecks/Scenes/Lobby/Sidebar.elm b/client/src/MassiveDecks/Scenes/Lobby/Sidebar.elm index 19f51fd..ca8d340 100644 --- a/client/src/MassiveDecks/Scenes/Lobby/Sidebar.elm +++ b/client/src/MassiveDecks/Scenes/Lobby/Sidebar.elm @@ -40,7 +40,7 @@ update : Message -> Model -> (Model, Cmd Message) update message model = case message of Toggle -> - (model, Task.perform Util.impossible Show Window.width) + (model, Task.perform Show Window.width) Show screenWidth -> if model.shownAsOverlay then diff --git a/client/src/MassiveDecks/Scenes/Lobby/UI.elm b/client/src/MassiveDecks/Scenes/Lobby/UI.elm index 8b55027..a36fc77 100644 --- a/client/src/MassiveDecks/Scenes/Lobby/UI.elm +++ b/client/src/MassiveDecks/Scenes/Lobby/UI.elm @@ -1,7 +1,6 @@ module MassiveDecks.Scenes.Lobby.UI exposing (view, inviteOverlay) import Html exposing (..) -import Html.App as Html import Html.Attributes exposing (..) import Html.Events exposing (..) diff --git a/client/src/MassiveDecks/Scenes/Playing.elm b/client/src/MassiveDecks/Scenes/Playing.elm index deaebb5..87e0082 100644 --- a/client/src/MassiveDecks/Scenes/Playing.elm +++ b/client/src/MassiveDecks/Scenes/Playing.elm @@ -4,7 +4,6 @@ import Random import String import Html exposing (..) -import Html.App as Html import AnimationFrame @@ -146,7 +145,7 @@ update message lobbyModel round = (model, Request.send (API.skip gameCode secret playerIds) skipErrorHandler ErrorMessage ignore) Back -> - (model, Request.send' (API.back gameCode secret) ErrorMessage ignore) + (model, Request.send_ (API.back gameCode secret) ErrorMessage ignore) LobbyAndHandUpdated -> lobbyAndHandUpdated lobbyModel round diff --git a/client/src/MassiveDecks/Scenes/Playing/UI.elm b/client/src/MassiveDecks/Scenes/Playing/UI.elm index 12c7bee..1030421 100644 --- a/client/src/MassiveDecks/Scenes/Playing/UI.elm +++ b/client/src/MassiveDecks/Scenes/Playing/UI.elm @@ -1,7 +1,6 @@ module MassiveDecks.Scenes.Playing.UI exposing (view) import Html exposing (..) -import Html.App as Html import Html.Attributes exposing (..) import Html.Events exposing (..) import Html.Keyed as Keyed @@ -112,7 +111,7 @@ roundContents lobbyModel round = callFill = case round.state of Round.P _ -> picked - Round.J judging -> Maybe.withDefault [] (model.considering `Maybe.andThen` (Util.get judging.responses)) + Round.J judging -> Maybe.withDefault [] (model.considering |> Maybe.andThen (Util.get judging.responses)) Round.F _ -> [] pickedOrChosen = case round.state of @@ -296,7 +295,7 @@ chooseButton playedId = infoBar : Game.Lobby -> Player.Secret -> List (Html Message) infoBar lobby secret = let - content = Maybe.oneOf [ statusInfo lobby.players secret.id, stateInfo lobby.game ] + content = statusInfo lobby.players secret.id |> Util.or (stateInfo lobby.game) in case content of Just message -> diff --git a/client/src/MassiveDecks/Scenes/Start.elm b/client/src/MassiveDecks/Scenes/Start.elm index e9b893f..ea0d419 100644 --- a/client/src/MassiveDecks/Scenes/Start.elm +++ b/client/src/MassiveDecks/Scenes/Start.elm @@ -3,11 +3,10 @@ module MassiveDecks.Scenes.Start exposing (update, urlUpdate, view, init, subscr import String import Html exposing (..) -import Html.App as Html import Navigation -import MassiveDecks.Models exposing (Init, Path) +import MassiveDecks.Models exposing (Init, Path, pathFromLocation) import MassiveDecks.Models.Game as Game import MassiveDecks.Components.Tabs as Tabs import MassiveDecks.Components.Storage as Storage @@ -27,9 +26,10 @@ import MassiveDecks.Util as Util {-| Create the initial model for the start screen. -} -init : Init -> Path -> (Model, Cmd Message) -init init path = +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 @@ -113,6 +113,9 @@ update message model = in ({ model | errors = newErrors }, Cmd.map ErrorMessage cmd) + PathChange path -> + urlUpdate path model + TabsMessage tabsMessage -> ({ model | tabs = (Tabs.update tabsMessage model.tabs) }, Cmd.none) @@ -137,7 +140,7 @@ update message model = CreateLobby -> ( { model | buttonsEnabled = False } - , Request.send' + , Request.send_ (API.createLobby model.nameInput.value) ErrorMessage (\gameCodeAndSecret -> StoreCredentialsAndMoveToLobby gameCodeAndSecret.gameCode gameCodeAndSecret.secret)) @@ -233,7 +236,7 @@ update message model = ([], model.storage) Just lobby -> - ( [ Request.send' (API.leave lobby.lobby.gameCode lobby.secret) ErrorMessage (\_ -> NoOp) + ( [ 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 diff --git a/client/src/MassiveDecks/Scenes/Start/Messages.elm b/client/src/MassiveDecks/Scenes/Start/Messages.elm index 1ddd9ec..236d19d 100644 --- a/client/src/MassiveDecks/Scenes/Start/Messages.elm +++ b/client/src/MassiveDecks/Scenes/Start/Messages.elm @@ -1,5 +1,6 @@ module MassiveDecks.Scenes.Start.Messages exposing (..) +import MassiveDecks.Models exposing (Path) import MassiveDecks.Components.Input as Input import MassiveDecks.Components.Errors as Errors import MassiveDecks.Components.Tabs as Tabs @@ -14,6 +15,7 @@ import MassiveDecks.Models.Player as Player -} type Message = SubmitCurrentTab + | PathChange Path | CreateLobby | SetButtonsEnabled Bool | JoinLobbyAsNewPlayer diff --git a/client/src/MassiveDecks/Util.elm b/client/src/MassiveDecks/Util.elm index d5a3d49..a930f41 100644 --- a/client/src/MassiveDecks/Util.elm +++ b/client/src/MassiveDecks/Util.elm @@ -20,8 +20,14 @@ impossible n = impossible n {-| Add an item to a list if the value is not nothing. -} -andMaybe : List a -> Maybe a -> List a -andMaybe values maybeExtra = List.append values (Maybe.map (\value -> [ value ]) maybeExtra |> Maybe.withDefault []) +andMaybe : Maybe a -> List a -> List a +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 {-| Give the first value from the list that matches the given condition. If none do, return `Nothing`. @@ -58,7 +64,7 @@ lobbyUrl url lobbyId = url ++ "#" ++ lobbyId {-| Create a command that just sends the given message instantly. -} cmd : msg -> Cmd msg -cmd message = Task.succeed message |> Task.perform identity (\_ -> message) +cmd message = Task.perform identity (Task.succeed message) {-| Chains two updates together to produce a single update. @@ -135,7 +141,7 @@ apply fs value = List.map (\f -> f value) fs -} 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. -} diff --git a/elm-package.json b/elm-package.json index d38c961..06c30cf 100644 --- a/elm-package.json +++ b/elm-package.json @@ -8,13 +8,13 @@ ], "exposed-modules": [], "dependencies": { - "elm-lang/animation-frame": "1.0.0 <= v < 2.0.0", - "elm-lang/core": "4.0.1 <= v < 5.0.0", - "elm-lang/html": "1.1.0 <= v < 2.0.0", - "elm-lang/navigation": "1.0.0 <= v < 2.0.0", - "elm-lang/websocket": "1.0.1 <= v < 2.0.0", - "elm-lang/window": "1.0.0 <= v < 2.0.0", - "evancz/elm-http": "3.0.1 <= v < 4.0.0" + "elm-lang/animation-frame": "1.0.1 <= v < 2.0.0", + "elm-lang/core": "5.1.1 <= v < 6.0.0", + "elm-lang/html": "2.0.0 <= v < 3.0.0", + "elm-lang/http": "1.0.0 <= v < 2.0.0", + "elm-lang/navigation": "2.1.0 <= v < 3.0.0", + "elm-lang/websocket": "1.0.2 <= v < 2.0.0", + "elm-lang/window": "1.0.1 <= v < 2.0.0" }, - "elm-version": "0.17.0 <= v < 0.18.0" -} \ No newline at end of file + "elm-version": "0.18.0 <= v < 0.19.0" +}