mirror of
https://github.com/dillonkearns/elm-pages-v3-beta.git
synced 2024-11-26 04:31:39 +03:00
More wiring for form integration prototype.
This commit is contained in:
Dillon Kearns
parent
a3f9b98409
commit
8275f4e447
@ -237,7 +237,7 @@ otherFile routes phaseString =
|
||||
}
|
||||
view =
|
||||
Elm.Declare.function "view"
|
||||
[ ( "pageFormState", Gen.Pages.FormState.annotation_.pageFormState |> Just )
|
||||
[ ( "pageFormState", Type.named [ "Form" ] "Model" |> Just )
|
||||
, ( "fetchers"
|
||||
, Gen.Dict.annotation_.dict Type.string
|
||||
(Gen.Pages.Transition.annotation_.fetcherState (Type.named [] "ActionData"))
|
||||
@ -914,7 +914,7 @@ otherFile routes phaseString =
|
||||
}
|
||||
update =
|
||||
Elm.Declare.function "update"
|
||||
[ ( "pageFormState", Type.named [ "Pages", "FormState" ] "PageFormState" |> Just )
|
||||
[ ( "pageFormState", Type.named [ "Form" ] "Model" |> Just )
|
||||
, ( "fetchers"
|
||||
, Gen.Dict.annotation_.dict
|
||||
Type.string
|
||||
|
||||
@ -12,16 +12,17 @@ import Date exposing (Date)
|
||||
import Effect
|
||||
import ErrorPage
|
||||
import FatalError
|
||||
import Form
|
||||
import Form exposing (Validated(..))
|
||||
import Form.Field
|
||||
import Form.FieldView
|
||||
import Form.Handler
|
||||
import Form.Validation
|
||||
import Form.Value
|
||||
import Head
|
||||
import Html exposing (Html)
|
||||
import Html.Attributes
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
import Json.Encode as Encode
|
||||
import Pages.Form
|
||||
import PagesMsg exposing (PagesMsg)
|
||||
import Path
|
||||
import Platform.Sub
|
||||
@ -93,7 +94,7 @@ type alias Data =
|
||||
|
||||
|
||||
type alias ActionData =
|
||||
{ errors : Form.Response String }
|
||||
{ errors : Form.ServerResponse String }
|
||||
|
||||
|
||||
data :
|
||||
@ -151,13 +152,21 @@ view app shared model =
|
||||
, body =
|
||||
[ Html.h2 [] [ Html.text "Form" ]
|
||||
, form
|
||||
|> Form.renderHtml "form" [] (Just << .errors) app app.data.post
|
||||
|> Pages.Form.renderHtml "form"
|
||||
[]
|
||||
--(Just << .errors)
|
||||
app
|
||||
app.data.post
|
||||
, if app.routeParams.slug == "new" then
|
||||
Html.text ""
|
||||
|
||||
else
|
||||
deleteForm
|
||||
|> Form.renderHtml "delete" [] (\_ -> Nothing) app ()
|
||||
|> Pages.Form.renderHtml "delete"
|
||||
[]
|
||||
--(\_ -> Nothing)
|
||||
app
|
||||
()
|
||||
]
|
||||
}
|
||||
|
||||
@ -169,7 +178,7 @@ action routeParams =
|
||||
Server.Request.map
|
||||
(\( formResponse, parsedForm ) ->
|
||||
case parsedForm of
|
||||
Ok Delete ->
|
||||
Valid Delete ->
|
||||
BackendTask.Custom.run "deletePost"
|
||||
(Encode.object
|
||||
[ ( "slug", Encode.string routeParams.slug )
|
||||
@ -182,7 +191,7 @@ action routeParams =
|
||||
Route.redirectTo Route.Index
|
||||
)
|
||||
|
||||
Ok (CreateOrEdit okForm) ->
|
||||
Valid (CreateOrEdit okForm) ->
|
||||
let
|
||||
createPost : Bool
|
||||
createPost =
|
||||
@ -214,7 +223,7 @@ action routeParams =
|
||||
(Route.Admin__Slug_ { slug = okForm.slug })
|
||||
)
|
||||
|
||||
Err invalidForm ->
|
||||
Invalid _ invalidForm ->
|
||||
BackendTask.succeed
|
||||
(Server.Response.render
|
||||
{ errors = formResponse }
|
||||
@ -223,7 +232,10 @@ action routeParams =
|
||||
(Server.Request.formData formHandlers)
|
||||
|
||||
|
||||
form : Form.HtmlForm String Post Post Msg
|
||||
|
||||
--form : Form.HtmlForm String Post Post Msg
|
||||
|
||||
|
||||
form =
|
||||
(\title slug body publish ->
|
||||
{ combine =
|
||||
@ -253,25 +265,24 @@ form =
|
||||
]
|
||||
}
|
||||
)
|
||||
|> Form.init
|
||||
|> Form.form
|
||||
|> Form.hiddenKind ( "kind", "create-or-edit" ) "Expected create-or-edit"
|
||||
|> Form.field "title"
|
||||
(Form.Field.required "Required" Form.Field.text
|
||||
|> Form.Field.withInitialValue (.title >> Form.Value.string)
|
||||
|> Form.Field.withInitialValue .title
|
||||
)
|
||||
|> Form.field "slug"
|
||||
(Form.Field.required "Required" Form.Field.text
|
||||
|> Form.Field.withInitialValue (.slug >> Form.Value.string)
|
||||
|> Form.Field.withInitialValue .slug
|
||||
)
|
||||
|> Form.field "body"
|
||||
(Form.Field.required "Required" Form.Field.text
|
||||
|> Form.Field.textarea { rows = Just 10, cols = Just 80 }
|
||||
|> Form.Field.withInitialValue (.body >> Form.Value.string)
|
||||
|> Form.Field.withInitialValue .body
|
||||
)
|
||||
|> Form.field "publish"
|
||||
(Form.Field.date { invalid = \_ -> "Invalid date." }
|
||||
|> Form.Field.withOptionalInitialValue
|
||||
(.publish >> Maybe.map Form.Value.date)
|
||||
|> Form.Field.withOptionalInitialValue .publish
|
||||
)
|
||||
|
||||
|
||||
@ -280,16 +291,19 @@ type Action
|
||||
| CreateOrEdit Post
|
||||
|
||||
|
||||
formHandlers : Form.ServerForms String Action
|
||||
formHandlers : Form.Handler.Handler String Action
|
||||
formHandlers =
|
||||
deleteForm
|
||||
|> Form.initCombined (\() -> Delete)
|
||||
|> Form.combine CreateOrEdit form
|
||||
|> Form.Handler.init (\() -> Delete)
|
||||
|> Form.Handler.with CreateOrEdit form
|
||||
|
||||
|
||||
|
||||
--deleteForm : Form.HtmlForm String () input (PagesMsg Msg)
|
||||
|
||||
|
||||
deleteForm : Form.HtmlForm String () input Msg
|
||||
deleteForm =
|
||||
Form.init
|
||||
Form.form
|
||||
{ combine = Form.Validation.succeed ()
|
||||
, view =
|
||||
\formState ->
|
||||
@ -305,9 +319,9 @@ deleteForm =
|
||||
|> Form.hiddenKind ( "kind", "delete" ) "Expected delete"
|
||||
|
||||
|
||||
buttonWithTransition : List (Html.Attribute msg) -> String -> String -> { a | isTransitioning : Bool } -> Html msg
|
||||
buttonWithTransition : List (Html.Attribute msg) -> String -> String -> { a | submitting : Bool } -> Html msg
|
||||
buttonWithTransition attributes initialText transitioningText formState =
|
||||
if formState.isTransitioning then
|
||||
if formState.submitting then
|
||||
Html.button
|
||||
(attributes
|
||||
++ [ Html.Attributes.disabled True
|
||||
|
||||
@ -9,8 +9,8 @@ import FatalError exposing (FatalError)
|
||||
import Form
|
||||
import Form.Field as Field
|
||||
import Form.FieldView as FieldView
|
||||
import Form.Handler
|
||||
import Form.Validation as Validation
|
||||
import Form.Value
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Keyed as Keyed
|
||||
@ -352,7 +352,7 @@ view app shared model =
|
||||
|
||||
_ ->
|
||||
allForms
|
||||
|> Form.runOneOfServerSide payload.fields
|
||||
|> Form.Handler.run payload.fields
|
||||
|> Tuple.first
|
||||
)
|
||||
|
||||
@ -471,7 +471,7 @@ view app shared model =
|
||||
(\( key, { status, payload } ) ->
|
||||
case
|
||||
( allForms
|
||||
|> Form.runOneOfServerSide payload.fields
|
||||
|> Form.Handler.run payload.fields
|
||||
|> Tuple.first
|
||||
, status
|
||||
)
|
||||
@ -531,20 +531,20 @@ view app shared model =
|
||||
-- FORMS
|
||||
|
||||
|
||||
allForms : Form.ServerForms String Action
|
||||
allForms : Form.Handler.Handler String Action
|
||||
allForms =
|
||||
editItemForm
|
||||
|> Form.initCombined UpdateEntry
|
||||
|> Form.combine Add addItemForm
|
||||
|> Form.combine Check checkItemForm
|
||||
|> Form.combine Delete deleteItemForm
|
||||
|> Form.combine (\_ -> DeleteComplete) clearCompletedForm
|
||||
|> Form.combine CheckAll toggleAllForm
|
||||
|> Form.Handler.init UpdateEntry
|
||||
|> Form.Handler.with Add addItemForm
|
||||
|> Form.Handler.with Check checkItemForm
|
||||
|> Form.Handler.with Delete deleteItemForm
|
||||
|> Form.Handler.with (\_ -> DeleteComplete) clearCompletedForm
|
||||
|> Form.Handler.with CheckAll toggleAllForm
|
||||
|
||||
|
||||
addItemForm : Form.HtmlForm String String (Maybe String) Msg
|
||||
addItemForm =
|
||||
Form.init
|
||||
Form.form
|
||||
(\description ->
|
||||
{ combine =
|
||||
Validation.succeed identity
|
||||
@ -571,7 +571,7 @@ addItemForm =
|
||||
|
||||
editItemForm : Form.HtmlForm String ( String, String ) Entry Msg
|
||||
editItemForm =
|
||||
Form.init
|
||||
Form.form
|
||||
(\itemId description ->
|
||||
{ combine =
|
||||
Validation.succeed Tuple.pair
|
||||
@ -603,7 +603,7 @@ editItemForm =
|
||||
|
||||
deleteItemForm : Form.HtmlForm String String Entry Msg
|
||||
deleteItemForm =
|
||||
Form.init
|
||||
Form.form
|
||||
(\todoId ->
|
||||
{ combine =
|
||||
Validation.succeed identity
|
||||
@ -623,7 +623,7 @@ deleteItemForm =
|
||||
|
||||
toggleAllForm : Form.HtmlForm String Bool { allCompleted : Bool } Msg
|
||||
toggleAllForm =
|
||||
Form.init
|
||||
Form.form
|
||||
(\toggleTo ->
|
||||
{ combine =
|
||||
Validation.succeed identity
|
||||
@ -656,7 +656,7 @@ toggleAllForm =
|
||||
|
||||
checkItemForm : Form.HtmlForm String ( Bool, String ) Entry Msg
|
||||
checkItemForm =
|
||||
Form.init
|
||||
Form.form
|
||||
(\todoId complete ->
|
||||
{ combine =
|
||||
Validation.succeed Tuple.pair
|
||||
@ -688,7 +688,7 @@ checkItemForm =
|
||||
|
||||
clearCompletedForm : Form.HtmlForm String () { entriesCompleted : Int } Msg
|
||||
clearCompletedForm =
|
||||
Form.init
|
||||
Form.form
|
||||
{ combine = Validation.succeed ()
|
||||
, view =
|
||||
\formState ->
|
||||
|
||||
@ -103,4 +103,14 @@ function find_anchor(node) {
|
||||
return /** @type {HTMLAnchorElement} */ (node);
|
||||
}
|
||||
|
||||
Object.defineProperty(SubmitEvent.prototype, "fields", {
|
||||
get: function fields() {
|
||||
let formData = new FormData(this.currentTarget);
|
||||
if (this.submitter?.name) {
|
||||
formData.append(this.submitter.name, this.submitter.value);
|
||||
}
|
||||
return [...formData.entries()];
|
||||
},
|
||||
});
|
||||
|
||||
setup();
|
||||
|
||||
117
src/Form.elm
117
src/Form.elm
@ -13,6 +13,7 @@ module Form exposing
|
||||
, Msg, Model, init, update
|
||||
, Validated(..)
|
||||
, ServerResponse
|
||||
, map
|
||||
, mapMsg
|
||||
-- subGroup
|
||||
|
||||
@ -273,6 +274,8 @@ in the user's workflow to show validation errors.
|
||||
|
||||
@docs ServerResponse
|
||||
|
||||
@docs map
|
||||
|
||||
-}
|
||||
|
||||
import Dict exposing (Dict)
|
||||
@ -741,13 +744,8 @@ hiddenKind ( name, value ) error_ (Internal.Form.Form options definitions parseF
|
||||
|> myFn
|
||||
)
|
||||
(\input ->
|
||||
case fieldParser.initialValue input of
|
||||
Just initialValue ->
|
||||
( name, Just initialValue )
|
||||
:: toInitialValues input
|
||||
|
||||
Nothing ->
|
||||
toInitialValues input
|
||||
( name, Just value )
|
||||
:: toInitialValues input
|
||||
)
|
||||
|
||||
|
||||
@ -870,8 +868,9 @@ unwrapValidation (Pages.Internal.Form.Validation _ _ ( maybeParsed, errors )) =
|
||||
|
||||
{-| -}
|
||||
renderHtml :
|
||||
String
|
||||
-> List (Html.Attribute (Msg msg))
|
||||
(Msg msg -> mappedMsg)
|
||||
-> String
|
||||
-> List (Html.Attribute mappedMsg)
|
||||
->
|
||||
{ submitting : Bool
|
||||
, serverResponse : Maybe (ServerResponse error)
|
||||
@ -882,14 +881,20 @@ renderHtml :
|
||||
Form
|
||||
error
|
||||
{ combine : Form.Validation.Validation error parsed named constraints
|
||||
, view : Context error input -> List (Html (Msg msg))
|
||||
, view : Context error input -> List (Html mappedMsg)
|
||||
}
|
||||
parsed
|
||||
input
|
||||
msg
|
||||
-> Html (Msg msg)
|
||||
renderHtml formId attrs app input form_ =
|
||||
Html.Lazy.lazy5 renderHelper formId attrs app input form_
|
||||
mappedMsg
|
||||
-> Html mappedMsg
|
||||
renderHtml liftMsg formId attrs app input form_ =
|
||||
Html.Lazy.lazy6 renderHelper
|
||||
liftMsg
|
||||
formId
|
||||
attrs
|
||||
app
|
||||
input
|
||||
form_
|
||||
|
||||
|
||||
{-| -}
|
||||
@ -930,7 +935,7 @@ withOnSubmit onSubmit (Internal.Form.Form options a b c) =
|
||||
{-| -}
|
||||
renderStyledHtml :
|
||||
String
|
||||
-> List (Html.Styled.Attribute (Msg msg))
|
||||
-> List (Html.Styled.Attribute msg)
|
||||
->
|
||||
{ submitting : Bool
|
||||
, serverResponse : Maybe (ServerResponse error)
|
||||
@ -941,7 +946,7 @@ renderStyledHtml :
|
||||
Form
|
||||
error
|
||||
{ combine : Form.Validation.Validation error parsed field constraints
|
||||
, view : Context error input -> List (Html.Styled.Html (Msg msg))
|
||||
, view : Context error input -> List (Html.Styled.Html msg)
|
||||
}
|
||||
parsed
|
||||
input
|
||||
@ -969,8 +974,9 @@ type alias ServerResponse error =
|
||||
|
||||
|
||||
renderHelper :
|
||||
String
|
||||
-> List (Html.Attribute (Msg msg))
|
||||
(Msg msg -> mappedMsg)
|
||||
-> String
|
||||
-> List (Html.Attribute mappedMsg)
|
||||
---> (actionData -> Maybe (ServerResponse error))
|
||||
-> AppContext error
|
||||
-> input
|
||||
@ -978,26 +984,26 @@ renderHelper :
|
||||
Form
|
||||
error
|
||||
{ combine : Form.Validation.Validation error parsed named constraints
|
||||
, view : Context error input -> List (Html (Msg msg))
|
||||
, view : Context error input -> List (Html mappedMsg)
|
||||
}
|
||||
parsed
|
||||
input
|
||||
msg
|
||||
-> Html (Msg msg)
|
||||
renderHelper formId attrs formState input ((Internal.Form.Form options _ _ _) as form_) =
|
||||
mappedMsg
|
||||
-> Html mappedMsg
|
||||
renderHelper liftMsg formId attrs formState input ((Internal.Form.Form options _ _ _) as 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?
|
||||
let
|
||||
{ hiddenInputs, children, parsed, fields, errors } =
|
||||
helperValues formId toHiddenInput formState input form_
|
||||
|
||||
toHiddenInput : List (Html.Attribute (Msg msg)) -> Html (Msg msg)
|
||||
toHiddenInput : List (Html.Attribute mappedMsg) -> Html mappedMsg
|
||||
toHiddenInput hiddenAttrs =
|
||||
Html.input hiddenAttrs []
|
||||
in
|
||||
Html.form
|
||||
((Form.listeners formId
|
||||
|> List.map (Attr.map Internal.FieldEvent.FormFieldEvent)
|
||||
|> List.map (Attr.map (Internal.FieldEvent.FormFieldEvent >> liftMsg))
|
||||
)
|
||||
++ [ Attr.method (Internal.Form.methodToString options.method)
|
||||
, Attr.novalidate True
|
||||
@ -1012,22 +1018,24 @@ renderHelper formId attrs formState input ((Internal.Form.Form options _ _ _) as
|
||||
-- TransitionStrategy ->
|
||||
-- Pages.Internal.Msg.submitIfValid options.onSubmit formId (\_ -> isValid)
|
||||
]
|
||||
++ [ Internal.FieldEvent.formDataOnSubmit
|
||||
++ [ let
|
||||
-- TODO include this msg
|
||||
maybeFormMsg formDataThing =
|
||||
options.onSubmit
|
||||
|> Maybe.map
|
||||
(\onSubmit ->
|
||||
onSubmit
|
||||
{ fields = formDataThing.fields |> Maybe.withDefault fields
|
||||
, parsed = ( parsed, errors )
|
||||
}
|
||||
--|> Internal.FieldEvent.UserMsg
|
||||
)
|
||||
in
|
||||
Internal.FieldEvent.formDataOnSubmit
|
||||
|> Attr.map
|
||||
(\formDataThing ->
|
||||
let
|
||||
msgThing : Maybe msg
|
||||
msgThing =
|
||||
options.onSubmit
|
||||
|> Maybe.map
|
||||
(\onSubmit ->
|
||||
onSubmit
|
||||
{ fields = formDataThing.fields |> Maybe.withDefault fields
|
||||
, parsed = ( parsed, errors )
|
||||
}
|
||||
)
|
||||
in
|
||||
Internal.FieldEvent.Submit formDataThing msgThing
|
||||
Internal.FieldEvent.Submit formDataThing Nothing
|
||||
|> liftMsg
|
||||
)
|
||||
]
|
||||
++ attrs
|
||||
@ -1037,14 +1045,14 @@ renderHelper formId attrs formState input ((Internal.Form.Form options _ _ _) as
|
||||
|
||||
renderStyledHelper :
|
||||
String
|
||||
-> List (Html.Styled.Attribute (Msg msg))
|
||||
-> List (Html.Styled.Attribute msg)
|
||||
-> AppContext error
|
||||
-> input
|
||||
->
|
||||
Form
|
||||
error
|
||||
{ combine : Form.Validation.Validation error parsed field constraints
|
||||
, view : Context error input -> List (Html.Styled.Html (Msg msg))
|
||||
, view : Context error input -> List (Html.Styled.Html msg)
|
||||
}
|
||||
parsed
|
||||
input
|
||||
@ -1057,7 +1065,7 @@ renderStyledHelper formId attrs formState input ((Internal.Form.Form options _ _
|
||||
{ hiddenInputs, children, parsed, fields, errors } =
|
||||
helperValues formId toHiddenInput formState input form_
|
||||
|
||||
toHiddenInput : List (Html.Attribute (Msg msg)) -> Html.Styled.Html (Msg msg)
|
||||
toHiddenInput : List (Html.Attribute msg) -> Html.Styled.Html msg
|
||||
toHiddenInput hiddenAttrs =
|
||||
Html.Styled.input (hiddenAttrs |> List.map StyledAttr.fromUnstyled) []
|
||||
in
|
||||
@ -1100,14 +1108,14 @@ renderStyledHelper formId attrs formState input ((Internal.Form.Form options _ _
|
||||
)
|
||||
|> StyledAttr.fromUnstyled
|
||||
]
|
||||
++ attrs
|
||||
++ (attrs |> List.map (StyledAttr.map Internal.FieldEvent.UserMsg))
|
||||
)
|
||||
(hiddenInputs ++ children)
|
||||
((hiddenInputs ++ children) |> List.map (Html.Styled.map Internal.FieldEvent.UserMsg))
|
||||
|
||||
|
||||
helperValues :
|
||||
String
|
||||
-> (List (Html.Attribute (Msg msg)) -> view)
|
||||
-> (List (Html.Attribute mappedMsg) -> view)
|
||||
-> AppContext error
|
||||
-> input
|
||||
->
|
||||
@ -1118,7 +1126,7 @@ helperValues :
|
||||
}
|
||||
parsed
|
||||
input
|
||||
msg
|
||||
mappedMsg
|
||||
-> { hiddenInputs : List view, children : List view, isValid : Bool, parsed : Maybe parsed, fields : List ( String, String ), errors : Dict String (List error) }
|
||||
helperValues formId toHiddenInput formState input (Internal.Form.Form _ fieldDefinitions parser toInitialValues) =
|
||||
let
|
||||
@ -1309,7 +1317,7 @@ type alias HtmlForm error parsed input msg =
|
||||
Form
|
||||
error
|
||||
{ combine : Combined error parsed
|
||||
, view : Context error input -> List (Html (Msg msg))
|
||||
, view : Context error input -> List (Html msg)
|
||||
}
|
||||
parsed
|
||||
input
|
||||
@ -1321,7 +1329,7 @@ type alias StyledHtmlForm error parsed input msg =
|
||||
Form
|
||||
error
|
||||
{ combine : Combined error parsed
|
||||
, view : Context error input -> List (Html.Styled.Html (Msg msg))
|
||||
, view : Context error input -> List (Html.Styled.Html msg)
|
||||
}
|
||||
parsed
|
||||
input
|
||||
@ -1333,6 +1341,21 @@ type alias Form error combineAndView parsed input userMsg =
|
||||
Internal.Form.Form error combineAndView parsed input userMsg
|
||||
|
||||
|
||||
{-| -}
|
||||
map : (msg -> mappedMsg) -> Form error combineAndView parsed input msg -> Form error combineAndView parsed input mappedMsg
|
||||
map mapFn (Internal.Form.Form a b c d) =
|
||||
Internal.Form.Form
|
||||
{ method = a.method
|
||||
, onSubmit =
|
||||
Maybe.map
|
||||
(\onSubmit -> onSubmit >> mapFn)
|
||||
a.onSubmit
|
||||
}
|
||||
b
|
||||
c
|
||||
d
|
||||
|
||||
|
||||
{-| -}
|
||||
addErrorsInternal : String -> List error -> Dict String (List error) -> Dict String (List error)
|
||||
addErrorsInternal name newErrors allErrors =
|
||||
|
||||
91
src/Pages/Form.elm
Normal file
91
src/Pages/Form.elm
Normal file
@ -0,0 +1,91 @@
|
||||
module Pages.Form exposing (renderHtml)
|
||||
|
||||
import Dict exposing (Dict)
|
||||
import Form
|
||||
import Form.Validation exposing (Validation)
|
||||
import Html
|
||||
import Pages.Internal.Msg
|
||||
import Pages.Transition
|
||||
import PagesMsg exposing (PagesMsg)
|
||||
|
||||
|
||||
renderHtml :
|
||||
String
|
||||
-> List (Html.Attribute (PagesMsg userMsg))
|
||||
->
|
||||
--{ submitting : Bool, serverResponse : Maybe (Form.ServerResponse error), state : Form.Model }
|
||||
{ --path : Path
|
||||
--, url : Maybe PageUrl
|
||||
--, action : Maybe action
|
||||
app
|
||||
| pageFormState : Form.Model
|
||||
, transition : Maybe Pages.Transition.Transition
|
||||
, fetchers : Dict String (Pages.Transition.FetcherState (Maybe action))
|
||||
}
|
||||
-> input
|
||||
-> Form.Form error { combine : Validation error parsed named constraints, view : Form.Context error input -> List (Html.Html (PagesMsg userMsg)) } parsed input (PagesMsg userMsg)
|
||||
-> Html.Html (PagesMsg userMsg)
|
||||
renderHtml formId attrs app input form_ =
|
||||
(form_
|
||||
|> Form.withOnSubmit
|
||||
(\{ fields, parsed } ->
|
||||
case parsed of
|
||||
Form.Valid _ ->
|
||||
Pages.Internal.Msg.Submit
|
||||
{ useFetcher = False
|
||||
, fields = fields
|
||||
, msg = Nothing
|
||||
, id = formId
|
||||
, valid = True
|
||||
}
|
||||
|
||||
Form.Invalid _ _ ->
|
||||
Pages.Internal.Msg.Submit
|
||||
{ useFetcher = False
|
||||
, fields = fields
|
||||
, msg = Nothing
|
||||
, id = formId
|
||||
, valid = True
|
||||
}
|
||||
)
|
||||
)
|
||||
|> Form.renderHtml Pages.Internal.Msg.FormMsg
|
||||
formId
|
||||
attrs
|
||||
{ state = app.pageFormState
|
||||
, serverResponse = Nothing -- TODO
|
||||
, submitting =
|
||||
(case app.fetchers |> Dict.get formId of
|
||||
Just { status } ->
|
||||
case status of
|
||||
Pages.Transition.FetcherComplete _ ->
|
||||
False
|
||||
|
||||
Pages.Transition.FetcherSubmitting ->
|
||||
True
|
||||
|
||||
Pages.Transition.FetcherReloading _ ->
|
||||
True
|
||||
|
||||
Nothing ->
|
||||
False
|
||||
)
|
||||
|| (case app.transition of
|
||||
Just (Pages.Transition.Submitting formData) ->
|
||||
formData.id == Just formId
|
||||
|
||||
Just (Pages.Transition.LoadAfterSubmit submitData _ _) ->
|
||||
submitData.id == Just formId
|
||||
|
||||
Just (Pages.Transition.Loading _ _) ->
|
||||
False
|
||||
|
||||
Nothing ->
|
||||
False
|
||||
)
|
||||
}
|
||||
input
|
||||
|
||||
|
||||
|
||||
-- TODO renderStyledHtml
|
||||
@ -14,6 +14,7 @@ module Pages.Internal.Msg exposing
|
||||
import Form
|
||||
import Html exposing (Attribute)
|
||||
import Html.Attributes as Attr
|
||||
import Internal.FieldEvent
|
||||
import Json.Decode
|
||||
|
||||
|
||||
@ -23,7 +24,7 @@ type Msg userMsg
|
||||
| Submit { valid : Bool, fields : List ( String, String ), id : String, msg : Maybe userMsg, useFetcher : Bool }
|
||||
--| SubmitIfValid String FormData Bool (Maybe userMsg)
|
||||
--| SubmitFetcher String FormData Bool (Maybe userMsg)
|
||||
| FormMsg (Form.Msg userMsg)
|
||||
| FormMsg (Internal.FieldEvent.Msg userMsg)
|
||||
| NoOp
|
||||
|
||||
|
||||
|
||||
@ -510,10 +510,20 @@ update config appMsg model =
|
||||
Just
|
||||
( -- TODO remove hardcoded number
|
||||
-1
|
||||
, Pages.Transition.Submitting fields
|
||||
, Pages.Transition.Submitting
|
||||
{ fields = fields.fields
|
||||
, method = Post -- TODO
|
||||
, action = "" -- TODO
|
||||
, id = Just fields.id
|
||||
}
|
||||
)
|
||||
}
|
||||
, Submit fields
|
||||
, Submit
|
||||
{ fields = fields.fields
|
||||
, method = Post -- TODO
|
||||
, action = "" -- TODO
|
||||
, id = Just fields.id
|
||||
}
|
||||
)
|
||||
|
||||
--Pages.Internal.Msg.SubmitIfValid formId fields isValid maybeUserMsg ->
|
||||
@ -1002,7 +1012,11 @@ perform config model effect =
|
||||
startFetcher "TODO" -1 options model
|
||||
, fromPageMsg = Pages.Internal.Msg.UserMsg >> UserMsg
|
||||
, key = key
|
||||
, setField = \info -> Task.succeed (SetField info) |> Task.perform identity
|
||||
, setField =
|
||||
\info ->
|
||||
--Task.succeed (SetField info) |> Task.perform identity
|
||||
-- TODO
|
||||
Cmd.none
|
||||
}
|
||||
|
||||
Nothing ->
|
||||
@ -1017,16 +1031,7 @@ startFetcher fetcherKey transitionId options model =
|
||||
let
|
||||
encodedBody : String
|
||||
encodedBody =
|
||||
FormDecoder.encodeFormData
|
||||
{ fields = options.fields
|
||||
|
||||
-- TODO remove hardcoding
|
||||
, action = ""
|
||||
|
||||
-- TODO remove hardcoding
|
||||
, method = Post
|
||||
, id = Nothing
|
||||
}
|
||||
encodeFormData options.fields
|
||||
|
||||
formData : { method : Method, action : String, fields : List ( String, String ), id : Maybe String }
|
||||
formData =
|
||||
@ -1089,7 +1094,7 @@ startFetcher2 config fromPageReload fetcherKey transitionId formData model =
|
||||
let
|
||||
encodedBody : String
|
||||
encodedBody =
|
||||
FormDecoder.encodeFormData formData
|
||||
encodeFormData formData.fields
|
||||
in
|
||||
-- TODO make sure that `actionData` isn't updated in Model for fetchers
|
||||
Cmd.batch
|
||||
@ -1150,7 +1155,7 @@ startFetcher2 config fromPageReload fetcherKey transitionId formData model =
|
||||
|
||||
-- TODO use formData.method to do either query params or POST body
|
||||
, url = formData.action |> Url.fromString |> Maybe.map (\{ path } -> Path.join [ path, "content.dat" ] |> Path.toAbsolute) |> Maybe.withDefault "/"
|
||||
, method = formData.method |> FormDecoder.methodToString
|
||||
, method = formData.method |> methodToString
|
||||
, timeout = Nothing
|
||||
}
|
||||
]
|
||||
@ -1185,7 +1190,7 @@ appendFormQueryParams fields =
|
||||
)
|
||||
++ (case fields.method of
|
||||
Get ->
|
||||
"?" ++ FormDecoder.encodeFormData fields
|
||||
"?" ++ encodeFormData fields.fields
|
||||
|
||||
Post ->
|
||||
""
|
||||
@ -1309,7 +1314,7 @@ fetchRouteData transitionKey toMsg config url details =
|
||||
|> Maybe.withDefault Get
|
||||
in
|
||||
Http.request
|
||||
{ method = details |> Maybe.map (.method >> FormDecoder.methodToString) |> Maybe.withDefault "GET"
|
||||
{ method = details |> Maybe.map (.method >> methodToString) |> Maybe.withDefault "GET"
|
||||
, headers = []
|
||||
, url =
|
||||
"/"
|
||||
@ -1332,7 +1337,7 @@ fetchRouteData transitionKey toMsg config url details =
|
||||
|
||||
Get ->
|
||||
details
|
||||
|> Maybe.map FormDecoder.encodeFormData
|
||||
|> Maybe.map (.fields >> encodeFormData)
|
||||
|> Maybe.map (\encoded -> "?" ++ encoded)
|
||||
|> Maybe.withDefault ""
|
||||
)
|
||||
@ -1354,7 +1359,7 @@ fetchRouteData transitionKey toMsg config url details =
|
||||
urlEncodedFields : Maybe String
|
||||
urlEncodedFields =
|
||||
details
|
||||
|> Maybe.map FormDecoder.encodeFormData
|
||||
|> Maybe.map (.fields >> encodeFormData)
|
||||
in
|
||||
urlEncodedFields
|
||||
|> Maybe.map (\encoded -> Http.stringBody "application/x-www-form-urlencoded" encoded)
|
||||
@ -1608,3 +1613,23 @@ loadDataAndUpdateUrl ( newPageData, newSharedData, newActionData ) maybeUserMsg
|
||||
|> Url.toString
|
||||
|> BrowserLoadUrl
|
||||
)
|
||||
|
||||
|
||||
methodToString : Method -> String
|
||||
methodToString method =
|
||||
case method of
|
||||
Get ->
|
||||
"GET"
|
||||
|
||||
Post ->
|
||||
"POST"
|
||||
|
||||
|
||||
encodeFormData : List ( String, String ) -> String
|
||||
encodeFormData fields =
|
||||
fields
|
||||
|> List.map
|
||||
(\( name, value ) ->
|
||||
Url.percentEncode name ++ "=" ++ Url.percentEncode value
|
||||
)
|
||||
|> String.join "&"
|
||||
|
||||
@ -1,7 +1,6 @@
|
||||
module Pages.StaticHttpRequest exposing (Error(..), MockResolver, RawRequest(..), Status(..), cacheRequestResolution, mockResolve, toBuildError)
|
||||
|
||||
import BuildError exposing (BuildError)
|
||||
import Dict
|
||||
import Json.Encode
|
||||
import Pages.StaticHttp.Request
|
||||
import RequestsAndPending exposing (RequestsAndPending)
|
||||
|
||||
@ -881,57 +881,49 @@ fileField_ name =
|
||||
{-| -}
|
||||
formDataWithServerValidation :
|
||||
Form.Handler.Handler error (BackendTask FatalError (Validation.Validation error combined kind constraints))
|
||||
-> Parser (BackendTask FatalError (Result (Form.Response error) ( Form.Response error, combined )))
|
||||
-> Parser (BackendTask FatalError (Result (Form.ServerResponse error) ( Form.ServerResponse error, combined )))
|
||||
formDataWithServerValidation formParsers =
|
||||
rawFormData
|
||||
|> andThen
|
||||
(\rawFormData_ ->
|
||||
let
|
||||
( maybeDecoded, errors ) =
|
||||
Form.Handler.run
|
||||
rawFormData_
|
||||
formParsers
|
||||
in
|
||||
case ( maybeDecoded, errors |> Dict.toList |> List.filter (\( _, value ) -> value |> List.isEmpty |> not) |> List.NonEmpty.fromList ) of
|
||||
( Just decoded, Nothing ) ->
|
||||
case Form.Handler.run rawFormData_ formParsers of
|
||||
Form.Valid decoded ->
|
||||
succeed
|
||||
(decoded
|
||||
|> BackendTask.map
|
||||
-- TODO not sure how to migrate this
|
||||
(\(Validation _ _ ( maybeParsed, errors2 )) ->
|
||||
case ( maybeParsed, errors2 |> Dict.toList |> List.filter (\( _, value ) -> value |> List.isEmpty |> not) |> List.NonEmpty.fromList ) of
|
||||
( Just decodedFinal, Nothing ) ->
|
||||
Ok
|
||||
( Pages.Internal.Form.Response
|
||||
{ fields = rawFormData_
|
||||
, errors = Dict.empty
|
||||
, clientErrors = Dict.empty
|
||||
}
|
||||
( { persisted =
|
||||
{ fields = Just rawFormData_
|
||||
, clientSideErrors = Nothing
|
||||
}
|
||||
, serverSideErrors = Dict.empty
|
||||
}
|
||||
, decodedFinal
|
||||
)
|
||||
|
||||
_ ->
|
||||
Err
|
||||
(Pages.Internal.Form.Response
|
||||
{ fields = rawFormData_
|
||||
, errors = errors2
|
||||
, clientErrors = errors
|
||||
{ persisted =
|
||||
{ fields = Just rawFormData_
|
||||
, clientSideErrors = Just errors2
|
||||
}
|
||||
)
|
||||
, serverSideErrors = Dict.empty
|
||||
}
|
||||
)
|
||||
)
|
||||
|
||||
( _, maybeErrors ) ->
|
||||
Form.Invalid maybeValue errors ->
|
||||
Err
|
||||
(Pages.Internal.Form.Response
|
||||
{ fields = rawFormData_
|
||||
, errors =
|
||||
maybeErrors
|
||||
|> Maybe.map List.NonEmpty.toList
|
||||
|> Maybe.withDefault []
|
||||
|> Dict.fromList
|
||||
, clientErrors = Dict.empty
|
||||
{ persisted =
|
||||
{ fields = Just rawFormData_
|
||||
, clientSideErrors = Just errors
|
||||
}
|
||||
)
|
||||
, serverSideErrors = Dict.empty
|
||||
}
|
||||
|> BackendTask.succeed
|
||||
|> succeed
|
||||
)
|
||||
@ -940,39 +932,31 @@ formDataWithServerValidation formParsers =
|
||||
{-| -}
|
||||
formData :
|
||||
Form.Handler.Handler error combined
|
||||
-> Parser ( Form.Response error, Result { fields : List ( String, String ), errors : Dict String (List error), clientErrors : Dict String (List error) } combined )
|
||||
-> Parser ( Form.ServerResponse error, Form.Validated error combined )
|
||||
formData formParsers =
|
||||
rawFormData
|
||||
|> andThen
|
||||
(\rawFormData_ ->
|
||||
let
|
||||
( maybeDecoded, errors ) =
|
||||
Form.Handler.run
|
||||
rawFormData_
|
||||
formParsers
|
||||
in
|
||||
case ( maybeDecoded, errors |> Dict.toList |> List.filter (\( _, value ) -> value |> List.isEmpty |> not) |> List.NonEmpty.fromList ) of
|
||||
( Just decoded, Nothing ) ->
|
||||
( Pages.Internal.Form.Response { fields = [], errors = Dict.empty, clientErrors = Dict.empty }
|
||||
, Ok decoded
|
||||
case Form.Handler.run rawFormData_ formParsers of
|
||||
(Form.Valid decoded) as validated ->
|
||||
( { persisted =
|
||||
{ fields = Just rawFormData_
|
||||
, clientSideErrors = Just Dict.empty
|
||||
}
|
||||
, serverSideErrors = Dict.empty
|
||||
}
|
||||
, validated
|
||||
)
|
||||
|> succeed
|
||||
|
||||
( _, maybeErrors ) ->
|
||||
let
|
||||
record : { fields : List ( String, String ), errors : Dict String (List error), clientErrors : Dict String (List error) }
|
||||
record =
|
||||
{ fields = rawFormData_
|
||||
, errors = Dict.empty
|
||||
, clientErrors =
|
||||
maybeErrors
|
||||
|> Maybe.map List.NonEmpty.toList
|
||||
|> Maybe.withDefault []
|
||||
|> Dict.fromList
|
||||
(Form.Invalid maybeDecoded maybeErrors) as validated ->
|
||||
( { persisted =
|
||||
{ fields = Just rawFormData_
|
||||
, clientSideErrors = Just maybeErrors
|
||||
}
|
||||
in
|
||||
( Pages.Internal.Form.Response record
|
||||
, Err record
|
||||
, serverSideErrors = Dict.empty
|
||||
}
|
||||
, validated
|
||||
)
|
||||
|> succeed
|
||||
)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user