Handle parsing multiple form shapes.

This commit is contained in:
Dillon Kearns 2022-06-14 16:49:02 -07:00
parent 061643eedc
commit c83e3bb957
6 changed files with 205 additions and 102 deletions

View File

@ -8,14 +8,14 @@ import DataSource exposing (DataSource)
import Dict exposing (Dict)
import Effect exposing (Effect)
import ErrorPage exposing (ErrorPage)
import Form.Value
import Graphql.SelectionSet as SelectionSet
import Head
import Html exposing (Html)
import Html.Attributes as Attr
import Html.Events
import Icon
import MySession
import Pages.Form
import Pages.Field as Field
import Pages.FormParser as FormParser
import Pages.Msg
import Pages.PageUrl exposing (PageUrl)
@ -108,14 +108,12 @@ data routeParams =
Request.requestTime
|> MySession.expectSessionDataOrRedirect (Session.get "userId")
(\userId requestTime session ->
(SelectionSet.map3 Data
SelectionSet.map3 Data
Smoothie.selection
(User.selection userId)
(Cart.selection userId)
|> Request.Hasura.dataSource requestTime
|> DataSource.map
Response.render
)
|> DataSource.map Response.render
|> DataSource.map (Tuple.pair session)
)
@ -125,44 +123,75 @@ type Action
| SetQuantity Uuid Int
actionFormDecoder : FormParser.Parser String Action
actionFormDecoder =
FormParser.required "kind" "Kind is required"
|> FormParser.andThen
(\kind ->
if kind == "signout" then
FormParser.succeed Signout
else if kind == "add" then
FormParser.map2 SetQuantity
(FormParser.required "itemId" "First is required" |> FormParser.map Uuid)
-- TODO what's the best way to combine together int and required? Should it be `requiredInt`, or `Form.required |> Form.int`?
(FormParser.int "setQuantity" "Expected setQuantity to be an integer")
else
FormParser.fail "Error"
signoutForm : FormParser.HtmlForm String Action input Msg
signoutForm =
FormParser.andThenNew
(FormParser.ok Signout)
(\formState ->
( []
, [ Html.button [] [ Html.text "Sign out" ]
]
)
)
|> FormParser.hiddenKind ( "kind", "signout" ) "Expected signout"
setQuantityForm : FormParser.HtmlForm String Action ( Int, Smoothie ) Msg
setQuantityForm =
FormParser.andThenNew
(\uuid quantity ->
SetQuantity (Uuid uuid.value) quantity.value
|> FormParser.ok
)
(\formState ->
( []
, [ Html.button [] [ Html.text "+" ]
]
)
)
|> FormParser.hiddenKind ( "kind", "setQuantity" ) "Expected setQuantity"
|> FormParser.hiddenField "itemId"
(Field.text
|> Field.required "Required"
|> Field.withInitialValue (\( _, item ) -> Form.Value.string (uuidToString item.id))
)
|> FormParser.hiddenField "quantity"
(Field.int { invalid = \_ -> "Expected int" }
|> Field.required "Required"
|> Field.withInitialValue (\( quantity, _ ) -> Form.Value.int quantity)
)
oneOfParsers : List (FormParser.HtmlForm String Action ( Int, Smoothie ) Msg)
oneOfParsers =
[ signoutForm, setQuantityForm ]
action : RouteParams -> Request.Parser (DataSource (Response ActionData ErrorPage))
action routeParams =
Request.map2 Tuple.pair
(Request.formParser actionFormDecoder)
(Request.formParserResultNew oneOfParsers)
Request.requestTime
|> MySession.expectSessionDataOrRedirect (Session.get "userId" >> Maybe.map Uuid)
(\userId ( parsedAction, requestTime ) session ->
case parsedAction of
Signout ->
Ok Signout ->
DataSource.succeed (Route.redirectTo Route.Login)
|> DataSource.map (Tuple.pair Session.empty)
SetQuantity itemId quantity ->
Ok (SetQuantity itemId quantity) ->
(Cart.addItemToCart quantity userId itemId
|> Request.Hasura.mutationDataSource requestTime
|> DataSource.map
(\_ -> Response.render {})
)
|> DataSource.map (Tuple.pair session)
Err error ->
DataSource.succeed
( session
, Response.errorPage (ErrorPage.internalError "Unexpected form data format.")
)
)
@ -181,12 +210,11 @@ view maybeUrl sharedModel model app =
app.fetchers
|> List.filterMap
(\pending ->
-- TODO use the latest FormParser API for this example
--case FormParser.runOnList pending.payload.fields actionFormDecoder of
-- ( Just (SetQuantity itemId addAmount), _ ) ->
-- Just ( uuidToString itemId, addAmount )
--
-- _ ->
case FormParser.runOneOfServerSide pending.payload.fields oneOfParsers of
( Just (SetQuantity itemId addAmount), _ ) ->
Just ( uuidToString itemId, addAmount )
_ ->
Nothing
)
|> Dict.fromList
@ -221,16 +249,12 @@ view maybeUrl sharedModel model app =
]
, Html.p []
[ Html.text <| "Welcome " ++ app.data.user.name ++ "!"
, Html.form
[ Attr.method "POST"
, Pages.Msg.onSubmit
]
[ Html.button [ Attr.name "kind", Attr.value "signout" ] [ Html.text "Sign out" ] ]
, FormParser.renderHtml app () signoutForm
]
, cartView totals
, app.data.smoothies
|> List.map
(productView
(productView app
cartWithPending
)
|> Html.ul []
@ -251,8 +275,8 @@ uuidToString (Uuid id) =
id
productView : Dict String Cart.CartEntry -> Smoothie -> Html (Pages.Msg.Msg Msg)
productView cart item =
productView : StaticPayload Data ActionData RouteParams -> Dict String Cart.CartEntry -> Smoothie -> Html (Pages.Msg.Msg Msg)
productView app cart item =
let
quantityInCart : Int
quantityInCart =
@ -268,29 +292,11 @@ productView cart item =
, Html.p [] [ Html.text item.description ]
, Html.p [] [ "$" ++ String.fromInt item.price |> Html.text ]
]
, Html.form
[ Attr.method "POST"
, Pages.Msg.fetcherOnSubmit
]
[ Html.input
[ Attr.type_ "hidden"
, Attr.name "kind"
, Attr.value "add"
]
, Html.div
[]
, Html.input
[ Attr.type_ "hidden"
, Attr.name "itemId"
, Attr.value (uuidToString item.id)
]
[]
, Html.button [] [ Html.text "-" ]
[ FormParser.renderHtml app ( quantityInCart - 1, item ) setQuantityForm
, Html.p [] [ quantityInCart |> String.fromInt |> Html.text ]
, Html.button
[ Attr.name "setQuantity"
, Attr.value (quantityInCart + 1 |> String.fromInt)
]
[ Html.text "+" ]
, FormParser.renderHtml app ( quantityInCart + 1, item ) setQuantityForm
]
, Html.div []
[ Html.img

View File

@ -99,7 +99,7 @@ data routeParams =
action : RouteParams -> Request.Parser (DataSource (Response ActionData ErrorPage))
action routeParams =
Request.map2 Tuple.pair
(Request.formParserResultNew form)
(Request.formParserResultNew [ form ])
Request.requestTime
|> MySession.expectSessionDataOrRedirect (Session.get "userId" >> Maybe.map Uuid)
(\userId ( parsed, requestTime ) session ->
@ -209,14 +209,14 @@ view maybeUrl sharedModel model app =
pendingCreation : Result (FormParser.FieldErrors String) NewItem
pendingCreation =
form
|> FormParser.runNew app
|> FormParser.runNew app app.data
|> .result
|> parseIgnoreErrors
in
{ title = "New Item"
, body =
[ Html.h2 [] [ Html.text "New item" ]
, FormParser.renderHtml app form
, FormParser.renderHtml app app.data form
, pendingCreation
|> Debug.log "pendingCreation"
|> Result.toMaybe

View File

@ -193,7 +193,7 @@ validateUsername rawUsername =
action : RouteParams -> Request.Parser (DataSource (Response ActionData ErrorPage))
action routeParams =
Request.map2 Tuple.pair
(Request.formParserResultNew formParser)
(Request.formParserResultNew [ formParser ])
Request.requestTime
|> MySession.expectSessionDataOrRedirect (Session.get "userId" >> Maybe.map Uuid)
(\userId ( parsedAction, requestTime ) session ->
@ -245,13 +245,7 @@ view maybeUrl sharedModel model app =
{ title = "Ctrl-R Smoothies"
, body =
[ Html.p []
[ Html.text <| "Welcome " ++ app.data.user.name ++ "!"
, Html.form
[ Attr.method "POST"
, Pages.Msg.onSubmit
]
[ Html.button [ Attr.name "kind", Attr.value "signout" ] [ Html.text "Sign out" ] ]
]
, FormParser.renderHtml app formParser
[ Html.text <| "Welcome " ++ app.data.user.name ++ "!" ]
, FormParser.renderHtml app app.data formParser
]
}

View File

@ -129,7 +129,7 @@ data routeParams =
action : RouteParams -> Request.Parser (DataSource (Response ActionData ErrorPage))
action routeParams =
Request.map2 Tuple.pair
(Request.formParserResultNew form)
(Request.formParserResultNew [ form ])
Request.requestTime
|> MySession.expectSessionDataOrRedirect (Session.get "userId" >> Maybe.map Uuid)
(\userId ( parsed, requestTime ) session ->
@ -257,14 +257,14 @@ view maybeUrl sharedModel model app =
pendingCreation : Result (FormParser.FieldErrors String) NewItem
pendingCreation =
form
|> FormParser.runNew app
|> FormParser.runNew app app.data
|> .result
|> parseIgnoreErrors
in
{ title = "Update Item"
, body =
[ Html.h2 [] [ Html.text "Update item" ]
, FormParser.renderHtml app form
, FormParser.renderHtml app app.data form
, pendingCreation
|> Result.toMaybe
|> Maybe.map pendingView

View File

@ -63,7 +63,7 @@ field :
-> CombinedParser error combined data (Context error -> combinedView)
field name (Field fieldParser) (CombinedParser definitions parseFn toInitialValues) =
CombinedParser
(( name, FieldDefinition )
(( name, RegularField )
:: definitions
)
(\maybeData formState ->
@ -149,7 +149,7 @@ hiddenField :
-> CombinedParser error combined data (Context error -> combinedView)
hiddenField name (Field fieldParser) (CombinedParser definitions parseFn toInitialValues) =
CombinedParser
(( name, FieldDefinition )
(( name, HiddenField )
:: definitions
)
(\maybeData formState ->
@ -230,6 +230,78 @@ hiddenField name (Field fieldParser) (CombinedParser definitions parseFn toIniti
)
hiddenKind :
( String, String )
-> error
-> CombinedParser error combined data (Context error -> combinedView)
-> CombinedParser error combined data (Context error -> combinedView)
hiddenKind ( name, value ) error_ (CombinedParser definitions parseFn toInitialValues) =
let
(Field fieldParser) =
Field.exactValue value error_
in
CombinedParser
(( name, HiddenField )
:: definitions
)
(\maybeData formState ->
let
( maybeParsed, errors ) =
fieldParser.decode rawField.value
rawField : RawField
rawField =
case formState.fields |> Dict.get name of
Just info ->
{ name = name
, value = Just info.value
, status = info.status
}
Nothing ->
{ name = name
, value = Maybe.map2 (|>) maybeData fieldParser.initialValue
, status = Form.NotVisited
}
myFn :
{ result :
( Maybe combined
, Dict String (List error)
)
, view : Context error -> combinedView
}
->
{ result : ( Maybe combined, Dict String (List error) )
, view : Context error -> combinedView
}
myFn soFar =
let
( fieldThings, errorsSoFar ) =
soFar.result
in
{ result =
( fieldThings
, errorsSoFar |> addErrors name errors
)
, view = \fieldErrors -> soFar.view fieldErrors
}
in
formState
|> parseFn maybeData
|> myFn
)
(\data ->
case fieldParser.initialValue of
Just toInitialValue ->
( name, toInitialValue data )
:: toInitialValues data
Nothing ->
toInitialValues data
)
type ParsingResult a
= ParsingResult
@ -254,7 +326,7 @@ type alias FieldErrors error =
Dict String (List error)
type alias AppContext app data =
type alias AppContext app =
{ app
| --, sharedData : Shared.Data
--, routeParams : routeParams
@ -266,24 +338,24 @@ type alias AppContext app data =
transition : Maybe Pages.Transition.Transition
, fetchers : List Pages.Transition.FetcherState
, pageFormState : Form.PageFormState
, data : data
}
runNew :
AppContext app data
AppContext app
-> data
-> CombinedParser error parsed data (Context error -> view)
->
{ result : ( Maybe parsed, FieldErrors error )
, view : view
}
runNew app (CombinedParser fieldDefinitions parser _) =
runNew app data (CombinedParser fieldDefinitions parser _) =
-- 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
parsed : { result : ( Maybe parsed, FieldErrors error ), view : Context error -> view }
parsed =
parser (Just app.data) thisFormState
parser (Just data) thisFormState
thisFormState : Form.FormState
thisFormState =
@ -368,7 +440,8 @@ runOneOfServerSide rawFormData parsers =
renderHtml :
AppContext app data
AppContext app
-> data
->
CombinedParser
error
@ -378,12 +451,13 @@ renderHtml :
-> ( List (Html.Attribute (Pages.Msg.Msg msg)), List (Html (Pages.Msg.Msg msg)) )
)
-> Html (Pages.Msg.Msg msg)
renderHtml formState_ combinedParser =
Html.Lazy.lazy2 renderHelper formState_ combinedParser
renderHtml app data combinedParser =
Html.Lazy.lazy3 renderHelper app data combinedParser
renderHelper :
AppContext app data
AppContext app
-> data
->
CombinedParser
error
@ -393,7 +467,7 @@ renderHelper :
-> ( List (Html.Attribute (Pages.Msg.Msg msg)), List (Html (Pages.Msg.Msg msg)) )
)
-> Html (Pages.Msg.Msg msg)
renderHelper formState (CombinedParser fieldDefinitions parser toInitialValues) =
renderHelper formState data (CombinedParser fieldDefinitions parser toInitialValues) =
-- 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
@ -404,7 +478,7 @@ renderHelper formState (CombinedParser fieldDefinitions parser toInitialValues)
initialValues : Dict String Form.FieldState
initialValues =
toInitialValues formState.data
toInitialValues data
|> List.map (Tuple.mapSecond (\value -> { value = value, status = Form.NotVisited }))
|> Dict.fromList
@ -425,7 +499,7 @@ renderHelper formState (CombinedParser fieldDefinitions parser toInitialValues)
, view : Context error -> ( List (Html.Attribute (Pages.Msg.Msg msg)), List (Html (Pages.Msg.Msg msg)) )
}
parsed =
parser (Just formState.data) thisFormState
parser (Just data) thisFormState
thisFormState : Form.FormState
thisFormState =
@ -452,12 +526,39 @@ renderHelper formState (CombinedParser fieldDefinitions parser toInitialValues)
( formAttributes, children ) =
parsed.view context
hiddenInputs : List (Html (Pages.Msg.Msg msg))
hiddenInputs =
fieldDefinitions
|> List.filterMap
(\( name, fieldDefinition ) ->
case fieldDefinition of
HiddenField ->
Just
(Html.input
[ Attr.name name
, Attr.type_ "hidden"
, Attr.value
(initialValues
|> Dict.get name
|> Maybe.map .value
|> Maybe.withDefault ""
)
]
[]
)
RegularField ->
Nothing
)
in
Html.form
(Form.listeners formId
++ [ -- TODO remove hardcoded method - make it part of the config for the form? Should the default be POST?
Attr.method "POST"
, Pages.Msg.submitIfValid
, -- TODO need to make an option to choose `Pages.Msg.fetcherOnSubmit`
-- TODO `Pages.Msg.fetcherOnSubmit` needs to accept an `isValid` param, too
Pages.Msg.submitIfValid
(\fields ->
case
{ init
@ -466,7 +567,7 @@ renderHelper formState (CombinedParser fieldDefinitions parser toInitialValues)
|> List.map (Tuple.mapSecond (\value -> { value = value, status = Form.NotVisited }))
|> Dict.fromList
}
|> parser (Just formState.data)
|> parser (Just data)
|> .result
|> toResult
of
@ -479,7 +580,7 @@ renderHelper formState (CombinedParser fieldDefinitions parser toInitialValues)
]
++ formAttributes
)
children
(hiddenInputs ++ children)
toResult : ( Maybe parsed, FieldErrors error ) -> Result (FieldErrors error) parsed
@ -503,10 +604,11 @@ toResult ( maybeParsed, fieldErrors ) =
render :
AppContext app data
AppContext app
-> data
-> CombinedParser error parsed data (Context error -> view)
-> view
render formState (CombinedParser fieldDefinitions parser toInitialValues) =
render formState data (CombinedParser fieldDefinitions parser toInitialValues) =
-- 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
@ -520,7 +622,7 @@ render formState (CombinedParser fieldDefinitions parser toInitialValues) =
, view : Context error -> view
}
parsed =
parser (Just formState.data) thisFormState
parser (Just data) thisFormState
thisFormState : Form.FormState
thisFormState =
@ -575,7 +677,8 @@ type CombinedParser error parsed data view
type FieldDefinition
= FieldDefinition
= RegularField
| HiddenField
type alias ParsedField error parsed =

View File

@ -972,17 +972,17 @@ formParserResult formParser_ =
{-| -}
formParserResultNew :
Pages.FormParser.CombinedParser error combined data (Pages.FormParser.Context error -> viewFn)
List (Pages.FormParser.CombinedParser error combined data (Pages.FormParser.Context error -> viewFn))
-> Parser (Result { fields : List ( String, String ), errors : Dict String (List error) } combined)
formParserResultNew formParser_ =
formParserResultNew formParsers =
formData
|> andThen
(\rawFormData ->
let
( maybeDecoded, errors ) =
Pages.FormParser.runServerSide
Pages.FormParser.runOneOfServerSide
rawFormData
formParser_
formParsers
in
case ( maybeDecoded, errors |> Dict.toList |> List.filter (\( key, value ) -> value |> List.isEmpty |> not) |> List.NonEmpty.fromList ) of
( Just decoded, Nothing ) ->