Skip to content

Commit

Permalink
Add browser nav to fixture modal
Browse files Browse the repository at this point in the history
  • Loading branch information
@blair55
blair55 committed Aug 4, 2022
1 parent f57a61c commit dc6d7fc
Show file tree
Hide file tree
Showing 3 changed files with 154 additions and 127 deletions.
8 changes: 5 additions & 3 deletions src/Client/Areas/Gameweek/GameweekArea.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand All @@ -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

Expand Down
233 changes: 123 additions & 110 deletions src/Client/Areas/Gameweek/GameweekFixtures.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,8 +32,8 @@ module GameweekFixtures =
| Noop
| GameweekFixturesReceived of Rresult<GameweekFixturesViewModel>
| LeaguesReceived of Rresult<LeagueList>
| ShowModal of FixtureId
| HideModal
| ShowModal of GameweekNo * FixtureId
| HideModal of GameweekNo
| NavTo of Route
| Prediction of FixtureId * PredictionAction
| PredictionAccepted of Rresult<PredictionAction>
Expand All @@ -47,11 +47,14 @@ module GameweekFixtures =
| SetBigUpResponse of Rresult<FixtureSetId * FixtureId>
| 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) ]

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 ->
Expand Down Expand Up @@ -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 ] []
]
]
Expand Down Expand Up @@ -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" ] [
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -716,107 +719,117 @@ module GameweekFixtures =
InProgress = false })

let update api player msg model : Model * Cmd<Msg> =
(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
Expand Down
40 changes: 26 additions & 14 deletions src/Client/Routes.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ type Route =
and GameweekRoute =
| GameweekInitRoute
| GameweekFixturesRoute of int
| GameweekFixtureRoute of int * string
| AddGameweekRoute
and LeaguesRoute =
| PlayerLeaguesRoute
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -73,6 +75,7 @@ let route : Parser<Route -> 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")
Expand All @@ -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
Expand All @@ -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

[<Emit("window.history.pushState({}, '', $0)")>]
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

Expand Down

0 comments on commit dc6d7fc

Please sign in to comment.