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

Add submit Cmd in Effect.perform.

Browse Source
This commit is contained in:
Dillon Kearns 2022-04-27 09:05:48 -07:00
parent 298faed45c
commit cfd78682fa
6 changed files with 129 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
examples/pokedex/app/Effect.elm
View File

@ -16,6 +16,12 @@ type Effect msg
, path : Maybe String
, toMsg : Result Http.Error Url -> msg
}
| Submit
{ values : List ( String, String )
, path : Maybe (List String)
, method : Maybe String
, toMsg : Result Http.Error Url -> msg
}
type alias RequestInfo =
@ -61,6 +67,14 @@ map fn effect =
, toMsg = fetchInfo.toMsg >> fn
}
Submit fetchInfo ->
Submit
{ values = fetchInfo.values
, path = fetchInfo.path
, method = fetchInfo.method
, toMsg = fetchInfo.toMsg >> fn
}
perform :
{ fetchRouteData :
@ -69,6 +83,14 @@ perform :
, toMsg : Result Http.Error Url -> pageMsg
}
-> Cmd msg
, submit :
{ values : List ( String, String )
, encType : Maybe String
, method : Maybe String
, path : Maybe String
, toMsg : Result Http.Error Url -> pageMsg
}
-> Cmd msg
, fromPageMsg : pageMsg -> msg
, key : Browser.Navigation.Key
}
@ -98,3 +120,12 @@ perform ({ fromPageMsg, key } as helpers) effect =
, path = fetchInfo.path
, toMsg = fetchInfo.toMsg
}
Submit record ->
helpers.submit
{ values = record.values
, path = Nothing --fetchInfo.path
, method = record.method
, encType = Nothing -- TODO
, toMsg = record.toMsg
}

20
examples/pokedex/app/Route/Todos.elm
View File

@ -41,8 +41,8 @@ type alias Model =
type Msg
= FormMsg Form.Msg
| NoOp
| FormSubmitted { contentType : String, body : String }
| DeleteFormSubmitted String { contentType : String, body : String }
| FormSubmitted (List ( String, String ))
| DeleteFormSubmitted String (List ( String, String ))
| SubmitComplete
@ -92,11 +92,12 @@ update pageUrl sharedModel static msg model =
NoOp ->
( model, Effect.none )
FormSubmitted info ->
FormSubmitted submitEvent ->
( { model | submitting = True }
, Effect.FetchRouteData
{ body = Just info
, Effect.Submit
{ values = submitEvent
, path = Nothing
, method = Just "POST"
, toMsg = \_ -> SubmitComplete
}
)
@ -104,14 +105,15 @@ update pageUrl sharedModel static msg model =
SubmitComplete ->
( { model | submitting = False }, Effect.none )
DeleteFormSubmitted id record ->
DeleteFormSubmitted id submitEvent ->
( { model
| deleting = model.deleting |> Set.insert id
}
, Effect.FetchRouteData
{ body = Just record
, Effect.Submit
{ values = submitEvent
, path = Nothing
, toMsg = \_ -> NoOp
, method = Just "POST"
, toMsg = \_ -> SubmitComplete
}
)

113
src/Form.elm
View File

@ -169,45 +169,6 @@ fieldStatusToString fieldStatus =
"Blurred"
http : String -> Form msg error value view -> Model -> Cmd (Result Http.Error (FieldState String))
http url_ (Form _ _ _ _) model =
Http.request
{ method = "POST"
, headers =
[ Http.header "accept" "application/json"
]
, body =
model.fields
|> Dict.toList
|> List.map
(\( name, { raw } ) ->
Url.percentEncode name
++ "="
++ Url.percentEncode
(raw |> Maybe.withDefault "")
)
|> String.join "&"
|> Http.stringBody "application/x-www-form-urlencoded"
, expect =
Http.expectJson identity
(Decode.dict
(Decode.map2
(\raw errors ->
{ raw = raw
, errors = errors
, status = NotVisited
}
)
(Decode.field "raw" (Decode.nullable Decode.string))
(Decode.field "errors" (Decode.list Decode.string))
)
)
, timeout = Nothing
, tracker = Nothing
, url = url_
}
{-| -}
type Form msg error value view
= Form
@ -233,6 +194,13 @@ type Form msg error value view
(FieldState error -> Result (List ( String, List error )) ( value, List ( String, List error ) ))
type alias FormConfig =
-- TODO wire this up as a param in `Form` type
{ method : Maybe String
, url : Maybe String
}
{-| -}
type Field msg error value view constraints
= Field (FieldInfo msg error value view)
@ -522,11 +490,14 @@ update toMsg onResponse ((Form _ _ _ modelToValue) as form) msg model =
( { model | isSubmitting = Submitting }
-- TODO use Effect.submit
-- TODO remove hardcoded "/tailwind-form"
, http "/tailwind-form" form model |> Cmd.map GotFormResponse |> Cmd.map toMsg
-- TODO use `effect` instead of `Cmd` - let user pass in effect for submit
, Cmd.none
-- http "/tailwind-form" form model |> Cmd.map GotFormResponse |> Cmd.map toMsg
)
GotFormResponse result ->
let
-- TODO pass in the callback to the perform function passed in by user
responseTask : Cmd msg
responseTask =
Task.succeed () |> Task.perform (\() -> onResponse result)
@ -1832,7 +1803,7 @@ simplify3 field =
{-| -}
toHtml :
{ onSubmit : Maybe ({ contentType : String, body : String } -> msg)
{ onSubmit : Maybe (List ( String, String ) -> msg)
, onFormMsg : Maybe (Msg -> msg)
}
-> (List (Html.Attribute msg) -> List view -> view)
@ -1849,25 +1820,41 @@ toHtml config toForm serverValidationErrors (Form fields _ _ _) =
([ [ Attr.method "POST" ]
, [ Attr.novalidate True |> Just
-- TODO wire up SubmitForm Msg
--, Html.Events.onSubmit SubmitForm |> Just
, config.onSubmit
|> Maybe.map
(\onSubmit ->
FormDecoder.formDataOnSubmit
|> Attr.map
(\formFields_ ->
onSubmit
{ contentType = "application/x-www-form-urlencoded"
, body =
formFields_
|> List.map
(\( name, value ) ->
Url.percentEncode name ++ "=" ++ Url.percentEncode value
)
|> String.join "&"
}
)
case config.onFormMsg of
Just onFormMsg ->
--FormDecoder.formDataOnSubmit |> Attr.map onSubmit
-- TODO need to run both the user's `onSubmit` as well as the internal Form.Msg here
-- How to do both???
FormDecoder.formDataOnSubmit |> Attr.map (\_ -> onFormMsg SubmitForm)
--onSubmit
Nothing ->
FormDecoder.formDataOnSubmit |> Attr.map onSubmit
)
--, config.onSubmit
-- |> Maybe.map
-- (\onSubmit ->
-- FormDecoder.formDataOnSubmit
-- |> Attr.map
-- (\formFields_ ->
-- onSubmit
-- { contentType = "application/x-www-form-urlencoded"
-- , body =
-- formFields_
-- |> List.map
-- (\( name, value ) ->
-- Url.percentEncode name ++ "=" ++ Url.percentEncode value
-- )
-- |> String.join "&"
-- }
-- )
-- )
]
|> List.filterMap identity
]
@ -1948,13 +1935,13 @@ apiHandler (Form _ decoder serverValidations _) =
)
)
(Request.expectFormPost
(\{ optionalField } ->
decoder (\string -> optionalField string)
(\{ field } ->
decoder (\string -> field string |> Request.map Just)
)
)
(Request.expectFormPost
(\{ optionalField } ->
serverValidations (\string -> optionalField string)
(\{ field } ->
serverValidations (\string -> field string |> Request.map Just)
)
)
|> Request.acceptContentTypes (List.NonEmpty.singleton "application/json")
@ -1992,13 +1979,13 @@ toRequest2 ((Form _ decoder serverValidations modelToValue) as form) =
)
)
(Request.expectFormPost
(\{ optionalField } ->
decoder (\fieldName -> optionalField fieldName)
(\{ field } ->
decoder (\fieldName -> field fieldName |> Request.map Just)
)
)
(Request.expectFormPost
(\{ optionalField } ->
serverValidations (\string -> optionalField string)
(\{ field } ->
serverValidations (\string -> field string |> Request.map Just)
|> Request.map
(DataSource.map
(\thing ->

16
src/FormDecoder.elm
View File

@ -1,9 +1,10 @@
module FormDecoder exposing (formDataOnSubmit)
module FormDecoder exposing (encodeFormData, formDataOnSubmit)
import Html
import Html.Events
import Json.Decode as Decode
import Json.Encode
import Url
formDataOnSubmit : Html.Attribute (List ( String, String ))
@ -44,3 +45,16 @@ tuplesDecoder =
(Decode.index 0 Decode.string)
(Decode.index 1 Decode.string)
)
encodeFormData : List ( String, String ) -> { contentType : String, body : String }
encodeFormData formFields_ =
{ contentType = "application/x-www-form-urlencoded"
, body =
formFields_
|> List.map
(\( name, value ) ->
Url.percentEncode name ++ "=" ++ Url.percentEncode value
)
|> String.join "&"
}

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

@ -17,6 +17,7 @@ import Browser.Navigation
import BuildError exposing (BuildError)
import Bytes exposing (Bytes)
import Bytes.Decode
import FormDecoder
import Html exposing (Html)
import Html.Attributes as Attr
import Http
@ -656,6 +657,19 @@ perform config currentUrl maybeKey effect =
fetchRouteData -1 (prepare fetchInfo.toMsg) config currentUrl fetchInfo.body
-- TODO map the Msg with the wrapper type (like in the PR branch)
, submit =
\fetchInfo ->
let
urlToSubmitTo : Url
urlToSubmitTo =
case fetchInfo.path of
Just path ->
{ currentUrl | path = path }
Nothing ->
currentUrl
in
fetchRouteData -1 (prepare fetchInfo.toMsg) config urlToSubmitTo (Just (FormDecoder.encodeFormData fetchInfo.values))
, fromPageMsg = UserMsg
, key = key
}

8
src/Pages/ProgramConfig.elm
View File

@ -95,6 +95,14 @@ type alias ProgramConfig userMsg userModel route pageData sharedData effect mapp
, toMsg : Result Http.Error Url -> userMsg
}
-> Cmd mappedMsg
, submit :
{ values : List ( String, String )
, encType : Maybe String
, method : Maybe String
, path : Maybe String
, toMsg : Result Http.Error Url -> userMsg
}
-> Cmd mappedMsg
, fromPageMsg : userMsg -> mappedMsg
, key : Browser.Navigation.Key
}