diff --git a/generator/src/RouteBuilder.elm b/generator/src/RouteBuilder.elm index 16265b63..5d9bbe76 100644 --- a/generator/src/RouteBuilder.elm +++ b/generator/src/RouteBuilder.elm @@ -144,6 +144,7 @@ type alias StaticPayload data action routeParams = { fields : List ( String, String ), headers : List ( String, String ) } -> Pages.Fetcher.Fetcher (Result Http.Error action) , transition : Maybe Pages.Transition.Transition + , fetchers : List Pages.Transition.FetcherState } diff --git a/generator/src/generate-template-module-connector.js b/generator/src/generate-template-module-connector.js index 7acdde34..c80d946d 100644 --- a/generator/src/generate-template-module-connector.js +++ b/generator/src/generate-template-module-connector.js @@ -159,7 +159,8 @@ type ActionData view : - Maybe Pages.Transition.Transition + List Pages.Transition.FetcherState + -> Maybe Pages.Transition.Transition -> { path : Path , route : Maybe Route } @@ -171,7 +172,7 @@ view : { view : Model -> { title : String, body : Html (Pages.Msg.Msg Msg) } , head : List Head.Tag } -view transition page maybePageUrl globalData pageData actionData = +view fetchers transition page maybePageUrl globalData pageData actionData = case ( page.route, pageData ) of ( _, DataErrorPage____ data ) -> { view = @@ -232,6 +233,7 @@ view transition page maybePageUrl globalData pageData actionData = name )}.w3_decode_ActionData , transition = transition + , fetchers = fetchers } |> View.map (Pages.Msg.map Msg${pathNormalizedName( name @@ -253,6 +255,7 @@ view transition page maybePageUrl globalData pageData actionData = name )}.w3_decode_ActionData , transition = Nothing -- TODO is this safe? + , fetchers = [] -- TODO is this safe? } ` } @@ -333,6 +336,7 @@ init currentGlobalModel userFlags sharedData pageData actionData navigationKey m name )}.w3_decode_ActionData , transition = Nothing -- TODO is this safe, will this always be Nothing? + , fetchers = [] } |> Tuple.mapBoth Model${pathNormalizedName( name @@ -363,8 +367,8 @@ init currentGlobalModel userFlags sharedData pageData actionData navigationKey m -update : Maybe Pages.Transition.Transition -> Shared.Data -> PageData -> Maybe Browser.Navigation.Key -> Msg -> Model -> ( Model, Effect Msg ) -update transition sharedData pageData navigationKey msg model = +update : List Pages.Transition.FetcherState -> Maybe Pages.Transition.Transition -> Shared.Data -> PageData -> Maybe Browser.Navigation.Key -> Msg -> Model -> ( Model, Effect Msg ) +update fetchers transition sharedData pageData navigationKey msg model = case msg of MsgErrorPage____ msg_ -> let @@ -475,6 +479,7 @@ update transition sharedData pageData navigationKey msg model = name )}.w3_decode_ActionData , transition = transition + , fetchers = fetchers } msg_ pageModel diff --git a/src/Pages/Internal/Platform.elm b/src/Pages/Internal/Platform.elm index caacb6cb..4b004941 100644 --- a/src/Pages/Internal/Platform.elm +++ b/src/Pages/Internal/Platform.elm @@ -73,7 +73,8 @@ mainView config model = currentUrl = model.url in - (config.view (model.transition |> Maybe.map Tuple.second) + (config.view (model.inFlightFetchers |> Dict.values) + (model.transition |> Maybe.map Tuple.second) { path = ContentCache.pathForUrl urls |> Path.join , route = config.urlToRoute { currentUrl | path = model.currentPath } } @@ -323,7 +324,7 @@ type alias Model userModel pageData actionData sharedData = , userFlags : Decode.Value , transition : Maybe ( Int, Pages.Transition.Transition ) , nextTransitionKey : Int - , inFlightFetchers : Dict Int FormDecoder.FormData + , inFlightFetchers : Dict Int Pages.Transition.FetcherState } @@ -387,7 +388,18 @@ update config appMsg model = FetcherComplete fetcherId userMsgResult -> case userMsgResult of Ok userMsg -> - ( { model | inFlightFetchers = model.inFlightFetchers |> Dict.remove fetcherId }, NoEffect ) + ( { model + | inFlightFetchers = + model.inFlightFetchers + |> Dict.update fetcherId + (Maybe.map + (\fetcherState -> + { fetcherState | status = Pages.Transition.FetcherReloading } + ) + ) + } + , NoEffect + ) |> performUserMsg userMsg config |> startNewGetLoad (currentUrlWithPath model.url.path model) (UpdateCacheAndUrlNew False model.url Nothing) @@ -424,6 +436,7 @@ update config appMsg model = ) UpdateCacheAndUrlNew fromLinkClick urlWithoutRedirectResolution maybeUserMsg updateResult -> + -- TODO remove all fetchers that are in the state `FetcherReloading` here -- I think that's the right logic? case Result.map2 Tuple.pair (updateResult @@ -465,7 +478,8 @@ update config appMsg model = -- TODO if urlWithoutRedirectResolution is different from the url with redirect resolution, then -- instead of calling update, call pushUrl (I think?) -- TODO include user Cmd - config.update (model.transition |> Maybe.map Tuple.second) + config.update (model.inFlightFetchers |> Dict.values) + (model.transition |> Maybe.map Tuple.second) newSharedData newPageData model.key @@ -488,6 +502,7 @@ update config appMsg model = , pageData = Ok updatedPageData , transition = Nothing } + |> clearLoadingFetchers onActionMsg : Maybe userMsg onActionMsg = @@ -591,7 +606,8 @@ update config appMsg model = | nextTransitionKey = model.nextTransitionKey + 1 , inFlightFetchers = model.inFlightFetchers - |> Dict.insert model.nextTransitionKey fetcherData + |> Dict.insert model.nextTransitionKey + { payload = fetcherData, status = Pages.Transition.FetcherSubmitting } } , NoEffect ) @@ -607,7 +623,7 @@ performUserMsg userMsg config ( model, effect ) = Ok pageData -> let ( userModel, userCmd ) = - config.update (model.transition |> Maybe.map Tuple.second) pageData.sharedData pageData.pageData model.key userMsg pageData.userModel + config.update (model.inFlightFetchers |> Dict.values) (model.transition |> Maybe.map Tuple.second) pageData.sharedData pageData.pageData model.key userMsg pageData.userModel updatedPageData : Result error { userModel : userModel, pageData : pageData, actionData : Maybe actionData, sharedData : sharedData } updatedPageData = @@ -837,7 +853,7 @@ withUserMsg config userMsg ( model, effect ) = Ok pageData -> let ( userModel, userCmd ) = - config.update (model.transition |> Maybe.map Tuple.second) pageData.sharedData pageData.pageData model.key userMsg pageData.userModel + config.update (model.inFlightFetchers |> Dict.values) (model.transition |> Maybe.map Tuple.second) pageData.sharedData pageData.pageData model.key userMsg pageData.userModel updatedPageData : Result error { userModel : userModel, pageData : pageData, actionData : Maybe actionData, sharedData : sharedData } updatedPageData = @@ -1029,6 +1045,15 @@ startNewGetLoad urlToGet toMsg ( model, effect ) = ) +clearLoadingFetchers : Model userModel pageData actionData sharedData -> Model userModel pageData actionData sharedData +clearLoadingFetchers model = + { model + | inFlightFetchers = + model.inFlightFetchers + |> Dict.filter (\_ fetcherState -> fetcherState.status /= Pages.Transition.FetcherReloading) + } + + currentUrlWithPath : String -> Model userModel pageData actionData sharedData -> Url currentUrlWithPath path { url } = { url | path = path } diff --git a/src/Pages/Internal/Platform/Cli.elm b/src/Pages/Internal/Platform/Cli.elm index 2c81946b..ea98aecf 100644 --- a/src/Pages/Internal/Platform/Cli.elm +++ b/src/Pages/Internal/Platform/Cli.elm @@ -841,10 +841,10 @@ sendSinglePageProgress site contentJson config model info = viewValue : { title : String, body : Html (Pages.Msg.Msg userMsg) } viewValue = - (config.view Nothing currentPage Nothing sharedData pageData maybeActionData |> .view) pageModel + (config.view [] Nothing currentPage Nothing sharedData pageData maybeActionData |> .view) pageModel in PageServerResponse.RenderPage responseInfo - { head = config.view Nothing currentPage Nothing sharedData pageData maybeActionData |> .head + { head = config.view [] Nothing currentPage Nothing sharedData pageData maybeActionData |> .head , view = viewValue.body |> HtmlPrinter.htmlToString , title = viewValue.title } @@ -884,13 +884,13 @@ sendSinglePageProgress site contentJson config model info = viewValue : { title : String, body : Html (Pages.Msg.Msg userMsg) } viewValue = - (config.view Nothing currentPage Nothing sharedData pageData Nothing |> .view) pageModel + (config.view [] Nothing currentPage Nothing sharedData pageData Nothing |> .view) pageModel in PageServerResponse.RenderPage { statusCode = config.errorStatusCode error , headers = record.headers } - { head = config.view Nothing currentPage Nothing sharedData pageData Nothing |> .head + { head = config.view [] Nothing currentPage Nothing sharedData pageData Nothing |> .head , view = viewValue.body |> HtmlPrinter.htmlToString , title = viewValue.title } @@ -1154,7 +1154,8 @@ render404Page config sharedData model path notFoundReason = viewValue : { title : String, body : Html (Pages.Msg.Msg userMsg) } viewValue = - (config.view Nothing + (config.view [] + Nothing pathAndRoute Nothing justSharedData @@ -1168,7 +1169,7 @@ render404Page config sharedData model path notFoundReason = , contentJson = Dict.empty , html = viewValue.body |> HtmlPrinter.htmlToString , errors = [] - , head = config.view Nothing pathAndRoute Nothing justSharedData pageData Nothing |> .head + , head = config.view [] Nothing pathAndRoute Nothing justSharedData pageData Nothing |> .head , title = viewValue.title , staticHttpCache = Dict.empty , is404 = True diff --git a/src/Pages/ProgramConfig.elm b/src/Pages/ProgramConfig.elm index 5e8fe7db..06fa6d73 100644 --- a/src/Pages/ProgramConfig.elm +++ b/src/Pages/ProgramConfig.elm @@ -45,14 +45,15 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData , pageUrl : Maybe PageUrl } -> ( userModel, effect ) - , update : Maybe Pages.Transition.Transition -> sharedData -> pageData -> Maybe Browser.Navigation.Key -> userMsg -> userModel -> ( userModel, effect ) + , update : List Pages.Transition.FetcherState -> Maybe Pages.Transition.Transition -> sharedData -> pageData -> Maybe Browser.Navigation.Key -> userMsg -> userModel -> ( userModel, effect ) , subscriptions : route -> Path -> userModel -> Sub userMsg , sharedData : DataSource sharedData , data : route -> DataSource (PageServerResponse pageData errorPage) , action : route -> DataSource (PageServerResponse actionData errorPage) , onActionData : actionData -> Maybe userMsg , view : - Maybe Pages.Transition.Transition + List Pages.Transition.FetcherState + -> Maybe Pages.Transition.Transition -> { path : Path , route : route diff --git a/src/Pages/Transition.elm b/src/Pages/Transition.elm index 12e76dd0..a44580f3 100644 --- a/src/Pages/Transition.elm +++ b/src/Pages/Transition.elm @@ -1,9 +1,18 @@ -module Pages.Transition exposing (Transition(..), LoadingState(..)) +module Pages.Transition exposing + ( Transition(..), LoadingState(..) + , FetcherState + , FetcherSubmitStatus(..) + ) {-| @docs Transition, LoadingState + +## Fetchers + +@docs FetcherState, FetcherSubmitStatus + -} import FormDecoder @@ -21,3 +30,16 @@ type LoadingState = Redirecting | Load | ActionRedirect + + +{-| -} +type alias FetcherState = + { status : FetcherSubmitStatus + , payload : FormDecoder.FormData + } + + +{-| -} +type FetcherSubmitStatus + = FetcherSubmitting + | FetcherReloading