dillonkearns/elm-pages
1
1
Fork 0
mirror of https://github.com/dillonkearns/elm-pages.git synced 2024-09-11 09:05:28 +03:00
Code Issues Packages Projects Releases Wiki Activity

Move Pages.Msg.Msg variants to internals, expose more high-level public API.

Browse Source
This commit is contained in:
Dillon Kearns 2023-02-28 11:52:18 -08:00
parent 8d7a6d873e
commit c418b536c0
7 changed files with 167 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
codegen/GenerateMain.elm
View File

@ -291,14 +291,14 @@ otherFile routes phaseString =
, model |> Elm.get "global"
, Elm.fn ( "myMsg", Nothing )
(\myMsg ->
Gen.Pages.Msg.make_.userMsg
Gen.Pages.Msg.fromMsg
(Elm.apply (Elm.val "MsgGlobal") [ myMsg ])
)
, Elm.apply
(Elm.value { importFrom = [ "View" ], name = "map", annotation = Nothing })
[ Elm.functionReduced "myMsg"
(\myMsg ->
Gen.Pages.Msg.make_.userMsg
Gen.Pages.Msg.fromMsg
(Elm.apply (Elm.val "MsgErrorPage____") [ myMsg ])
)
, Elm.apply
@ -357,7 +357,7 @@ otherFile routes phaseString =
, model |> Elm.get "global"
, Elm.fn ( "myMsg", Nothing )
(\myMsg ->
Gen.Pages.Msg.make_.userMsg
Gen.Pages.Msg.fromMsg
(Elm.apply (Elm.val "MsgGlobal") [ myMsg ])
)
, Elm.apply

2
docs.json
View File

File diff suppressed because one or more lines are too long

10
src/Form.elm
View File

@ -282,6 +282,7 @@ 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.Internal.Msg
import Pages.Msg
import Pages.Transition exposing (Transition(..))
import Path exposing (Path)
@ -1228,10 +1229,11 @@ 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)
-- TODO pass in options.onSubmit here
Pages.Internal.Msg.submitIfValid formId (\_ -> isValid)
]
++ attrs
)
@ -1265,11 +1267,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 formId (\_ -> isValid)
]
++ attrs
)

7
src/Pages/FormState.elm
View File

@ -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.Internal.Msg
import Pages.Msg
{-| -}
listeners : String -> List (Attribute (Pages.Msg.Msg 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
]

78
src/Pages/Internal/Msg.elm Normal file
View File

@ -0,0 +1,78 @@
module Pages.Internal.Msg exposing
( Msg(..)
, fetcherOnSubmit
, map
, onSubmit
, submitIfValid
)
import Form.FormData exposing (FormData)
import FormDecoder
import Html exposing (Attribute)
import Html.Attributes as Attr
import Json.Decode
{-| -}
type Msg userMsg
= UserMsg userMsg
| Submit FormData
| SubmitIfValid String FormData Bool
| SubmitFetcher String FormData Bool (Maybe userMsg)
| FormFieldEvent Json.Decode.Value
| NoOp
{-| -}
onSubmit : Attribute (Msg userMsg)
onSubmit =
FormDecoder.formDataOnSubmit
|> Attr.map Submit
{-| -}
submitIfValid : String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
submitIfValid formId isValid =
FormDecoder.formDataOnSubmit
|> Attr.map (\formData -> SubmitIfValid formId formData (isValid formData.fields))
{-| -}
fetcherOnSubmit : Maybe ({ fields : List ( String, String ) } -> userMsg) -> String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
fetcherOnSubmit userMsg formId isValid =
FormDecoder.formDataOnSubmit
|> Attr.map
(\formData ->
SubmitFetcher formId
formData
(isValid formData.fields)
(userMsg
|> Maybe.map
(\toUserMsg ->
toUserMsg { fields = formData.fields }
)
)
)
{-| -}
map : (a -> b) -> Msg a -> Msg b
map mapFn msg =
case msg of
UserMsg userMsg ->
UserMsg (mapFn userMsg)
Submit info ->
Submit info
SubmitIfValid formId info isValid ->
SubmitIfValid formId info isValid
SubmitFetcher formId info isValid toUserMsg ->
SubmitFetcher formId info isValid (Maybe.map mapFn toUserMsg)
FormFieldEvent value ->
FormFieldEvent value
NoOp ->
NoOp

18
src/Pages/Internal/Platform.elm
View File

@ -31,6 +31,7 @@ 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
@ -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 ->
if isValid then
( { model
-- TODO should I setSubmitAttempted here, too?
@ -530,7 +531,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,13 +554,13 @@ 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.Msg.NoOp ->
Pages.Internal.Msg.NoOp ->
( model, NoEffect )
UpdateCacheAndUrlNew scrollToTopWhenDone urlWithoutRedirectResolution maybeUserMsg updateResult ->
@ -980,7 +981,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
}
@ -1091,6 +1092,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
@ -1208,7 +1210,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
]

122
src/Pages/Msg.elm
View File

@ -1,83 +1,91 @@
module Pages.Msg exposing
( Msg(..)
, map, onSubmit, fetcherOnSubmit, submitIfValid
( Msg
, 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 `Pages.Msg.Msg` type.
@docs Msg
@docs map, onSubmit, fetcherOnSubmit, submitIfValid
You can wrap your Route Module's `Msg` using `fromMsg`.
@docs fromMsg
@docs map, noOp
@docs onSubmit
-}
import Form.FormData exposing (FormData)
import FormDecoder
import Html exposing (Attribute)
import Html.Attributes as Attr
import Json.Decode
import Pages.Internal.Msg
{-| -}
type Msg userMsg
= UserMsg userMsg
| Submit FormData
| SubmitIfValid String FormData Bool
| SubmitFetcher String FormData Bool (Maybe userMsg)
| FormFieldEvent Json.Decode.Value
| NoOp
type alias Msg userMsg =
Pages.Internal.Msg.Msg userMsg
{-| -}
onSubmit : Attribute (Msg userMsg)
onSubmit =
FormDecoder.formDataOnSubmit
|> Attr.map Submit
{-|
type Msg
= ToggleMenu
view :
Maybe PageUrl
-> Shared.Model
-> Model
-> StaticPayload Data ActionData RouteParams
-> View (Pages.Msg.Msg 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 `Pages.Msg.Msg Msg`
[ onClick (Pages.Msg.fromMsg ToggleMenu) ]
[]
-- `Form.renderHtml` gives us `Html (Pages.Msg.Msg 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 -> Msg userMsg
fromMsg userMsg =
Pages.Internal.Msg.UserMsg userMsg
{-| -}
submitIfValid : String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
submitIfValid formId isValid =
FormDecoder.formDataOnSubmit
|> Attr.map (\formData -> SubmitIfValid formId formData (isValid formData.fields))
{-| 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 Pages.Msg
import Task
{-| -}
fetcherOnSubmit : Maybe ({ fields : List ( String, String ) } -> userMsg) -> String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
fetcherOnSubmit userMsg formId isValid =
FormDecoder.formDataOnSubmit
|> Attr.map
(\formData ->
SubmitFetcher formId
formData
(isValid formData.fields)
(userMsg
|> Maybe.map
(\toUserMsg ->
toUserMsg { fields = formData.fields }
)
)
)
resetViewport : Cmd (Pages.Msg.Msg msg)
resetViewport =
Dom.setViewport 0 0
|> Task.perform (\() -> Pages.Msg.noOp)
-}
noOp : Msg userMsg
noOp =
Pages.Internal.Msg.NoOp
{-| -}
map : (a -> b) -> Msg a -> Msg b
map mapFn msg =
case msg of
UserMsg userMsg ->
UserMsg (mapFn userMsg)
Pages.Internal.Msg.map mapFn msg
Submit info ->
Submit info
SubmitIfValid formId info isValid ->
SubmitIfValid formId info isValid
SubmitFetcher formId info isValid toUserMsg ->
SubmitFetcher formId info isValid (Maybe.map mapFn toUserMsg)
FormFieldEvent value ->
FormFieldEvent value
NoOp ->
NoOp
{-| -}
onSubmit : Attribute (Msg userMsg)
onSubmit =
Pages.Internal.Msg.onSubmit