diff --git a/codegen/GenerateMain.elm b/codegen/GenerateMain.elm index 8e06ba66..b079632a 100644 --- a/codegen/GenerateMain.elm +++ b/codegen/GenerateMain.elm @@ -21,13 +21,14 @@ import Gen.Json.Decode import Gen.Json.Encode import Gen.List import Gen.Maybe +import Gen.Pages.ConcurrentSubmission import Gen.Pages.Fetcher import Gen.Pages.Internal.NotFoundReason import Gen.Pages.Internal.Platform import Gen.Pages.Internal.Platform.Cli import Gen.Pages.Internal.RoutePattern +import Gen.Pages.Navigation import Gen.Pages.PageUrl -import Gen.Pages.Transition import Gen.PagesMsg import Gen.Server.Response import Gen.String @@ -239,10 +240,10 @@ otherFile routes phaseString = [ ( "pageFormState", Type.named [ "Form" ] "Model" |> Just ) , ( "concurrentSubmissions" , Gen.Dict.annotation_.dict Type.string - (Gen.Pages.Transition.annotation_.fetcherState (Type.named [] "ActionData")) + (Gen.Pages.ConcurrentSubmission.annotation_.concurrentSubmission (Type.named [] "ActionData")) |> Just ) - , ( "navigation", Type.named [ "Pages", "Transition" ] "Transition" |> Type.maybe |> Just ) + , ( "navigation", Type.named [ "Pages", "Navigation" ] "Navigation" |> Type.maybe |> Just ) , ( "page" , Type.record [ ( "path", Type.named [ "UrlPath" ] "UrlPath" ) @@ -381,7 +382,7 @@ otherFile routes phaseString = |> Gen.Dict.map (\_ fetcherState -> fetcherState - |> Gen.Pages.Transition.map (\ad -> actionDataOrNothing ad) + |> Gen.Pages.ConcurrentSubmission.map (\ad -> actionDataOrNothing ad) ) ) , ( "pageFormState", pageFormState ) @@ -917,10 +918,10 @@ otherFile routes phaseString = , ( "concurrentSubmissions" , Gen.Dict.annotation_.dict Type.string - (Gen.Pages.Transition.annotation_.fetcherState (Type.named [] "ActionData")) + (Gen.Pages.ConcurrentSubmission.annotation_.concurrentSubmission (Type.named [] "ActionData")) |> Just ) - , ( "navigation", Type.named [ "Pages", "Transition" ] "Transition" |> Type.maybe |> Just ) + , ( "navigation", Type.named [ "Pages", "Navigation" ] "Navigation" |> Type.maybe |> Just ) , ( "sharedData", Type.named [ "Shared" ] "Data" |> Just ) , ( "pageData", Type.named [] "PageData" |> Just ) , ( "navigationKey", Type.named [ "Browser", "Navigation" ] "Key" |> Type.maybe |> Just ) @@ -1189,7 +1190,7 @@ otherFile routes phaseString = |> Gen.Dict.map (\_ fetcherState -> fetcherState - |> Gen.Pages.Transition.map + |> Gen.Pages.ConcurrentSubmission.map (\ad -> Elm.Case.custom ad Type.unit diff --git a/elm.json b/elm.json index 7ac6e733..d02a1cc7 100644 --- a/elm.json +++ b/elm.json @@ -31,6 +31,7 @@ "Pages.Flags", "Pages.Fetcher", "Pages.Navigation", + "Pages.ConcurrentSubmission", "Scaffold.Route", "Scaffold.Form", "Pages.Script", diff --git a/examples/end-to-end/app/Route/Fetcher.elm b/examples/end-to-end/app/Route/Fetcher.elm index 4b5d6111..be89fced 100644 --- a/examples/end-to-end/app/Route/Fetcher.elm +++ b/examples/end-to-end/app/Route/Fetcher.elm @@ -17,8 +17,8 @@ import Html.Styled as Html import Html.Styled.Attributes as Attr import Json.Decode as Decode import Json.Encode as Encode +import Pages.ConcurrentSubmission import Pages.Form -import Pages.Navigation exposing (FetcherSubmitStatus(..)) import PagesMsg exposing (PagesMsg) import Platform.Sub import RouteBuilder @@ -205,7 +205,7 @@ view app sharedModel model = |> List.filterMap (\{ status, payload } -> case status of - FetcherComplete _ -> + Pages.ConcurrentSubmission.Complete _ -> Nothing _ -> diff --git a/examples/todos/app/Route/Visibility__.elm b/examples/todos/app/Route/Visibility__.elm index 7fb4db1c..dfcfc6ef 100644 --- a/examples/todos/app/Route/Visibility__.elm +++ b/examples/todos/app/Route/Visibility__.elm @@ -477,7 +477,7 @@ view app shared model = , status ) of - ( Form.Valid (Add newItem), Pages.Navigation.FetcherComplete (Just parsedActionData) ) -> + ( Form.Valid (Add newItem), Pages.ConcurrentSubmission.Complete (Just parsedActionData) ) -> parsedActionData.errors |> Maybe.map (Tuple.pair key) diff --git a/generator/src/RouteBuilder.elm b/generator/src/RouteBuilder.elm index 588fa8ce..fc783bcb 100644 --- a/generator/src/RouteBuilder.elm +++ b/generator/src/RouteBuilder.elm @@ -94,6 +94,7 @@ import Form import Head import Http import Json.Decode +import Pages.ConcurrentSubmission import Pages.Fetcher import Pages.Internal.NotFoundReason exposing (NotFoundReason) import Pages.Internal.RoutePattern exposing (RoutePattern) @@ -146,7 +147,7 @@ type alias App data action routeParams = { fields : List ( String, String ), headers : List ( String, String ) } -> Pages.Fetcher.Fetcher (Result Http.Error action) , navigation : Maybe Pages.Navigation.Navigation - , concurrentSubmissions : Dict String (Pages.Navigation.FetcherState (Maybe action)) + , concurrentSubmissions : Dict String (Pages.ConcurrentSubmission.ConcurrentSubmission (Maybe action)) , pageFormState : Form.Model } diff --git a/src/Pages/ConcurrentSubmission.elm b/src/Pages/ConcurrentSubmission.elm new file mode 100644 index 00000000..5eef5cfc --- /dev/null +++ b/src/Pages/ConcurrentSubmission.elm @@ -0,0 +1,52 @@ +module Pages.ConcurrentSubmission exposing + ( ConcurrentSubmission, Status(..) + , map + ) + +{-| + +@docs ConcurrentSubmission, Status + +@docs map + +-} + +import Pages.FormData exposing (FormData) +import Time + + +{-| -} +type alias ConcurrentSubmission actionData = + { status : Status actionData + , payload : FormData + , initiatedAt : Time.Posix + } + + +{-| -} +type Status actionData + = Submitting + | Reloading actionData + | Complete actionData + + +{-| -} +map : (a -> b) -> ConcurrentSubmission a -> ConcurrentSubmission b +map mapFn fetcherState = + { status = mapStatus mapFn fetcherState.status + , payload = fetcherState.payload + , initiatedAt = fetcherState.initiatedAt + } + + +mapStatus : (a -> b) -> Status a -> Status b +mapStatus mapFn fetcherSubmitStatus = + case fetcherSubmitStatus of + Submitting -> + Submitting + + Reloading value -> + Reloading (mapFn value) + + Complete value -> + Complete (mapFn value) diff --git a/src/Pages/Form.elm b/src/Pages/Form.elm index 0afb3099..c26e5999 100644 --- a/src/Pages/Form.elm +++ b/src/Pages/Form.elm @@ -22,6 +22,7 @@ import Form.Handler import Form.Validation exposing (Validation) import Html import Html.Styled +import Pages.ConcurrentSubmission import Pages.Internal.Msg import Pages.Navigation import PagesMsg exposing (PagesMsg) @@ -93,7 +94,7 @@ renderHtml : app | pageFormState : Form.Model , navigation : Maybe Pages.Navigation.Navigation - , concurrentSubmissions : Dict String (Pages.Navigation.FetcherState (Maybe action)) + , concurrentSubmissions : Dict String (Pages.ConcurrentSubmission.ConcurrentSubmission (Maybe action)) } -> Form.Form error { combine : Validation error parsed named constraints, view : Form.Context error input -> List (Html.Html (PagesMsg userMsg)) } parsed input -> Html.Html (PagesMsg userMsg) @@ -110,13 +111,13 @@ renderHtml attrs options_ app form_ = (case app.concurrentSubmissions |> Dict.get options_.id of Just { status } -> case status of - Pages.Navigation.FetcherComplete _ -> + Pages.ConcurrentSubmission.Complete _ -> False - Pages.Navigation.FetcherSubmitting -> + Pages.ConcurrentSubmission.Submitting -> True - Pages.Navigation.FetcherReloading _ -> + Pages.ConcurrentSubmission.Reloading _ -> True Nothing -> @@ -187,7 +188,7 @@ renderStyledHtml : app | pageFormState : Form.Model , navigation : Maybe Pages.Navigation.Navigation - , concurrentSubmissions : Dict String (Pages.Navigation.FetcherState (Maybe action)) + , concurrentSubmissions : Dict String (Pages.ConcurrentSubmission.ConcurrentSubmission (Maybe action)) } -> Form.Form error { combine : Validation error parsed named constraints, view : Form.Context error input -> List (Html.Styled.Html (PagesMsg userMsg)) } parsed input -> Html.Styled.Html (PagesMsg userMsg) @@ -205,13 +206,13 @@ renderStyledHtml attrs options_ app form_ = (case app.concurrentSubmissions |> Dict.get options_.id of Just { status } -> case status of - Pages.Navigation.FetcherComplete _ -> + Pages.ConcurrentSubmission.Complete _ -> False - Pages.Navigation.FetcherSubmitting -> + Pages.ConcurrentSubmission.Submitting -> True - Pages.Navigation.FetcherReloading _ -> + Pages.ConcurrentSubmission.Reloading _ -> True Nothing -> diff --git a/src/Pages/FormData.elm b/src/Pages/FormData.elm new file mode 100644 index 00000000..3234a43f --- /dev/null +++ b/src/Pages/FormData.elm @@ -0,0 +1,18 @@ +module Pages.FormData exposing (FormData) + +{-| + +@docs FormData + +-} + +import Form + + +{-| -} +type alias FormData = + { fields : List ( String, String ) + , method : Form.Method + , action : String + , id : Maybe String + } diff --git a/src/Pages/Internal/Platform.elm b/src/Pages/Internal/Platform.elm index faf53eb8..9b2fcc87 100644 --- a/src/Pages/Internal/Platform.elm +++ b/src/Pages/Internal/Platform.elm @@ -26,6 +26,7 @@ import Html.Attributes as Attr import Http import Json.Decode as Decode import Json.Encode +import Pages.ConcurrentSubmission import Pages.ContentCache as ContentCache import Pages.Fetcher import Pages.Flags @@ -342,7 +343,7 @@ type alias Model userModel pageData actionData sharedData = , userFlags : Decode.Value , transition : Maybe ( Int, Pages.Navigation.Navigation ) , nextTransitionKey : Int - , inFlightFetchers : Dict String ( Int, Pages.Navigation.FetcherState actionData ) + , inFlightFetchers : Dict String ( Int, Pages.ConcurrentSubmission.ConcurrentSubmission actionData ) , pageFormState : Form.Model , pendingRedirect : Bool , pendingData : Maybe ( pageData, sharedData, Maybe actionData ) @@ -454,9 +455,9 @@ update config appMsg model = , { fetcherState | status = maybeFetcherDoneActionData - |> Maybe.map Pages.Navigation.FetcherReloading + |> Maybe.map Pages.ConcurrentSubmission.Reloading -- TODO remove this bad default, FetcherSubmitting is incorrect - |> Maybe.withDefault Pages.Navigation.FetcherSubmitting + |> Maybe.withDefault Pages.ConcurrentSubmission.Submitting } ) ) @@ -857,7 +858,7 @@ update config appMsg model = |> Dict.insert fetcherKey ( transitionId , { payload = fetcherData - , status = Pages.Navigation.FetcherSubmitting + , status = Pages.ConcurrentSubmission.Submitting , initiatedAt = initiatedAt } ) @@ -866,7 +867,7 @@ update config appMsg model = ) -toFetcherState : Dict String ( Int, Pages.Navigation.FetcherState actionData ) -> Dict String (Pages.Navigation.FetcherState actionData) +toFetcherState : Dict String ( Int, Pages.ConcurrentSubmission.ConcurrentSubmission actionData ) -> Dict String (Pages.ConcurrentSubmission.ConcurrentSubmission actionData) toFetcherState inFlightFetchers = inFlightFetchers |> Dict.map (\_ ( _, fetcherState ) -> fetcherState) @@ -1143,14 +1144,14 @@ cancelStaleFetchers model = |> List.filterMap (\( _, ( id, fetcher ) ) -> case fetcher.status of - Pages.Navigation.FetcherReloading _ -> + Pages.ConcurrentSubmission.Reloading _ -> Http.cancel (String.fromInt id) |> Just - Pages.Navigation.FetcherSubmitting -> + Pages.ConcurrentSubmission.Submitting -> Nothing - Pages.Navigation.FetcherComplete _ -> + Pages.ConcurrentSubmission.Complete _ -> Nothing ) |> Cmd.batch @@ -1459,9 +1460,9 @@ clearLoadingFetchersAfterDataLoad completedTransitionId model = -- TODO fetchers are never removed from the list. Need to decide how and when to remove them. --(fetcherState.status /= Pages.Transition.FetcherReloading) || (transitionId > completedTransitionId) case ( transitionId > completedTransitionId, fetcherState.status ) of - ( False, Pages.Navigation.FetcherReloading actionData ) -> + ( False, Pages.ConcurrentSubmission.Reloading actionData ) -> ( transitionId - , { fetcherState | status = Pages.Navigation.FetcherComplete actionData } + , { fetcherState | status = Pages.ConcurrentSubmission.Complete actionData } ) _ -> diff --git a/src/Pages/Navigation.elm b/src/Pages/Navigation.elm index ddcc802b..5548c42c 100644 --- a/src/Pages/Navigation.elm +++ b/src/Pages/Navigation.elm @@ -1,34 +1,17 @@ -module Pages.Navigation exposing - ( LoadingState(..), map, FormData - , FetcherState, FetcherSubmitStatus(..) - , Navigation(..) - ) +module Pages.Navigation exposing (Navigation(..), LoadingState(..)) {-| -@docs Transition, LoadingState, map, FormData - - -## Fetchers - -@docs FetcherState, FetcherSubmitStatus +@docs Navigation, LoadingState -} import Form +import Pages.FormData exposing (FormData) import Time import UrlPath exposing (UrlPath) -{-| -} -type alias FormData = - { fields : List ( String, String ) - , method : Form.Method - , action : String - , id : Maybe String - } - - {-| -} type Navigation = Submitting FormData @@ -41,40 +24,3 @@ type LoadingState = Redirecting | Load | ActionRedirect - - -{-| -} -type alias FetcherState actionData = - { status : FetcherSubmitStatus actionData - , payload : FormData - , initiatedAt : Time.Posix - } - - -{-| -} -type FetcherSubmitStatus actionData - = FetcherSubmitting - | FetcherReloading actionData - | FetcherComplete actionData - - -{-| -} -map : (a -> b) -> FetcherState a -> FetcherState b -map mapFn fetcherState = - { status = mapStatus mapFn fetcherState.status - , payload = fetcherState.payload - , initiatedAt = fetcherState.initiatedAt - } - - -mapStatus : (a -> b) -> FetcherSubmitStatus a -> FetcherSubmitStatus b -mapStatus mapFn fetcherSubmitStatus = - case fetcherSubmitStatus of - FetcherSubmitting -> - FetcherSubmitting - - FetcherReloading value -> - FetcherReloading (mapFn value) - - FetcherComplete value -> - FetcherComplete (mapFn value) diff --git a/src/Pages/ProgramConfig.elm b/src/Pages/ProgramConfig.elm index 52bf49a1..15ba8653 100644 --- a/src/Pages/ProgramConfig.elm +++ b/src/Pages/ProgramConfig.elm @@ -15,6 +15,7 @@ import Http import Json.Decode as Decode import Json.Encode import PageServerResponse exposing (PageServerResponse) +import Pages.ConcurrentSubmission import Pages.Fetcher import Pages.Flags import Pages.Internal.NotFoundReason exposing (NotFoundReason) @@ -46,7 +47,7 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData , pageUrl : Maybe PageUrl } -> ( userModel, effect ) - , update : Form.Model -> Dict String (Pages.Navigation.FetcherState actionData) -> Maybe Pages.Navigation.Navigation -> sharedData -> pageData -> Maybe Browser.Navigation.Key -> userMsg -> userModel -> ( userModel, effect ) + , update : Form.Model -> Dict String (Pages.ConcurrentSubmission.ConcurrentSubmission actionData) -> Maybe Pages.Navigation.Navigation -> sharedData -> pageData -> Maybe Browser.Navigation.Key -> userMsg -> userModel -> ( userModel, effect ) , subscriptions : route -> UrlPath -> userModel -> Sub userMsg , sharedData : BackendTask FatalError sharedData , data : Decode.Value -> route -> BackendTask FatalError (PageServerResponse pageData errorPage) @@ -54,7 +55,7 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData , onActionData : actionData -> Maybe userMsg , view : Form.Model - -> Dict String (Pages.Navigation.FetcherState actionData) + -> Dict String (Pages.ConcurrentSubmission.ConcurrentSubmission actionData) -> Maybe Pages.Navigation.Navigation -> { path : UrlPath