diff --git a/src/Client/Areas/Gameweek/GameweekArea.fs b/src/Client/Areas/Gameweek/GameweekArea.fs index 7fa7140..4f238c8 100644 --- a/src/Client/Areas/Gameweek/GameweekArea.fs +++ b/src/Client/Areas/Gameweek/GameweekArea.fs @@ -30,10 +30,10 @@ module GameweekArea = match message, model with | InitMsg _, InitModel -> InitModel, [] | GetEarliestOpenGwno (Ok (GameweekNo gwno)), InitModel -> - let m, cmd = GameweekFixtures.init api p (GameweekNo gwno) + let m, cmd = GameweekFixtures.init api p (GameweekNo gwno) None GameweekFixturesModel m, Cmd.batch - [ GameweekRoute(GameweekFixturesRoute gwno) |> Routes.pushTo + [ GameweekRoute(GameweekFixturesRoute gwno) |> Routes.replaceUrl Cmd.map GameweekFixturesMsg cmd ] | GameweekFixturesMsg msg, GameweekFixturesModel m -> @@ -46,7 +46,9 @@ module GameweekArea = let urlUpdate api p = function | GameweekInitRoute -> init api p | GameweekFixturesRoute gwno -> - GameweekFixtures.init api p (GameweekNo gwno) |> fun (m, cmd) -> GameweekFixturesModel m, Cmd.map GameweekFixturesMsg cmd + GameweekFixtures.init api p (GameweekNo gwno) None |> fun (m, cmd) -> GameweekFixturesModel m, Cmd.map GameweekFixturesMsg cmd + | GameweekFixtureRoute (gwno, ToGuid fId) -> + GameweekFixtures.init api p (GameweekNo gwno) (Some (FixtureId(fId))) |> fun (m, cmd) -> GameweekFixturesModel m, Cmd.map GameweekFixturesMsg cmd | AddGameweekRoute -> AddGameweek.init api p |> fun (m, cmd) -> AddGameweekModel m, Cmd.map AddGameweekMsg cmd diff --git a/src/Client/Areas/Gameweek/GameweekFixtures.fs b/src/Client/Areas/Gameweek/GameweekFixtures.fs index e0e4412..0b35938 100644 --- a/src/Client/Areas/Gameweek/GameweekFixtures.fs +++ b/src/Client/Areas/Gameweek/GameweekFixtures.fs @@ -32,8 +32,8 @@ module GameweekFixtures = | Noop | GameweekFixturesReceived of Rresult | LeaguesReceived of Rresult - | ShowModal of FixtureId - | HideModal + | ShowModal of GameweekNo * FixtureId + | HideModal of GameweekNo | NavTo of Route | Prediction of FixtureId * PredictionAction | PredictionAccepted of Rresult @@ -47,11 +47,14 @@ module GameweekFixtures = | SetBigUpResponse of Rresult | ShareGameweek of GameweekFixturesViewModel - let init api p gwno = + let init api p gwno fixtureId = { GameweekFixtures = Fetching Player = p LeagueList = Fetching - ModalState = ModalClosed }, + ModalState = + match fixtureId with + | Some fId -> ModalOpen fId + | _ -> ModalClosed }, Cmd.batch [ Cmd.OfAsync.either (api.getGameweekFixtures p.Token) gwno GameweekFixturesReceived (Error >> Init) Cmd.OfAsync.either api.getPlayerLeagues p.Token LeaguesReceived (Error >> Init) ] @@ -80,7 +83,7 @@ module GameweekFixtures = Components.GameweekItemTitle.element (fp.KickOff, tl) div [ Class $"gw-item-space {inplayClass}" ] [] div [ Class "gw-item-body" - OnClick(fun _ -> dispatch (ShowModal fp.Id)) ] [ + OnClick(fun _ -> dispatch (ShowModal(fp.GameweekNo, fp.Id))) ] [ div [ Class $"gw-item-prediction {Components.predictionModifierClass fp.Prediction}" ] [ div [ Class "gw-item-badges" ] [ largeTeamBadge h @@ -364,7 +367,7 @@ module GameweekFixtures = >> function | Some (fp: FixturePredictionViewModel) -> Button.button [ Button.Color IsLight - Button.Props [ OnClick(fun _ -> dispatch (ShowModal fp.Id)) ] ] [ + Button.Props [ OnClick(fun _ -> dispatch (ShowModal(fp.GameweekNo, fp.Id))) ] ] [ Fa.i [ icon ] [] ] | None -> @@ -414,7 +417,7 @@ module GameweekFixtures = str fp.KickOff.DateAndShortMonth ] div [ Class "gw-fixture-modal-close" - OnClick(fun _ -> dispatch HideModal) ] [ + OnClick(fun _ -> dispatch (HideModal fp.GameweekNo)) ] [ Fa.i [ Fa.Solid.TimesCircle ] [] ] ] @@ -523,7 +526,7 @@ module GameweekFixtures = |> div [ Class "formguide" ] Modal.modal [ Modal.IsActive true ] [ - Modal.background [ Props [ OnClick(fun _ -> dispatch HideModal) ] ] [] + Modal.background [ Props [ OnClick(fun _ -> dispatch (HideModal fp.GameweekNo)) ] ] [] Modal.Card.card [] [ Modal.Card.body [ Props [ Id "fixture-modal-card" ] ] [ div [ Class "gw-fixture-modal-container" ] [ @@ -622,7 +625,7 @@ module GameweekFixtures = gwfs.Fixtures |> Map.toList - |> List.sortBy (snd >> fun p -> p.KickOff.KickOff) + |> List.sortBy (snd >> fun p -> p.SortOrder) |> List.map ( snd >> fun { TeamLine = TeamLine (hometeam, awayteam) @@ -716,107 +719,117 @@ module GameweekFixtures = InProgress = false }) let update api player msg model : Model * Cmd = - (match msg with - | Init _ -> model, [] - | GameweekFixturesReceived r -> { model with GameweekFixtures = resultToWebData r }, [] - | ShowModal fId -> - let m = - updateSingleModelGwf model fId (fun fixture -> - { fixture with - BigUpState = - if fixture.BigUpState = BigUpState.Expanded then - BigUpState.Available - else - fixture.BigUpState }) - - { m with ModalState = ModalOpen fId }, - Cmd.batch [ Cmd.OfFunc.perform Html.clip () (fun _ -> Noop) - Cmd.OfFunc.perform Html.resetScrollTop "fixture-modal-card" (fun _ -> Noop) - Cmd.OfFunc.perform Html.resetScrollLeft "modal-big-ups" (fun _ -> Noop) ] - - | HideModal -> { model with ModalState = ModalClosed }, Cmd.OfFunc.perform Html.unClip () (fun _ -> Noop) - | Noop -> model, [] - | NavTo r -> - model, - Cmd.batch [ Routes.navTo r - Cmd.OfFunc.perform Html.unClip () (fun _ -> Noop) ] - - | Prediction (fId, action) -> - updateSingleModelGwf model fId (fun fixture -> { fixture with InProgress = true }), - Cmd.OfAsync.perform (api.prediction player.Token) action PredictionAccepted - - | PredictionAccepted result -> - match result with - | Ok (PredictionAction.SetScoreline (_, fId, sl)) -> updatePredictionInModel model fId (fun (_, m) -> sl, m), [] - | Ok (PredictionAction.IncrementScore (_, fId, Home)) -> - updatePredictionInModel model fId (fun (ScoreLine (Score h, a), m) -> ScoreLine(h + 1 |> Score, a), m), [] - | Ok (PredictionAction.DecrementScore (_, fId, Home)) -> - updatePredictionInModel model fId (fun (ScoreLine (Score h, a), m) -> ScoreLine(h - 1 |> Score, a), m), [] - | Ok (PredictionAction.IncrementScore (_, fId, Away)) -> - updatePredictionInModel model fId (fun (ScoreLine (h, Score a), m) -> ScoreLine(h, a + 1 |> Score), m), [] - | Ok (PredictionAction.DecrementScore (_, fId, Away)) -> - updatePredictionInModel model fId (fun (ScoreLine (h, Score a), m) -> ScoreLine(h, a - 1 |> Score), m), [] - | Error e -> updateAllModelGwf model (fun f -> { f with InProgress = false }), alert e - - - | SetDoubleDown (fsId, fId) -> - updateSingleModelGwf model fId (fun fixture -> { fixture with InProgress = true }), - Cmd.OfAsync.perform (api.doubleDown player.Token) (fsId, fId) SetDoubleDownResponse - | SetDoubleDownResponse r -> - match r with - | Ok (_, fId) -> - let m = removeDoubleDownFromAllPredictions model - updatePredictionInModel m fId (fun (sl, _) -> sl, PredictionModifier.DoubleDown), infoAlert "Double Down set" - | Error e -> model, alert e - | RemoveDoubleDown fsId -> - updateAllModelGwf model (fun fixture -> { fixture with InProgress = true }), - Cmd.OfAsync.perform (api.removeDoubleDown player.Token) fsId RemoveDoubleDownResponse - | RemoveDoubleDownResponse r -> - match r with - | Ok _ -> removeDoubleDownFromAllPredictions model, infoAlert "Double Down removed" - | Error e -> model, alert e - - | ExpandBigUp fId -> - updateSingleModelGwf model fId (fun fixture -> { fixture with BigUpState = BigUpState.Expanded }), [] - | CollapseBigUp fId -> - updateSingleModelGwf model fId (fun fixture -> { fixture with BigUpState = BigUpState.Available }), [] - | SetBigUp (fsId, fId) -> - updateSingleModelGwf model fId (fun fixture -> { fixture with InProgress = true }), - Cmd.OfAsync.perform (api.bigUp player.Token) (fsId, fId) SetBigUpResponse - | SetBigUpResponse r -> - match r with - | Ok (_, fId) -> - let m = - updateAllModelGwf model (fun f -> - { f with - BigUpState = BigUpState.Unavailable - InProgress = false }) - - let m = - updateSingleModelGwf m fId (fun fixture -> - { fixture with - BigUpState = BigUpState.Set - FixtureDetails = - (fixture.FixtureDetails, fixture.Prediction) - ||> Option.map2 (fun fd (sl, _) -> - { fd with - BigUps = - { PlayerName = PlayerName player.Name - PlayerId = player.Id - TeamLine = fixture.TeamLine - ScoreLine = sl } - :: fd.BigUps }) - Prediction = - fixture.Prediction - |> Option.map (fun (sl, _) -> sl, PredictionModifier.BigUp) }) - - m, infoAlert "Big Up!" - | Error e -> model, alert e - | ShareGameweek gwfs -> - // Browser.Dom.console.log (buildShareGameweekString gwfs) - let shareData = Sharing.ShareData("", buildShareGameweekString gwfs, "") - model, Cmd.OfPromise.perform Sharing.share shareData (fun _ -> Noop) - | LeaguesReceived r -> { model with LeagueList = resultToWebData r }, []) + match msg with + | Init _ -> model, [] + | GameweekFixturesReceived r -> { model with GameweekFixtures = resultToWebData r }, [] + | ShowModal (GameweekNo gwno, (FixtureId fixtureIdGuid as fId)) -> + let m = + updateSingleModelGwf model fId (fun fixture -> + { fixture with + BigUpState = + if fixture.BigUpState = BigUpState.Expanded then + BigUpState.Available + else + fixture.BigUpState }) + + let routeCmd = + match model.ModalState with + | ModalClosed -> fun r -> Cmd.OfFunc.perform Routes.pushState r (fun _ -> Noop) + | ModalOpen _ -> Routes.replaceUrl + + { m with ModalState = ModalOpen fId }, + Cmd.batch [ Cmd.OfFunc.perform Html.clip () (fun _ -> Noop) + Cmd.OfFunc.perform Html.resetScrollTop "fixture-modal-card" (fun _ -> Noop) + Cmd.OfFunc.perform Html.resetScrollLeft "modal-big-ups" (fun _ -> Noop) + routeCmd (GameweekRoute(GameweekFixtureRoute(gwno, string fixtureIdGuid))) ] + + | HideModal (GameweekNo gwno) -> + { model with ModalState = ModalClosed }, + Cmd.batch [ Cmd.OfFunc.perform Html.unClip () (fun _ -> Noop) + Cmd.OfFunc.perform Routes.pushState (GameweekRoute(GameweekFixturesRoute gwno)) (fun _ -> Noop) ] + | Noop -> model, [] + | NavTo r -> + model, + Cmd.batch [ Routes.navTo r + Cmd.OfFunc.perform Html.unClip () (fun _ -> Noop) ] + + | Prediction (fId, action) -> + updateSingleModelGwf model fId (fun fixture -> { fixture with InProgress = true }), + Cmd.OfAsync.perform (api.prediction player.Token) action PredictionAccepted + + | PredictionAccepted result -> + match result with + | Ok (PredictionAction.SetScoreline (_, fId, sl)) -> updatePredictionInModel model fId (fun (_, m) -> sl, m), [] + | Ok (PredictionAction.IncrementScore (_, fId, Home)) -> + updatePredictionInModel model fId (fun (ScoreLine (Score h, a), m) -> ScoreLine(h + 1 |> Score, a), m), [] + | Ok (PredictionAction.DecrementScore (_, fId, Home)) -> + updatePredictionInModel model fId (fun (ScoreLine (Score h, a), m) -> ScoreLine(h - 1 |> Score, a), m), [] + | Ok (PredictionAction.IncrementScore (_, fId, Away)) -> + updatePredictionInModel model fId (fun (ScoreLine (h, Score a), m) -> ScoreLine(h, a + 1 |> Score), m), [] + | Ok (PredictionAction.DecrementScore (_, fId, Away)) -> + updatePredictionInModel model fId (fun (ScoreLine (h, Score a), m) -> ScoreLine(h, a - 1 |> Score), m), [] + | Error e -> updateAllModelGwf model (fun f -> { f with InProgress = false }), alert e + + + | SetDoubleDown (fsId, fId) -> + updateSingleModelGwf model fId (fun fixture -> { fixture with InProgress = true }), + Cmd.OfAsync.perform (api.doubleDown player.Token) (fsId, fId) SetDoubleDownResponse + | SetDoubleDownResponse r -> + match r with + | Ok (_, fId) -> + let m = removeDoubleDownFromAllPredictions model + updatePredictionInModel m fId (fun (sl, _) -> sl, PredictionModifier.DoubleDown), infoAlert "Double Down set" + | Error e -> model, alert e + | RemoveDoubleDown fsId -> + updateAllModelGwf model (fun fixture -> { fixture with InProgress = true }), + Cmd.OfAsync.perform (api.removeDoubleDown player.Token) fsId RemoveDoubleDownResponse + | RemoveDoubleDownResponse r -> + match r with + | Ok _ -> removeDoubleDownFromAllPredictions model, infoAlert "Double Down removed" + | Error e -> model, alert e + + | ExpandBigUp fId -> + updateSingleModelGwf model fId (fun fixture -> { fixture with BigUpState = BigUpState.Expanded }), [] + | CollapseBigUp fId -> + updateSingleModelGwf model fId (fun fixture -> { fixture with BigUpState = BigUpState.Available }), [] + | SetBigUp (fsId, fId) -> + updateSingleModelGwf model fId (fun fixture -> { fixture with InProgress = true }), + Cmd.OfAsync.perform (api.bigUp player.Token) (fsId, fId) SetBigUpResponse + | SetBigUpResponse r -> + match r with + | Ok (_, fId) -> + let m = + updateAllModelGwf model (fun f -> + { f with + BigUpState = BigUpState.Unavailable + InProgress = false }) + + let m = + updateSingleModelGwf m fId (fun fixture -> + { fixture with + BigUpState = BigUpState.Set + FixtureDetails = + (fixture.FixtureDetails, fixture.Prediction) + ||> Option.map2 (fun fd (sl, _) -> + { fd with + BigUps = + { PlayerName = PlayerName player.Name + PlayerId = player.Id + TeamLine = fixture.TeamLine + ScoreLine = sl } + :: fd.BigUps }) + Prediction = + fixture.Prediction + |> Option.map (fun (sl, _) -> sl, PredictionModifier.BigUp) }) + + m, infoAlert "Big Up!" + | Error e -> model, alert e + | ShareGameweek gwfs -> + // Browser.Dom.console.log (buildShareGameweekString gwfs) + let shareData = Sharing.ShareData("", buildShareGameweekString gwfs, "") + model, Cmd.OfPromise.perform Sharing.share shareData (fun _ -> Noop) + | LeaguesReceived r -> { model with LeagueList = resultToWebData r }, [] + // |> (fun (({ GameweekFixtures = gwfs }, _) as r) -> // match gwfs with diff --git a/src/Client/Routes.fs b/src/Client/Routes.fs index 1803c73..7e516cc 100644 --- a/src/Client/Routes.fs +++ b/src/Client/Routes.fs @@ -15,6 +15,7 @@ type Route = and GameweekRoute = | GameweekInitRoute | GameweekFixturesRoute of int + | GameweekFixtureRoute of int * string | AddGameweekRoute and LeaguesRoute = | PlayerLeaguesRoute @@ -42,6 +43,7 @@ let howItWorksPath = "how-it-works" let contactPath = "get-in-touch" let gwPath = "gameweek" let gwFixturesPath = sprintf "gameweek/%i" +let gwFixturePath = sprintf "gameweek/%i/%s" let addGameweekPath = "gameweek/add" let leaguesPath = "leagues" let globalleaguePath = "leagues/global" @@ -73,6 +75,7 @@ let route : Parser Route, _> = map (GameweekInitRoute |> GameweekRoute) (s gwPath) map (AddGameweekRoute |> GameweekRoute) (s gwPath s "add") map (GameweekFixturesRoute >> GameweekRoute) (s gwPath i32) + map (curry2 (GameweekFixtureRoute >> GameweekRoute)) (s gwPath i32 str) map (PlayerLeaguesRoute |> LeaguesRoute) (s leaguesPath) map (GlobalLeagueRoute |> LeaguesRoute) (s leaguesPath s "global") map (CreateLeagueRoute |> LeaguesRoute) (s leaguesPath s "create") @@ -99,9 +102,10 @@ let private routeToPath = function | ContactRoute -> contactPath | GameweekRoute r -> match r with - | GameweekInitRoute -> gwPath - | GameweekFixturesRoute gw -> gwFixturesPath gw - | AddGameweekRoute -> addGameweekPath + | GameweekInitRoute -> gwPath + | GameweekFixturesRoute gw -> gwFixturesPath gw + | GameweekFixtureRoute (gw, fId) -> gwFixturePath gw fId + | AddGameweekRoute -> addGameweekPath | LeaguesRoute r -> match r with | PlayerLeaguesRoute -> leaguesPath @@ -123,22 +127,30 @@ let private routeToPath = function | PlayerRoute playerId -> playerPath playerId | PlayerGameweekRoute (pId, gwno) -> playerGameweekPath pId gwno -let navTo r = - (routeToPath >> sprintf "/%s" >> Navigation.newUrl) r +let href = + routeToPath >> sprintf "/%s" >> Fable.React.Props.HTMLAttr.Href -open Fable.React +open Fable.Core -let href = - routeToPath >> sprintf "/%s" >> Props.HTMLAttr.Href +let (|RouteAsString|) = routeToPath >> sprintf "/%s" + +/// evaluate url and add to history +let navTo (RouteAsString r) = Navigation.newUrl r + +[] +let private pushStateInner (r:'t): Unit = jsNative + +/// do not evaluate url but do add to history +let pushState (RouteAsString r) = pushStateInner r + +/// do not evaluate url and do overwrite latest history item +let replaceUrl (RouteAsString r) = Navigation.modifyUrl r -let pushTo r = - (routeToPath >> sprintf "/%s" >> Navigation.modifyUrl) r +let isValidGuid (g:string) = System.Guid.TryParse g |> fst -let isValidGuid (g:string) = - System.Guid.TryParse g |> fst +let toGuid (g:string) = System.Guid.Parse g -let toGuid (g:string) = - System.Guid.Parse g +let (|ToGuid|) = toGuid open Shared