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

Pass in optional Form.Msg to userMsg function, and don't register event handlers if not present.

Browse Source
This commit is contained in:
Dillon Kearns 2022-04-25 14:42:38 -07:00
parent 4111d4e677
commit e04310b603
5 changed files with 206 additions and 164 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
examples/end-to-end/app/Route/Form.elm
View File

@ -77,7 +77,7 @@ errorsView errors =
Html.div [] [] Html.div [] []
form : User -> Form String User (Html Form.Msg) form : User -> Form Msg String User (Html Msg)
form user = form user =
Form.succeed User Form.succeed User
|> Form.with |> Form.with
@ -281,7 +281,7 @@ view maybeUrl sharedModel static =
[] []
[ Html.text <| "Edit profile " ++ user.first ++ " " ++ user.last ] [ Html.text <| "Edit profile " ++ user.first ++ " " ++ user.last ]
, form user , form user
|> Form.toHtml { pageReloadSubmit = True } Html.form static.data.errors |> Form.toHtml2 { onSubmit = Nothing, onFormMsg = Nothing } Html.form static.data.errors
|> Html.map (\_ -> ()) |> Html.map (\_ -> ())
] ]
|> List.map Html.Styled.fromUnstyled |> List.map Html.Styled.fromUnstyled

10
examples/pokedex/app/Route/Form.elm
View File

@ -76,7 +76,7 @@ errorsView errors =
Html.div [] [] Html.div [] []
form : User -> Form String User (Html Form.Msg) form : User -> Form Msg String User (Html Msg)
form user = form user =
Form.succeed User Form.succeed User
|> Form.with |> Form.with
@ -211,8 +211,10 @@ data routeParams =
(\model decoded -> (\model decoded ->
case decoded of case decoded of
Ok okUser -> Ok okUser ->
Route.Form { user = Just okUser
|> Route.redirectTo , errors = model
}
|> Server.Response.render
|> DataSource.succeed |> DataSource.succeed
Err _ -> Err _ ->
@ -280,7 +282,7 @@ view maybeUrl sharedModel static =
[] []
[ Html.text <| "Edit profile " ++ user.first ++ " " ++ user.last ] [ Html.text <| "Edit profile " ++ user.first ++ " " ++ user.last ]
, form user , form user
|> Form.toHtml { pageReloadSubmit = True } Html.form static.data.errors |> Form.toHtml2 { onSubmit = Nothing, onFormMsg = Nothing } Html.form static.data.errors
|> Html.map (\_ -> ()) |> Html.map (\_ -> ())
] ]
} }

8
examples/pokedex/app/Route/TailwindForm.elm
View File

@ -214,7 +214,7 @@ validateCapitalized string =
Err "Needs to be capitalized" Err "Needs to be capitalized"
form : User -> Form String User (Html Form.Msg) form : User -> Form Msg String User (Html Msg)
form user = form user =
Form.succeed User Form.succeed User
|> Form.with |> Form.with
@ -737,10 +737,12 @@ view maybeUrl sharedModel model static =
] ]
] ]
[ form user [ form user
|> Form.toHtml { pageReloadSubmit = False } |> Form.toHtml2
{ onSubmit = Nothing
, onFormMsg = Just FormMsg
}
(\attrs children -> Html.form (List.map Attr.fromUnstyled attrs) children) (\attrs children -> Html.form (List.map Attr.fromUnstyled attrs) children)
model.form model.form
|> Html.map FormMsg
] ]
] ]
|> Html.toUnstyled |> Html.toUnstyled

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

@ -254,7 +254,7 @@ view maybeUrl sharedModel model static =
[ Html.text item.description [ Html.text item.description
, deleteItemForm item.id , deleteItemForm item.id
|> Form.toHtml2 |> Form.toHtml2
{ onSubmit = DeleteFormSubmitted item.id } { onSubmit = Just (DeleteFormSubmitted item.id), onFormMsg = Nothing }
Html.form Html.form
(Form.init (deleteItemForm item.id)) (Form.init (deleteItemForm item.id))
] ]
@ -262,14 +262,14 @@ view maybeUrl sharedModel model static =
) )
, newItemForm model.submitting , newItemForm model.submitting
|> Form.toHtml2 |> Form.toHtml2
{ onSubmit = FormSubmitted } { onSubmit = Just FormSubmitted, onFormMsg = Nothing }
Html.form Html.form
(Form.init (newItemForm model.submitting)) (Form.init (newItemForm model.submitting))
] ]
} }
newItemForm : Bool -> Form String TodoInput (Html Msg) newItemForm : Bool -> Form Msg String TodoInput (Html Msg)
newItemForm submitting = newItemForm submitting =
Form.succeed (\description () -> TodoInput description) Form.succeed (\description () -> TodoInput description)
|> Form.with |> Form.with
@ -297,7 +297,7 @@ newItemForm submitting =
) )
deleteItemForm : String -> Form String String (Html Msg) deleteItemForm : String -> Form Msg String String (Html Msg)
deleteItemForm id = deleteItemForm id =
Form.succeed Form.succeed
(\id_ _ -> id_) (\id_ _ -> id_)

340
src/Form.elm
View File

@ -175,7 +175,7 @@ fieldStatusToString fieldStatus =
"Blurred" "Blurred"
http : String -> Form error value view -> Model -> Cmd (Result Http.Error (FieldState String)) http : String -> Form msg error value view -> Model -> Cmd (Result Http.Error (FieldState String))
http url_ (Form _ _ _ _) model = http url_ (Form _ _ _ _) model =
Http.request Http.request
{ method = "POST" { method = "POST"
@ -215,12 +215,12 @@ http url_ (Form _ _ _ _) model =
{-| -} {-| -}
type Form error value view type Form msg error value view
= Form = Form
-- TODO either make this a Dict and include the client-side validations here -- TODO either make this a Dict and include the client-side validations here
-- OR create a new Dict with ( name => client-side validation ( name -> Result String () ) -- OR create a new Dict with ( name => client-side validation ( name -> Result String () )
(List (List
( List (FieldInfoSimple error view) ( List (FieldInfoSimple msg error view)
, List view -> List view , List view -> List view
) )
) )
@ -240,8 +240,8 @@ type Form error value view
{-| -} {-| -}
type Field error value view constraints type Field msg error value view constraints
= Field (FieldInfo error value view) = Field (FieldInfo msg error value view)
{-| -} {-| -}
@ -251,14 +251,15 @@ type alias FormInfo =
{-| -} {-| -}
type alias FieldInfoSimple error view = type alias FieldInfoSimple msg error view =
{ name : String { name : String
, initialValue : Maybe String , initialValue : Maybe String
, type_ : String , type_ : String
, required : Bool , required : Bool
, serverValidation : Maybe String -> DataSource (List error) , serverValidation : Maybe String -> DataSource (List error)
, toHtml : , toHtml :
FormInfo Maybe (Msg -> msg)
-> FormInfo
-> Bool -> Bool
-> FinalFieldInfo error -> FinalFieldInfo error
-> Maybe (RawFieldState error) -> Maybe (RawFieldState error)
@ -276,14 +277,15 @@ type alias RawFieldState error =
} }
type alias FieldInfo error value view = type alias FieldInfo msg error value view =
{ name : String { name : String
, initialValue : Maybe String , initialValue : Maybe String
, type_ : String , type_ : String
, required : Bool , required : Bool
, serverValidation : Maybe String -> DataSource (List error) , serverValidation : Maybe String -> DataSource (List error)
, toHtml : , toHtml :
FormInfo Maybe (Msg -> msg)
-> FormInfo
-> Bool -> Bool
-> FinalFieldInfo error -> FinalFieldInfo error
-> Maybe (RawFieldState error) -> Maybe (RawFieldState error)
@ -305,7 +307,7 @@ type alias FinalFieldInfo error =
{-| -} {-| -}
succeed : constructor -> Form error constructor view succeed : constructor -> Form msg error constructor view
succeed constructor = succeed constructor =
Form [] Form []
(\_ -> Request.succeed (Ok ( constructor, [] ))) (\_ -> Request.succeed (Ok ( constructor, [] )))
@ -314,7 +316,7 @@ succeed constructor =
{-| -} {-| -}
runClientValidations : Model -> Form String value view -> Result (List ( String, List String )) ( value, List ( String, List String ) ) runClientValidations : Model -> Form msg String value view -> Result (List ( String, List String )) ( value, List ( String, List String ) )
runClientValidations model (Form _ _ _ modelToValue) = runClientValidations model (Form _ _ _ modelToValue) =
modelToValue model.fields modelToValue model.fields
@ -363,10 +365,10 @@ rawValues model =
) )
runValidation : Form error value view -> { name : String, value : String } -> List error runValidation : Form msg error value view -> { name : String, value : String } -> List error
runValidation (Form fields _ _ _) newInput = runValidation (Form fields _ _ _) newInput =
let let
matchingDecoder : Maybe (FieldInfoSimple error view) matchingDecoder : Maybe (FieldInfoSimple msg error view)
matchingDecoder = matchingDecoder =
fields fields
|> List.Extra.findMap |> List.Extra.findMap
@ -427,7 +429,7 @@ isAtLeast atLeastStatus currentStatus =
{-| -} {-| -}
update : (Msg -> msg) -> (Result Http.Error (FieldState String) -> msg) -> Form String value view -> Msg -> Model -> ( Model, Cmd msg ) update : (Msg -> msg) -> (Result Http.Error (FieldState String) -> msg) -> Form msg String value view -> Msg -> Model -> ( Model, Cmd msg )
update toMsg onResponse ((Form _ _ _ modelToValue) as form) msg model = update toMsg onResponse ((Form _ _ _ modelToValue) as form) msg model =
case msg of case msg of
OnFieldInput { name, value } -> OnFieldInput { name, value } ->
@ -524,6 +526,8 @@ update toMsg onResponse ((Form _ _ _ modelToValue) as form) msg model =
else else
( { model | isSubmitting = Submitting } ( { model | isSubmitting = Submitting }
-- TODO use Effect.submit
-- TODO remove hardcoded "/tailwind-form"
, http "/tailwind-form" form model |> Cmd.map GotFormResponse |> Cmd.map toMsg , http "/tailwind-form" form model |> Cmd.map GotFormResponse |> Cmd.map toMsg
) )
@ -551,7 +555,7 @@ initField =
{-| -} {-| -}
init : Form String value view -> Model init : Form msg String value view -> Model
init ((Form fields _ _ modelToValue) as form) = init ((Form fields _ _ modelToValue) as form) =
let let
initialFields : Dict String { raw : Maybe String, errors : List String, status : FieldStatus } initialFields : Dict String { raw : Maybe String, errors : List String, status : FieldStatus }
@ -609,21 +613,22 @@ nonEmptyString string =
toInputRecord : toInputRecord :
FormInfo Maybe (Msg -> msg)
-> FormInfo
-> String -> String
-> Maybe String -> Maybe String
-> Maybe (RawFieldState error) -> Maybe (RawFieldState error)
-> FinalFieldInfo error -> FinalFieldInfo error
-> FieldRenderInfo error -> FieldRenderInfo msg error
toInputRecord formInfo name maybeValue info field = toInputRecord maybeToMsg formInfo name maybeValue info field =
{ toInput = { toInput =
([ name |> nonEmptyString |> Maybe.map Attr.name ([ name |> nonEmptyString |> Maybe.map Attr.name
, maybeValue , maybeValue
|> Maybe.withDefault name |> Maybe.withDefault name
|> Attr.id |> Attr.id
|> Just |> Just
, Html.Events.onFocus (OnFieldFocus { name = name }) |> Just , Maybe.map (\toMsg -> Html.Events.onFocus (toMsg (OnFieldFocus { name = name }))) maybeToMsg
, Html.Events.onBlur (OnBlur { name = name }) |> Just , Maybe.map (\toMsg -> Html.Events.onBlur (toMsg (OnBlur { name = name }))) maybeToMsg
, case ( maybeValue, info ) of , case ( maybeValue, info ) of
( Just value, _ ) -> ( Just value, _ ) ->
Attr.value value |> Just Attr.value value |> Just
@ -635,28 +640,32 @@ toInputRecord formInfo name maybeValue info field =
valueAttr field field.initialValue valueAttr field field.initialValue
, field.type_ |> Attr.type_ |> Just , field.type_ |> Attr.type_ |> Just
, field.required |> Attr.required |> Just , field.required |> Attr.required |> Just
, if field.type_ == "checkbox" then , Maybe.map
Html.Events.onCheck (\toMsg ->
(\checkState -> if field.type_ == "checkbox" then
OnFieldInput Html.Events.onCheck
{ name = name (\checkState ->
, value = OnFieldInput
if checkState then { name = name
"on" , value =
if checkState then
"on"
else else
"" ""
} }
) |> toMsg
|> Just )
else else
Html.Events.onInput Html.Events.onInput
(\newValue -> (\newValue ->
OnFieldInput OnFieldInput
{ name = name, value = newValue } { name = name, value = newValue }
) |> toMsg
|> Just )
)
maybeToMsg
] ]
|> List.filterMap identity |> List.filterMap identity
) )
@ -685,20 +694,19 @@ toHtmlProperties properties =
toRadioInputRecord : toRadioInputRecord :
FormInfo Maybe (Msg -> msg)
-> FormInfo
-> String -> String
-> String -> String
-> Maybe (RawFieldState error) -> Maybe (RawFieldState error)
-> FinalFieldInfo error -> FinalFieldInfo error
-> FieldRenderInfo error -> FieldRenderInfo msg error
toRadioInputRecord formInfo name itemValue info field = toRadioInputRecord maybeToMsg formInfo name itemValue info field =
{ toInput = { toInput =
([ name |> nonEmptyString |> Maybe.map Attr.name ([ name |> nonEmptyString |> Maybe.map Attr.name
, itemValue , itemValue
|> Attr.id |> Attr.id
|> Just |> Just
, Html.Events.onFocus (OnFieldFocus { name = name }) |> Just
, Html.Events.onBlur (OnBlur { name = name }) |> Just
, Attr.value itemValue |> Just , Attr.value itemValue |> Just
, field.type_ |> Attr.type_ |> Just , field.type_ |> Attr.type_ |> Just
, field.required |> Attr.required |> Just , field.required |> Attr.required |> Just
@ -707,22 +715,31 @@ toRadioInputRecord formInfo name itemValue info field =
else else
Nothing Nothing
, Html.Events.onCheck
(\checkState ->
OnFieldInput
{ name = name
, value =
if checkState then
itemValue
else
""
}
)
|> Just
] ]
|> List.filterMap identity |> List.filterMap identity
) )
++ (Maybe.map
(\toMsg ->
[ Html.Events.onFocus (toMsg (OnFieldFocus { name = name }))
, Html.Events.onBlur (toMsg (OnBlur { name = name }))
, Html.Events.onCheck
(\checkState ->
OnFieldInput
{ name = name
, value =
if checkState then
itemValue
else
""
}
|> toMsg
)
]
)
maybeToMsg
|> Maybe.withDefault []
)
++ toHtmlProperties field.properties ++ toHtmlProperties field.properties
, toLabel = , toLabel =
[ itemValue |> Attr.for [ itemValue |> Attr.for
@ -753,11 +770,12 @@ valueAttr field stringValue =
text : text :
String String
-> ->
(FieldRenderInfo error (FieldRenderInfo msg error
-> view -> view
) )
-> ->
Field Field
msg
error error
(Maybe String) (Maybe String)
view view
@ -774,8 +792,8 @@ text name toHtmlFn =
, required = False , required = False
, serverValidation = \_ -> DataSource.succeed [] , serverValidation = \_ -> DataSource.succeed []
, toHtml = , toHtml =
\formInfo _ fieldInfo info -> \maybeToMsg formInfo _ fieldInfo info ->
toHtmlFn (toInputRecord formInfo name Nothing info fieldInfo) toHtmlFn (toInputRecord maybeToMsg formInfo name Nothing info fieldInfo)
, decode = , decode =
\rawValue -> \rawValue ->
Ok Ok
@ -794,9 +812,10 @@ text name toHtmlFn =
hidden : hidden :
String String
-> String -> String
-> (List (Html.Attribute Msg) -> view) -> (List (Html.Attribute msg) -> view)
-> ->
Field Field
msg
error error
String String
view view
@ -812,9 +831,9 @@ hidden name _ toHtmlFn =
-- TODO shouldn't be possible to include any server-side validations on hidden fields -- TODO shouldn't be possible to include any server-side validations on hidden fields
, serverValidation = \_ -> DataSource.succeed [] , serverValidation = \_ -> DataSource.succeed []
, toHtml = , toHtml =
\formInfo _ fieldInfo info -> \maybeToMsg formInfo _ fieldInfo info ->
-- TODO shouldn't be possible to add any validations or chain anything -- TODO shouldn't be possible to add any validations or chain anything
toHtmlFn (toInputRecord formInfo name Nothing info fieldInfo |> .toInput) toHtmlFn (toInputRecord maybeToMsg formInfo name Nothing info fieldInfo |> .toInput)
, decode = , decode =
\rawValue -> \rawValue ->
Ok ( rawValue |> Maybe.withDefault "", [] ) Ok ( rawValue |> Maybe.withDefault "", [] )
@ -830,7 +849,7 @@ radio :
-> ( ( String, item ), List ( String, item ) ) -> ( ( String, item ), List ( String, item ) )
-> ->
(item (item
-> FieldRenderInfo error -> FieldRenderInfo msg error
-> view -> view
) )
-> ->
@ -843,6 +862,7 @@ radio :
) )
-> ->
Field Field
msg
error error
(Maybe item) (Maybe item)
view view
@ -883,9 +903,9 @@ radio name invalidError nonEmptyItemMapping toHtmlFn wrapFn =
, required = False , required = False
, serverValidation = \_ -> DataSource.succeed [] , serverValidation = \_ -> DataSource.succeed []
, toHtml = , toHtml =
\formInfo _ fieldInfo info -> \maybeToMsg formInfo _ fieldInfo info ->
items items
|> List.map (\item -> toHtmlFn item (toRadioInputRecord formInfo name (toString item) info fieldInfo)) |> List.map (\item -> toHtmlFn item (toRadioInputRecord maybeToMsg formInfo name (toString item) info fieldInfo))
|> wrapFn { errors = info |> Maybe.map .errors |> Maybe.withDefault [], submitStatus = formInfo.submitStatus, status = info |> Maybe.map .status |> Maybe.withDefault NotVisited } |> wrapFn { errors = info |> Maybe.map .errors |> Maybe.withDefault [], submitStatus = formInfo.submitStatus, status = info |> Maybe.map .status |> Maybe.withDefault NotVisited }
, decode = , decode =
\raw -> \raw ->
@ -920,12 +940,12 @@ toFieldResult result =
{-| -} {-| -}
submit : submit :
({ attrs : List (Html.Attribute Msg) ({ attrs : List (Html.Attribute msg)
, formHasErrors : Bool , formHasErrors : Bool
} }
-> view -> view
) )
-> Field error () view {} -> Field msg error () view {}
submit toHtmlFn = submit toHtmlFn =
Field Field
{ name = "" { name = ""
@ -934,7 +954,8 @@ submit toHtmlFn =
, required = False , required = False
, serverValidation = \_ -> DataSource.succeed [] , serverValidation = \_ -> DataSource.succeed []
, toHtml = , toHtml =
\_ formHasErrors _ _ -> \maybeToMsg _ formHasErrors _ _ ->
-- TODO use maybeToMsg here?
toHtmlFn toHtmlFn
{ attrs = { attrs =
[ Attr.type_ "submit" [ Attr.type_ "submit"
@ -956,11 +977,12 @@ int :
String String
-> { invalid : String -> error } -> { invalid : String -> error }
-> ->
(FieldRenderInfo error (FieldRenderInfo msg error
-> view -> view
) )
-> ->
Field Field
msg
error error
(Maybe Int) (Maybe Int)
view view
@ -978,8 +1000,8 @@ int name toError toHtmlFn =
, required = False , required = False
, serverValidation = \_ -> DataSource.succeed [] , serverValidation = \_ -> DataSource.succeed []
, toHtml = , toHtml =
\formInfo _ fieldInfo info -> \maybeToMsg formInfo _ fieldInfo info ->
toHtmlFn (toInputRecord formInfo name Nothing info fieldInfo) toHtmlFn (toInputRecord maybeToMsg formInfo name Nothing info fieldInfo)
, decode = , decode =
\rawString -> \rawString ->
(case rawString of (case rawString of
@ -1005,11 +1027,12 @@ float :
String String
-> { invalid : String -> error } -> { invalid : String -> error }
-> ->
(FieldRenderInfo error (FieldRenderInfo msg error
-> view -> view
) )
-> ->
Field Field
msg
error error
(Maybe Float) (Maybe Float)
view view
@ -1027,8 +1050,8 @@ float name toError toHtmlFn =
, required = False , required = False
, serverValidation = \_ -> DataSource.succeed [] , serverValidation = \_ -> DataSource.succeed []
, toHtml = , toHtml =
\formInfo _ fieldInfo info -> \maybeToMsg formInfo _ fieldInfo info ->
toHtmlFn (toInputRecord formInfo name Nothing info fieldInfo) toHtmlFn (toInputRecord maybeToMsg formInfo name Nothing info fieldInfo)
, decode = , decode =
\rawString -> \rawString ->
(case rawString of (case rawString of
@ -1062,10 +1085,10 @@ range :
, max : Int , max : Int
} }
-> ->
(FieldRenderInfo error (FieldRenderInfo msg error
-> view -> view
) )
-> Field error Int view {} -> Field msg error Int view {}
range name toError options toHtmlFn = range name toError options toHtmlFn =
Field Field
{ name = name { name = name
@ -1074,8 +1097,8 @@ range name toError options toHtmlFn =
, required = True , required = True
, serverValidation = \_ -> DataSource.succeed [] , serverValidation = \_ -> DataSource.succeed []
, toHtml = , toHtml =
\formInfo _ fieldInfo info -> \maybeToMsg formInfo _ fieldInfo info ->
toHtmlFn (toInputRecord formInfo name Nothing info fieldInfo) toHtmlFn (toInputRecord maybeToMsg formInfo name Nothing info fieldInfo)
, decode = , decode =
\rawString -> \rawString ->
(rawString (rawString
@ -1116,11 +1139,12 @@ floatRange :
, max : Float , max : Float
} }
-> ->
(FieldRenderInfo error (FieldRenderInfo msg error
-> view -> view
) )
-> ->
Field Field
msg
error error
Float Float
view view
@ -1134,8 +1158,8 @@ floatRange name toError options toHtmlFn =
, required = True , required = True
, serverValidation = \_ -> DataSource.succeed [] , serverValidation = \_ -> DataSource.succeed []
, toHtml = , toHtml =
\formInfo _ fieldInfo info -> \maybeToMsg formInfo _ fieldInfo info ->
toHtmlFn (toInputRecord formInfo name Nothing info fieldInfo) toHtmlFn (toInputRecord maybeToMsg formInfo name Nothing info fieldInfo)
, decode = , decode =
\rawString -> \rawString ->
(rawString (rawString
@ -1167,11 +1191,12 @@ date :
String String
-> { invalid : String -> error } -> { invalid : String -> error }
-> ->
(FieldRenderInfo error (FieldRenderInfo msg error
-> view -> view
) )
-> ->
Field Field
msg
error error
(Maybe Date) (Maybe Date)
view view
@ -1189,8 +1214,8 @@ date name toError toHtmlFn =
, required = False , required = False
, serverValidation = \_ -> DataSource.succeed [] , serverValidation = \_ -> DataSource.succeed []
, toHtml = , toHtml =
\formInfo _ fieldInfo info -> \maybeToMsg formInfo _ fieldInfo info ->
toHtmlFn (toInputRecord formInfo name Nothing info fieldInfo) toHtmlFn (toInputRecord maybeToMsg formInfo name Nothing info fieldInfo)
, decode = , decode =
\rawString -> \rawString ->
(if (rawString |> Maybe.withDefault "") == "" then (if (rawString |> Maybe.withDefault "") == "" then
@ -1220,11 +1245,12 @@ time :
String String
-> { invalid : String -> error } -> { invalid : String -> error }
-> ->
(FieldRenderInfo error (FieldRenderInfo msg error
-> view -> view
) )
-> ->
Field Field
msg
error error
(Maybe TimeOfDay) (Maybe TimeOfDay)
view view
@ -1242,8 +1268,8 @@ time name toError toHtmlFn =
, required = False , required = False
, serverValidation = \_ -> DataSource.succeed [] , serverValidation = \_ -> DataSource.succeed []
, toHtml = , toHtml =
\formInfo _ fieldInfo info -> \maybeToMsg formInfo _ fieldInfo info ->
toHtmlFn (toInputRecord formInfo name Nothing info fieldInfo) toHtmlFn (toInputRecord maybeToMsg formInfo name Nothing info fieldInfo)
, decode = , decode =
\rawString -> \rawString ->
(if (rawString |> Maybe.withDefault "") == "" then (if (rawString |> Maybe.withDefault "") == "" then
@ -1284,9 +1310,9 @@ validateRequiredField toError maybeRaw =
{-| -} {-| -}
type alias FieldRenderInfo error = type alias FieldRenderInfo msg error =
{ toInput : List (Html.Attribute Msg) { toInput : List (Html.Attribute msg)
, toLabel : List (Html.Attribute Msg) , toLabel : List (Html.Attribute msg)
, errors : List error , errors : List error
, submitStatus : SubmitStatus , submitStatus : SubmitStatus
, status : FieldStatus , status : FieldStatus
@ -1298,11 +1324,12 @@ checkbox :
String String
-> Bool -> Bool
-> ->
(FieldRenderInfo error (FieldRenderInfo msg error
-> view -> view
) )
-> ->
Field Field
msg
error error
Bool Bool
view view
@ -1321,8 +1348,8 @@ checkbox name initial toHtmlFn =
, required = False , required = False
, serverValidation = \_ -> DataSource.succeed [] , serverValidation = \_ -> DataSource.succeed []
, toHtml = , toHtml =
\formInfo _ fieldInfo info -> \maybeToMsg formInfo _ fieldInfo info ->
toHtmlFn (toInputRecord formInfo name Nothing info fieldInfo) toHtmlFn (toInputRecord maybeToMsg formInfo name Nothing info fieldInfo)
, decode = , decode =
\rawString -> \rawString ->
Ok (rawString == Just "on") Ok (rawString == Just "on")
@ -1332,36 +1359,36 @@ checkbox name initial toHtmlFn =
{-| -} {-| -}
withMin : Form.Value.Value valueType -> Field error value view { constraints | min : valueType } -> Field error value view constraints withMin : Form.Value.Value valueType -> Field msg error value view { constraints | min : valueType } -> Field msg error value view constraints
withMin min field = withMin min field =
withStringProperty ( "min", Form.Value.toString min ) field withStringProperty ( "min", Form.Value.toString min ) field
{-| -} {-| -}
withMax : Form.Value.Value valueType -> Field error value view { constraints | max : valueType } -> Field error value view constraints withMax : Form.Value.Value valueType -> Field msg error value view { constraints | max : valueType } -> Field msg error value view constraints
withMax max field = withMax max field =
withStringProperty ( "max", Form.Value.toString max ) field withStringProperty ( "max", Form.Value.toString max ) field
{-| -} {-| -}
withStep : Form.Value.Value valueType -> Field error value view { constraints | step : valueType } -> Field error value view constraints withStep : Form.Value.Value valueType -> Field msg error value view { constraints | step : valueType } -> Field msg error value view constraints
withStep max field = withStep max field =
withStringProperty ( "step", Form.Value.toString max ) field withStringProperty ( "step", Form.Value.toString max ) field
{-| -} {-| -}
withInitialValue : Form.Value.Value valueType -> Field error value view { constraints | initial : valueType } -> Field error value view constraints withInitialValue : Form.Value.Value valueType -> Field msg error value view { constraints | initial : valueType } -> Field msg error value view constraints
withInitialValue initialValue (Field field) = withInitialValue initialValue (Field field) =
Field { field | initialValue = Just (Form.Value.toString initialValue) } Field { field | initialValue = Just (Form.Value.toString initialValue) }
{-| -} {-| -}
multiple : Field error value view { constraints | multiple : () } -> Field error value view constraints multiple : Field msg error value view { constraints | multiple : () } -> Field msg error value view constraints
multiple (Field field) = multiple (Field field) =
Field { field | properties = ( "multiple", Encode.bool True ) :: field.properties } Field { field | properties = ( "multiple", Encode.bool True ) :: field.properties }
withStringProperty : ( String, String ) -> Field error value view constraints1 -> Field error value view constraints2 withStringProperty : ( String, String ) -> Field msg error value view constraints1 -> Field msg error value view constraints2
withStringProperty ( key, value ) (Field field) = withStringProperty ( key, value ) (Field field) =
Field { field | properties = ( key, Encode.string value ) :: field.properties } Field { field | properties = ( key, Encode.string value ) :: field.properties }
@ -1381,6 +1408,7 @@ required :
error error
-> ->
Field Field
msg
error error
(Maybe value) (Maybe value)
view view
@ -1388,7 +1416,7 @@ required :
| required : () | required : ()
, wasMapped : No , wasMapped : No
} }
-> Field error value view { constraints | wasMapped : No } -> Field msg error value view { constraints | wasMapped : No }
required missingError (Field field) = required missingError (Field field) =
Field Field
{ name = field.name { name = field.name
@ -1413,37 +1441,37 @@ required missingError (Field field) =
{-| -} {-| -}
telephone : Field error value view { constraints | plainText : () } -> Field error value view constraints telephone : Field msg error value view { constraints | plainText : () } -> Field msg error value view constraints
telephone (Field field) = telephone (Field field) =
Field { field | type_ = "tel" } Field { field | type_ = "tel" }
{-| -} {-| -}
search : Field error value view { constraints | plainText : () } -> Field error value view constraints search : Field msg error value view { constraints | plainText : () } -> Field msg error value view constraints
search (Field field) = search (Field field) =
Field { field | type_ = "search" } Field { field | type_ = "search" }
{-| -} {-| -}
password : Field error value view { constraints | plainText : () } -> Field error value view constraints password : Field msg error value view { constraints | plainText : () } -> Field msg error value view constraints
password (Field field) = password (Field field) =
Field { field | type_ = "password" } Field { field | type_ = "password" }
{-| -} {-| -}
email : Field error value view { constraints | plainText : () } -> Field error value view constraints email : Field msg error value view { constraints | plainText : () } -> Field msg error value view constraints
email (Field field) = email (Field field) =
Field { field | type_ = "email" } Field { field | type_ = "email" }
{-| -} {-| -}
url : Field error value view { constraints | plainText : () } -> Field error value view constraints url : Field msg error value view { constraints | plainText : () } -> Field msg error value view constraints
url (Field field) = url (Field field) =
Field { field | type_ = "url" } Field { field | type_ = "url" }
{-| -} {-| -}
withServerValidation : (value -> DataSource (List error)) -> Field error value view constraints -> Field error value view constraints withServerValidation : (value -> DataSource (List error)) -> Field msg error value view constraints -> Field msg error value view constraints
withServerValidation serverValidation (Field field) = withServerValidation serverValidation (Field field) =
Field Field
{ field { field
@ -1468,13 +1496,13 @@ withServerValidation serverValidation (Field field) =
{-| -} {-| -}
map : (value -> mapped) -> Field error value view constraints -> Field error mapped view { constraints | wasMapped : Yes } map : (value -> mapped) -> Field msg error value view constraints -> Field msg error mapped view { constraints | wasMapped : Yes }
map mapFn field = map mapFn field =
withClientValidation (mapFn >> Ok) field withClientValidation (mapFn >> Ok) field
{-| -} {-| -}
withClientValidation : (value -> Result error mapped) -> Field error value view constraints -> Field error mapped view { constraints | wasMapped : Yes } withClientValidation : (value -> Result error mapped) -> Field msg error value view constraints -> Field msg error mapped view { constraints | wasMapped : Yes }
withClientValidation mapFn (Field field) = withClientValidation mapFn (Field field) =
Field Field
{ name = field.name { name = field.name
@ -1499,7 +1527,7 @@ withClientValidation mapFn (Field field) =
{-| -} {-| -}
withClientValidation2 : (value -> Result (List error) ( mapped, List error )) -> Field error value view constraints -> Field error mapped view { constraints | wasMapped : Yes } withClientValidation2 : (value -> Result (List error) ( mapped, List error )) -> Field msg error value view constraints -> Field msg error mapped view { constraints | wasMapped : Yes }
withClientValidation2 mapFn (Field field) = withClientValidation2 mapFn (Field field) =
Field Field
{ name = field.name { name = field.name
@ -1523,7 +1551,7 @@ withClientValidation2 mapFn (Field field) =
{-| -} {-| -}
with : Field error value view constraints -> Form error (value -> form) view -> Form error form view with : Field msg error value view constraints -> Form msg error (value -> form) view -> Form msg error form view
with (Field field) (Form fields decoder serverValidations modelToValue) = with (Field field) (Form fields decoder serverValidations modelToValue) =
let let
thing : (String -> Parser (Maybe String)) -> Parser (DataSource (List ( String, RawFieldState error ))) thing : (String -> Parser (Maybe String)) -> Parser (DataSource (List ( String, RawFieldState error )))
@ -1660,7 +1688,7 @@ map2ResultWithErrors mapFn result1 result2 =
Err errors2 Err errors2
addField : FieldInfo error value view -> List ( List (FieldInfoSimple error view), List view -> List view ) -> List ( List (FieldInfoSimple error view), List view -> List view ) addField : FieldInfo msg error value view -> List ( List (FieldInfoSimple msg error view), List view -> List view ) -> List ( List (FieldInfoSimple msg error view), List view -> List view )
addField field list = addField field list =
case list of case list of
[] -> [] ->
@ -1672,7 +1700,7 @@ addField field list =
{-| -} {-| -}
append : Field error value view constraints -> Form error form view -> Form error form view append : Field msg error value view constraints -> Form msg error form view -> Form msg error form view
append (Field field) (Form fields decoder serverValidations modelToValue) = append (Field field) (Form fields decoder serverValidations modelToValue) =
Form Form
--(field :: fields) --(field :: fields)
@ -1683,7 +1711,7 @@ append (Field field) (Form fields decoder serverValidations modelToValue) =
{-| -} {-| -}
validate : (form -> List ( String, List error )) -> Form error form view -> Form error form view validate : (form -> List ( String, List error )) -> Form msg error form view -> Form msg error form view
validate validateFn (Form fields decoder serverValidations modelToValue) = validate validateFn (Form fields decoder serverValidations modelToValue) =
Form fields Form fields
decoder decoder
@ -1708,7 +1736,7 @@ validate validateFn (Form fields decoder serverValidations modelToValue) =
{-| -} {-| -}
appendForm : (form1 -> form2 -> form) -> Form error form1 view -> Form error form2 view -> Form error form view appendForm : (form1 -> form2 -> form) -> Form msg error form1 view -> Form msg error form2 view -> Form msg error form view
appendForm mapFn (Form fields1 decoder1 serverValidations1 modelToValue1) (Form fields2 decoder2 serverValidations2 modelToValue2) = appendForm mapFn (Form fields1 decoder1 serverValidations1 modelToValue1) (Form fields2 decoder2 serverValidations2 modelToValue2) =
Form Form
-- TODO is this ordering correct? -- TODO is this ordering correct?
@ -1733,7 +1761,7 @@ appendForm mapFn (Form fields1 decoder1 serverValidations1 modelToValue1) (Form
{-| -} {-| -}
wrap : (List view -> view) -> Form error form view -> Form error form view wrap : (List view -> view) -> Form msg error form view -> Form msg error form view
wrap newWrapFn (Form fields decoder serverValidations modelToValue) = wrap newWrapFn (Form fields decoder serverValidations modelToValue) =
Form (wrapFields fields newWrapFn) decoder serverValidations modelToValue Form (wrapFields fields newWrapFn) decoder serverValidations modelToValue
@ -1741,13 +1769,13 @@ wrap newWrapFn (Form fields decoder serverValidations modelToValue) =
{-| -} {-| -}
wrapFields : wrapFields :
List List
( List (FieldInfoSimple error view) ( List (FieldInfoSimple msg error view)
, List view -> List view , List view -> List view
) )
-> (List view -> view) -> (List view -> view)
-> ->
List List
( List (FieldInfoSimple error view) ( List (FieldInfoSimple msg error view)
, List view -> List view , List view -> List view
) )
wrapFields fields newWrapFn = wrapFields fields newWrapFn =
@ -1763,7 +1791,7 @@ wrapFields fields newWrapFn =
:: others :: others
simplify2 : FieldInfo error value view -> FieldInfoSimple error view simplify2 : FieldInfo msg error value view -> FieldInfoSimple msg error view
simplify2 field = simplify2 field =
{ name = field.name { name = field.name
, initialValue = field.initialValue , initialValue = field.initialValue
@ -1787,7 +1815,7 @@ simplify2 field =
} }
simplify3 : FieldInfoSimple error view -> FinalFieldInfo error simplify3 : FieldInfoSimple msg error view -> FinalFieldInfo error
simplify3 field = simplify3 field =
{ name = field.name { name = field.name
, initialValue = field.initialValue , initialValue = field.initialValue
@ -1813,7 +1841,7 @@ toHtml :
{ pageReloadSubmit : Bool } { pageReloadSubmit : Bool }
-> (List (Html.Attribute Msg) -> List view -> view) -> (List (Html.Attribute Msg) -> List view -> view)
-> Model -> Model
-> Form String value view -> Form msg String value view
-> view -> view
toHtml { pageReloadSubmit } toForm serverValidationErrors (Form fields _ _ _) = toHtml { pageReloadSubmit } toForm serverValidationErrors (Form fields _ _ _) =
let let
@ -1859,7 +1887,8 @@ toHtml { pageReloadSubmit } toForm serverValidationErrors (Form fields _ _ _) =
) )
} }
in in
field.toHtml { submitStatus = serverValidationErrors.isSubmitting } field.toHtml (Debug.todo "Is this obsolete?")
{ submitStatus = serverValidationErrors.isSubmitting }
hasErrors_ hasErrors_
(simplify3 field) (simplify3 field)
(Just thing) (Just thing)
@ -1871,11 +1900,12 @@ toHtml { pageReloadSubmit } toForm serverValidationErrors (Form fields _ _ _) =
{-| -} {-| -}
toHtml2 : toHtml2 :
{ onSubmit : { contentType : String, body : String } -> msg { onSubmit : Maybe ({ contentType : String, body : String } -> msg)
, onFormMsg : Maybe (Msg -> msg)
} }
-> (List (Html.Attribute msg) -> List view -> view) -> (List (Html.Attribute msg) -> List view -> view)
-> Model -> Model
-> Form String value view -> Form msg String value view
-> view -> view
toHtml2 config toForm serverValidationErrors (Form fields _ _ _) = toHtml2 config toForm serverValidationErrors (Form fields _ _ _) =
let let
@ -1885,22 +1915,29 @@ toHtml2 config toForm serverValidationErrors (Form fields _ _ _) =
in in
toForm toForm
([ [ Attr.method "POST" ] ([ [ Attr.method "POST" ]
, [ Attr.novalidate True , [ Attr.novalidate True |> Just
, FormDecoder.formDataOnSubmit
|> Attr.map --, Html.Events.onSubmit SubmitForm |> Just
(\formFields_ -> , config.onSubmit
config.onSubmit |> Maybe.map
{ contentType = "application/x-www-form-urlencoded" (\onSubmit ->
, body = FormDecoder.formDataOnSubmit
formFields_ |> Attr.map
|> List.map (\formFields_ ->
(\( name, value ) -> onSubmit
Url.percentEncode name ++ "=" ++ Url.percentEncode value { contentType = "application/x-www-form-urlencoded"
) , body =
|> String.join "&" formFields_
} |> List.map
(\( name, value ) ->
Url.percentEncode name ++ "=" ++ Url.percentEncode value
)
|> String.join "&"
}
)
) )
] ]
|> List.filterMap identity
] ]
|> List.concat |> List.concat
) )
@ -1930,7 +1967,8 @@ toHtml2 config toForm serverValidationErrors (Form fields _ _ _) =
) )
} }
in in
field.toHtml { submitStatus = serverValidationErrors.isSubmitting } field.toHtml config.onFormMsg
{ submitStatus = serverValidationErrors.isSubmitting }
hasErrors_ hasErrors_
(simplify3 field) (simplify3 field)
(Just thing) (Just thing)
@ -1941,7 +1979,7 @@ toHtml2 config toForm serverValidationErrors (Form fields _ _ _) =
apiHandler : apiHandler :
Form String value view Form msg String value view
-> Parser (DataSource (Response response error)) -> Parser (DataSource (Response response error))
apiHandler (Form _ decoder serverValidations _) = apiHandler (Form _ decoder serverValidations _) =
let let
@ -1978,20 +2016,20 @@ apiHandler (Form _ decoder serverValidations _) =
) )
) )
(Request.expectFormPost (Request.expectFormPost
(\{ field } -> (\{ optionalField } ->
decoder (\string -> field string |> Request.map Just) decoder (\string -> optionalField string)
) )
) )
(Request.expectFormPost (Request.expectFormPost
(\{ field } -> (\{ optionalField } ->
serverValidations (\string -> field string |> Request.map Just) serverValidations (\string -> optionalField string)
) )
) )
|> Request.acceptContentTypes (List.NonEmpty.singleton "application/json") |> Request.acceptContentTypes (List.NonEmpty.singleton "application/json")
toRequest2 : toRequest2 :
Form String value view Form msg String value view
-> ->
Parser Parser
(DataSource (DataSource
@ -2022,13 +2060,13 @@ toRequest2 ((Form _ decoder serverValidations modelToValue) as form) =
) )
) )
(Request.expectFormPost (Request.expectFormPost
(\{ field } -> (\{ optionalField } ->
decoder (\fieldName -> field fieldName |> Request.map Just) decoder (\fieldName -> optionalField fieldName)
) )
) )
(Request.expectFormPost (Request.expectFormPost
(\{ field } -> (\{ optionalField } ->
serverValidations (\string -> field string |> Request.map Just) serverValidations (\string -> optionalField string)
|> Request.map |> Request.map
(DataSource.map (DataSource.map
(\thing -> (\thing ->
@ -2073,7 +2111,7 @@ toRequest2 ((Form _ decoder serverValidations modelToValue) as form) =
{-| -} {-| -}
submitHandlers : submitHandlers :
Form String decoded view Form msg String decoded view
-> (Model -> Result () decoded -> DataSource (Response data error)) -> (Model -> Result () decoded -> DataSource (Response data error))
-> Parser (DataSource (Response data error)) -> Parser (DataSource (Response data error))
submitHandlers myForm toDataSource = submitHandlers myForm toDataSource =