elm-pages 3.0.0-beta.26 → 3.0.0-beta.27

package/src/Form.elm

@@ -282,8 +282,9 @@ import Html.Styled.Attributes as StyledAttr
 import Html.Styled.Lazy
 import Pages.FormState as Form exposing (FormState)
 import Pages.Internal.Form exposing (Validation(..), unwrapResponse)
-import Pages.Msg
+import Pages.Internal.Msg
 import Pages.Transition exposing (Transition(..))
+import PagesMsg exposing (PagesMsg)
 import Path exposing (Path)
 
 
@@ -980,7 +981,7 @@ runOneOfServerSideHelp rawFormData firstFoundErrors (ServerForms parsers) =
 
 {-| -}
 renderHtml :
-    List (Html.Attribute (Pages.Msg.Msg msg))
+    List (Html.Attribute (PagesMsg msg))
     -> (actionData -> Maybe (Response error))
     -> AppContext app actionData
     -> data
@@ -990,10 +991,10 @@ renderHtml :
             (Form.Validation.Validation error parsed named constraints)
             data
             (Context error data
-             -> List (Html (Pages.Msg.Msg msg))
+             -> List (Html (PagesMsg msg))
             )
             msg
-    -> Html (Pages.Msg.Msg msg)
+    -> Html (PagesMsg msg)
 renderHtml attrs accessResponse app data (FinalForm options a b c) =
     Html.Lazy.lazy6 renderHelper attrs accessResponse options app data (FormInternal a b c)
 
@@ -1177,7 +1178,7 @@ withOnSubmit onSubmit (FinalForm options a b c) =
 
 {-| -}
 renderStyledHtml :
-    List (Html.Styled.Attribute (Pages.Msg.Msg msg))
+    List (Html.Styled.Attribute (PagesMsg msg))
     -> (actionData -> Maybe (Response error))
     -> AppContext app actionData
     -> data
@@ -1187,10 +1188,10 @@ renderStyledHtml :
             (Form.Validation.Validation error parsed named constraints)
             data
             (Context error data
-             -> List (Html.Styled.Html (Pages.Msg.Msg msg))
+             -> List (Html.Styled.Html (PagesMsg msg))
             )
             msg
-    -> Html.Styled.Html (Pages.Msg.Msg msg)
+    -> Html.Styled.Html (PagesMsg msg)
 renderStyledHtml attrs accessResponse app data (FinalForm options a b c) =
     Html.Styled.Lazy.lazy6 renderStyledHelper attrs accessResponse options app data (FormInternal a b c)
 
@@ -1201,13 +1202,13 @@ type alias Response error =
 
 
 renderHelper :
-    List (Html.Attribute (Pages.Msg.Msg msg))
+    List (Html.Attribute (PagesMsg msg))
     -> (actionData -> Maybe (Response error))
     -> RenderOptions msg
     -> AppContext app actionData
     -> data
-    -> FormInternal error (Form.Validation.Validation error parsed named constraints) data (Context error data -> List (Html (Pages.Msg.Msg msg)))
-    -> Html (Pages.Msg.Msg msg)
+    -> FormInternal error (Form.Validation.Validation error parsed named constraints) data (Context error data -> List (Html (PagesMsg msg)))
+    -> Html (PagesMsg msg)
 renderHelper attrs accessResponse options formState data form =
     -- TODO Get transition context from `app` so you can check if the current form is being submitted
     -- TODO either as a transition or a fetcher? Should be easy enough to check for the `id` on either of those?
@@ -1215,7 +1216,7 @@ renderHelper attrs accessResponse options formState data form =
         { formId, hiddenInputs, children, isValid } =
             helperValues toHiddenInput accessResponse options formState data form
 
-        toHiddenInput : List (Html.Attribute (Pages.Msg.Msg msg)) -> Html (Pages.Msg.Msg msg)
+        toHiddenInput : List (Html.Attribute (PagesMsg msg)) -> Html (PagesMsg msg)
         toHiddenInput hiddenAttrs =
             Html.input hiddenAttrs []
     in
@@ -1228,10 +1229,10 @@ renderHelper attrs accessResponse options formState data form =
                , Attr.action (Path.toAbsolute formState.path)
                , case options.submitStrategy of
                     FetcherStrategy ->
-                        Pages.Msg.fetcherOnSubmit options.onSubmit formId (\_ -> isValid)
+                        Pages.Internal.Msg.fetcherOnSubmit options.onSubmit formId (\_ -> isValid)
 
                     TransitionStrategy ->
-                        Pages.Msg.submitIfValid formId (\_ -> isValid)
+                        Pages.Internal.Msg.submitIfValid options.onSubmit formId (\_ -> isValid)
                ]
             ++ attrs
         )
@@ -1239,13 +1240,13 @@ renderHelper attrs accessResponse options formState data form =
 
 
 renderStyledHelper :
-    List (Html.Styled.Attribute (Pages.Msg.Msg msg))
+    List (Html.Styled.Attribute (PagesMsg msg))
     -> (actionData -> Maybe (Response error))
     -> RenderOptions msg
     -> AppContext app actionData
     -> data
-    -> FormInternal error (Form.Validation.Validation error parsed named constraints) data (Context error data -> List (Html.Styled.Html (Pages.Msg.Msg msg)))
-    -> Html.Styled.Html (Pages.Msg.Msg msg)
+    -> FormInternal error (Form.Validation.Validation error parsed named constraints) data (Context error data -> List (Html.Styled.Html (PagesMsg msg)))
+    -> Html.Styled.Html (PagesMsg msg)
 renderStyledHelper attrs accessResponse options formState data form =
     -- TODO Get transition context from `app` so you can check if the current form is being submitted
     -- TODO either as a transition or a fetcher? Should be easy enough to check for the `id` on either of those?
@@ -1253,7 +1254,7 @@ renderStyledHelper attrs accessResponse options formState data form =
         { formId, hiddenInputs, children, isValid } =
             helperValues toHiddenInput accessResponse options formState data form
 
-        toHiddenInput : List (Html.Attribute (Pages.Msg.Msg msg)) -> Html.Styled.Html (Pages.Msg.Msg msg)
+        toHiddenInput : List (Html.Attribute (PagesMsg msg)) -> Html.Styled.Html (PagesMsg msg)
         toHiddenInput hiddenAttrs =
             Html.Styled.input (hiddenAttrs |> List.map StyledAttr.fromUnstyled) []
     in
@@ -1265,11 +1266,11 @@ renderStyledHelper attrs accessResponse options formState data form =
                , case options.submitStrategy of
                     FetcherStrategy ->
                         StyledAttr.fromUnstyled <|
-                            Pages.Msg.fetcherOnSubmit options.onSubmit formId (\_ -> isValid)
+                            Pages.Internal.Msg.fetcherOnSubmit options.onSubmit formId (\_ -> isValid)
 
                     TransitionStrategy ->
                         StyledAttr.fromUnstyled <|
-                            Pages.Msg.submitIfValid formId (\_ -> isValid)
+                            Pages.Internal.Msg.submitIfValid options.onSubmit formId (\_ -> isValid)
                ]
             ++ attrs
         )
@@ -1277,7 +1278,7 @@ renderStyledHelper attrs accessResponse options formState data form =
 
 
 helperValues :
-    (List (Html.Attribute (Pages.Msg.Msg msg)) -> view)
+    (List (Html.Attribute (PagesMsg msg)) -> view)
     -> (actionData -> Maybe (Response error))
     -> RenderOptions msg
     -> AppContext app actionData
@@ -1476,7 +1477,7 @@ type alias HtmlForm error parsed input msg =
     Form
         error
         { combine : Combined error parsed
-        , view : Context error input -> List (Html (Pages.Msg.Msg msg))
+        , view : Context error input -> List (Html (PagesMsg msg))
         }
         input
 
@@ -1600,7 +1601,7 @@ type alias StyledHtmlForm error parsed data msg =
     Form
         error
         { combine : Combined error parsed
-        , view : Context error data -> List (Html.Styled.Html (Pages.Msg.Msg msg))
+        , view : Context error data -> List (Html.Styled.Html (PagesMsg msg))
         }
         data
 

package/src/Pages/FormState.elm

@@ -12,15 +12,16 @@ import Html exposing (Attribute)
 import Html.Attributes as Attr
 import Html.Events
 import Json.Decode as Decode exposing (Decoder)
-import Pages.Msg
+import Pages.Internal.Msg
+import PagesMsg exposing (PagesMsg)
 
 
 {-| -}
-listeners : String -> List (Attribute (Pages.Msg.Msg userMsg))
+listeners : String -> List (Attribute (PagesMsg userMsg))
 listeners formId =
-    [ Html.Events.on "focusin" (Decode.value |> Decode.map Pages.Msg.FormFieldEvent)
-    , Html.Events.on "focusout" (Decode.value |> Decode.map Pages.Msg.FormFieldEvent)
-    , Html.Events.on "input" (Decode.value |> Decode.map Pages.Msg.FormFieldEvent)
+    [ Html.Events.on "focusin" (Decode.value |> Decode.map Pages.Internal.Msg.FormFieldEvent)
+    , Html.Events.on "focusout" (Decode.value |> Decode.map Pages.Internal.Msg.FormFieldEvent)
+    , Html.Events.on "input" (Decode.value |> Decode.map Pages.Internal.Msg.FormFieldEvent)
     , Attr.id formId
     ]
 

package/src/Pages/{Msg.elm → Internal/Msg.elm}

@@ -1,16 +1,11 @@
-module Pages.Msg exposing
+module Pages.Internal.Msg exposing
     ( Msg(..)
-    , map, onSubmit, fetcherOnSubmit, submitIfValid
+    , fetcherOnSubmit
+    , map
+    , onSubmit
+    , submitIfValid
     )
 
-{-|
-
-@docs Msg
-
-@docs map, onSubmit, fetcherOnSubmit, submitIfValid
-
--}
-
 import Form.FormData exposing (FormData)
 import FormDecoder
 import Html exposing (Attribute)
@@ -22,9 +17,10 @@ import Json.Decode
 type Msg userMsg
     = UserMsg userMsg
     | Submit FormData
-    | SubmitIfValid String FormData Bool
+    | SubmitIfValid String FormData Bool (Maybe userMsg)
     | SubmitFetcher String FormData Bool (Maybe userMsg)
     | FormFieldEvent Json.Decode.Value
+    | NoOp
 
 
 {-| -}
@@ -35,10 +31,21 @@ onSubmit =
 
 
 {-| -}
-submitIfValid : String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
-submitIfValid formId isValid =
+submitIfValid : Maybe ({ fields : List ( String, String ) } -> userMsg) -> String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
+submitIfValid userMsg formId isValid =
     FormDecoder.formDataOnSubmit
-        |> Attr.map (\formData -> SubmitIfValid formId formData (isValid formData.fields))
+        |> Attr.map
+            (\formData ->
+                SubmitIfValid formId
+                    formData
+                    (isValid formData.fields)
+                    (userMsg
+                        |> Maybe.map
+                            (\toUserMsg ->
+                                toUserMsg { fields = formData.fields }
+                            )
+                    )
+            )
 
 
 {-| -}
@@ -69,11 +76,14 @@ map mapFn msg =
         Submit info ->
             Submit info
 
-        SubmitIfValid formId info isValid ->
-            SubmitIfValid formId info isValid
+        SubmitIfValid formId info isValid toUserMsg ->
+            SubmitIfValid formId info isValid (Maybe.map mapFn toUserMsg)
 
         SubmitFetcher formId info isValid toUserMsg ->
             SubmitFetcher formId info isValid (Maybe.map mapFn toUserMsg)
 
         FormFieldEvent value ->
             FormFieldEvent value
+
+        NoOp ->
+            NoOp

package/src/Pages/Internal/Platform/Cli.elm

@@ -27,10 +27,10 @@ import Pages.Internal.Platform.Effect as Effect exposing (Effect)
 import Pages.Internal.Platform.StaticResponses as StaticResponses
 import Pages.Internal.Platform.ToJsPayload as ToJsPayload
 import Pages.Internal.ResponseSketch as ResponseSketch
-import Pages.Msg
 import Pages.ProgramConfig exposing (ProgramConfig)
 import Pages.SiteConfig exposing (SiteConfig)
 import Pages.StaticHttp.Request
+import PagesMsg exposing (PagesMsg)
 import Path exposing (Path)
 import RenderRequest exposing (RenderRequest)
 import RequestsAndPending exposing (RequestsAndPending)
@@ -503,7 +503,7 @@ initLegacy site ((RenderRequest.SinglePage includeHtml singleRequest _) as rende
                                                                                                     )
                                                                                                     |> Tuple.first
 
-                                                                                            viewValue : { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }
+                                                                                            viewValue : { title : String, body : List (Html (PagesMsg userMsg)) }
                                                                                             viewValue =
                                                                                                 (config.view Dict.empty Dict.empty Nothing currentPage Nothing sharedData pageData_ maybeActionData |> .view) pageModel
 
@@ -550,7 +550,7 @@ initLegacy site ((RenderRequest.SinglePage includeHtml singleRequest _) as rende
                                                                                         )
                                                                                             |> (\( actionHeaders, byteEncodedPageData ) ->
                                                                                                     let
-                                                                                                        rendered : { view : userModel -> { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }, head : List Tag }
+                                                                                                        rendered : { view : userModel -> { title : String, body : List (Html (PagesMsg userMsg)) }, head : List Tag }
                                                                                                         rendered =
                                                                                                             config.view Dict.empty Dict.empty Nothing currentPage Nothing sharedData pageData_ maybeActionData
                                                                                                     in
@@ -641,7 +641,7 @@ initLegacy site ((RenderRequest.SinglePage includeHtml singleRequest _) as rende
                                                                                             pageData2 =
                                                                                                 config.errorPageToData error
 
-                                                                                            viewValue : { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }
+                                                                                            viewValue : { title : String, body : List (Html (PagesMsg userMsg)) }
                                                                                             viewValue =
                                                                                                 (config.view Dict.empty Dict.empty Nothing currentPage Nothing sharedData pageData2 Nothing |> .view) pageModel
                                                                                         in
@@ -854,7 +854,7 @@ render404Page config sharedData isDevServer path notFoundReason =
                 pathAndRoute =
                     { path = path, route = config.notFoundRoute }
 
-                viewValue : { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }
+                viewValue : { title : String, body : List (Html (PagesMsg userMsg)) }
                 viewValue =
                     (config.view Dict.empty
                         Dict.empty

package/src/Pages/Internal/Platform/CompatibilityKey.elm

@@ -3,4 +3,4 @@ module Pages.Internal.Platform.CompatibilityKey exposing (currentCompatibilityKe
 
 currentCompatibilityKey : Int
 currentCompatibilityKey =
-    10
+    11

package/src/Pages/Internal/Platform.elm

@@ -31,13 +31,14 @@ import Pages.ContentCache as ContentCache
 import Pages.Fetcher
 import Pages.Flags
 import Pages.FormState
+import Pages.Internal.Msg
 import Pages.Internal.NotFoundReason exposing (NotFoundReason)
 import Pages.Internal.ResponseSketch as ResponseSketch exposing (ResponseSketch)
 import Pages.Internal.String as String
-import Pages.Msg
 import Pages.ProgramConfig exposing (ProgramConfig)
 import Pages.StaticHttpRequest as StaticHttpRequest
 import Pages.Transition
+import PagesMsg exposing (PagesMsg)
 import Path exposing (Path)
 import QueryParams
 import Task
@@ -53,7 +54,7 @@ type alias Program userModel userMsg pageData actionData sharedData errorPage =
 mainView :
     ProgramConfig userMsg userModel route pageData actionData sharedData effect (Msg userMsg pageData actionData sharedData errorPage) errorPage
     -> Model userModel pageData actionData sharedData
-    -> { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }
+    -> { title : String, body : List (Html (PagesMsg userMsg)) }
 mainView config model =
     case model.notFound of
         Just info ->
@@ -308,7 +309,7 @@ init config flags url key =
 type Msg userMsg pageData actionData sharedData errorPage
     = LinkClicked Browser.UrlRequest
     | UrlChanged Url
-    | UserMsg (Pages.Msg.Msg userMsg)
+    | UserMsg (PagesMsg userMsg)
     | SetField { formId : String, name : String, value : String }
     | UpdateCacheAndUrlNew Bool Url (Maybe userMsg) (Result Http.Error ( Url, ResponseSketch pageData actionData sharedData ))
     | FetcherComplete Bool String Int (Result Http.Error ( Maybe userMsg, ActionDataOrRedirect actionData ))
@@ -491,11 +492,11 @@ update config appMsg model =
 
         UserMsg userMsg_ ->
             case userMsg_ of
-                Pages.Msg.UserMsg userMsg ->
+                Pages.Internal.Msg.UserMsg userMsg ->
                     ( model, NoEffect )
                         |> performUserMsg userMsg config
 
-                Pages.Msg.Submit fields ->
+                Pages.Internal.Msg.Submit fields ->
                     ( { model
                         | transition =
                             Just
@@ -507,7 +508,7 @@ update config appMsg model =
                     , Submit fields
                     )
 
-                Pages.Msg.SubmitIfValid formId fields isValid ->
+                Pages.Internal.Msg.SubmitIfValid formId fields isValid maybeUserMsg ->
                     if isValid then
                         ( { model
                             -- TODO should I setSubmitAttempted here, too?
@@ -520,6 +521,13 @@ update config appMsg model =
                           }
                         , Submit fields
                         )
+                            |> (case maybeUserMsg of
+                                    Just justUserMsg ->
+                                        performUserMsg justUserMsg config
+
+                                    Nothing ->
+                                        identity
+                               )
 
                     else
                         ( { model
@@ -530,7 +538,7 @@ update config appMsg model =
                         , NoEffect
                         )
 
-                Pages.Msg.SubmitFetcher fetcherKey fields isValid maybeUserMsg ->
+                Pages.Internal.Msg.SubmitFetcher fetcherKey fields isValid maybeUserMsg ->
                     if isValid then
                         -- TODO should I setSubmitAttempted here, too?
                         ( { model | nextTransitionKey = model.nextTransitionKey + 1 }
@@ -553,12 +561,15 @@ update config appMsg model =
                         , NoEffect
                         )
 
-                Pages.Msg.FormFieldEvent value ->
+                Pages.Internal.Msg.FormFieldEvent value ->
                     -- TODO when init is called for a new page, also need to clear out client-side `pageFormState`
                     ( { model | pageFormState = Pages.FormState.update value model.pageFormState }
                     , NoEffect
                     )
 
+                Pages.Internal.Msg.NoOp ->
+                    ( model, NoEffect )
+
         UpdateCacheAndUrlNew scrollToTopWhenDone urlWithoutRedirectResolution maybeUserMsg updateResult ->
             -- TODO remove all fetchers that are in the state `FetcherReloading` here -- I think that's the right logic?
             case
@@ -977,7 +988,7 @@ perform config model effect =
                                     -- TODO need to get the fetcherId here
                                     -- TODO need to increment and pass in the transitionId
                                     startFetcher "TODO" -1 options model
-                            , fromPageMsg = Pages.Msg.UserMsg >> UserMsg
+                            , fromPageMsg = Pages.Internal.Msg.UserMsg >> UserMsg
                             , key = key
                             , setField = \info -> Task.succeed (SetField info) |> Task.perform identity
                             }
@@ -1088,6 +1099,7 @@ startFetcher2 config fromPageReload fetcherKey transitionId formData model =
                                     decodedAction : ActionDataOrRedirect actionData
                                     decodedAction =
                                         case Bytes.Decode.decode config.decodeResponse bytesBody of
+                                            -- @@@
                                             Just (ResponseSketch.Redirect redirectTo) ->
                                                 RedirectResponse redirectTo
 
@@ -1205,7 +1217,7 @@ application config =
                             [ config.subscriptions (model.url |> config.urlToRoute)
                                 (urls.currentUrl |> config.urlToRoute |> config.routeToPath |> Path.join)
                                 pageData.userModel
-                                |> Sub.map (Pages.Msg.UserMsg >> UserMsg)
+                                |> Sub.map (Pages.Internal.Msg.UserMsg >> UserMsg)
                             , config.hotReloadData
                                 |> Sub.map HotReloadCompleteNew
                             ]

package/src/Pages/ProgramConfig.elm

@@ -22,10 +22,10 @@ import Pages.Internal.NotFoundReason exposing (NotFoundReason)
 import Pages.Internal.Platform.ToJsPayload
 import Pages.Internal.ResponseSketch exposing (ResponseSketch)
 import Pages.Internal.RoutePattern exposing (RoutePattern)
-import Pages.Msg
 import Pages.PageUrl exposing (PageUrl)
 import Pages.SiteConfig exposing (SiteConfig)
 import Pages.Transition
+import PagesMsg exposing (PagesMsg)
 import Path exposing (Path)
 import Url exposing (Url)
 
@@ -66,7 +66,7 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
         -> pageData
         -> Maybe actionData
         ->
-            { view : userModel -> { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }
+            { view : userModel -> { title : String, body : List (Html (PagesMsg userMsg)) }
             , head : List Head.Tag
             }
     , handleRoute : route -> BackendTask FatalError (Maybe NotFoundReason)

package/src/PagesMsg.elm

@@ -0,0 +1,93 @@
+module PagesMsg exposing
+    ( PagesMsg
+    , fromMsg
+    , map, noOp
+    , onSubmit
+    )
+
+{-| In `elm-pages`, Route modules have their own `Msg` type which can be used like a normal TEA (The Elm Architecture) app.
+But the `Msg` defined in a `Route` module is wrapped in the `PagesMsg` type.
+
+@docs PagesMsg
+
+You can wrap your Route Module's `Msg` using `fromMsg`.
+
+@docs fromMsg
+
+@docs map, noOp
+
+@docs onSubmit
+
+-}
+
+import Html exposing (Attribute)
+import Pages.Internal.Msg
+
+
+{-| -}
+type alias PagesMsg userMsg =
+    Pages.Internal.Msg.Msg userMsg
+
+
+{-|
+
+    import PagesMsg exposing (PagesMsg)
+
+    type Msg
+        = ToggleMenu
+
+    view :
+        Maybe PageUrl
+        -> Shared.Model
+        -> Model
+        -> StaticPayload Data ActionData RouteParams
+        -> View (PagesMsg Msg)
+    view maybeUrl sharedModel model app =
+        { title = "My Page"
+        , view =
+            [ button
+                -- we need to wrap our Route module's `Msg` here so we have a `PagesMsg Msg`
+                [ onClick (PagesMsg.fromMsg ToggleMenu) ]
+                []
+
+            -- `Form.renderHtml` gives us `Html (PagesMsg msg)`, so we don't need to wrap its Msg type
+            , logoutForm
+                |> Form.toDynamicTransition "logout"
+                |> Form.withOnSubmit (\_ -> NewItemSubmitted)
+                |> Form.renderHtml [] (\_ -> Nothing) app Nothing
+            ]
+        }
+
+-}
+fromMsg : userMsg -> PagesMsg userMsg
+fromMsg userMsg =
+    Pages.Internal.Msg.UserMsg userMsg
+
+
+{-| A Msg that is handled by the elm-pages framework and does nothing. Helpful for when you don't want to register a callback.
+
+    import Browser.Dom as Dom
+    import PagesMsg exposing (PagesMsg)
+    import Task
+
+    resetViewport : Cmd (PagesMsg msg)
+    resetViewport =
+        Dom.setViewport 0 0
+            |> Task.perform (\() -> PagesMsg.noOp)
+
+-}
+noOp : PagesMsg userMsg
+noOp =
+    Pages.Internal.Msg.NoOp
+
+
+{-| -}
+map : (a -> b) -> PagesMsg a -> PagesMsg b
+map mapFn msg =
+    Pages.Internal.Msg.map mapFn msg
+
+
+{-| -}
+onSubmit : Attribute (PagesMsg userMsg)
+onSubmit =
+    Pages.Internal.Msg.onSubmit