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

Wrap Validation type in custom type wrapper.

Browse Source
This commit is contained in:
Dillon Kearns 2022-06-27 10:55:45 -07:00
parent b82602e18f
commit 3816a4baf6
6 changed files with 80 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
examples/smoothies/app/Route/DependentForm.elm
View File

@ -185,12 +185,7 @@ dependentParser =
Form.init
(\kind postForm_ ->
kind.value
|> Validation.andThen
(\okKind ->
postForm_ okKind
|> Tuple.mapFirst Just
|> Validation.andThen identity
)
|> Validation.andThen postForm_
)
(\formState kind postForm_ ->
( []

2
examples/smoothies/app/Route/Index.elm
View File

@ -127,7 +127,7 @@ type Action
signoutForm : Form.HtmlForm String Action input Msg
signoutForm =
Form.init
(Form.ok Signout)
(Validation.succeed Signout)
(\formState ->
( []
, [ Html.button [] [ Html.text "Sign out" ]

2
examples/smoothies/app/Route/SmoothieId_/Edit.elm
View File

@ -179,7 +179,7 @@ type alias EditInfo =
deleteForm : Form.HtmlForm String Action data Msg
deleteForm =
Form.init
(Form.ok Delete)
(Validation.succeed Delete)
(\formState ->
( []
, [ Html.button

85
src/Pages/Form.elm
View File

@ -11,8 +11,9 @@ module Pages.Form exposing
, parse, runOneOfServerSide, runServerSide
, dynamic, HtmlSubForm
, FieldDefinition(..)
, fail
-- subGroup
, fail
-- subGroup
)
{-|
@ -86,7 +87,7 @@ import Pages.Field as Field exposing (Field(..))
import Pages.FormState as Form
import Pages.Msg
import Pages.Transition
import Validation exposing (Validation)
import Validation exposing (Validation(..))
@ -136,11 +137,11 @@ init fn viewFn =
{-| -}
dynamic :
(decider -> Form error parsed data (Context error data -> subView))
(decider -> Form error (Validation error parsed) data (Context error data -> subView))
->
Form
error
((decider -> ( parsed, FieldErrors error )) -> combined)
((decider -> Validation error parsed) -> combined)
data
(Context error data -> ((decider -> subView) -> combinedView))
-> Form error combined data (Context error data -> combinedView)
@ -148,7 +149,7 @@ dynamic forms formBuilder =
Form []
(\maybeData formState ->
let
toParser : decider -> { result : ( parsed, FieldErrors error ), view : Context error data -> subView }
toParser : decider -> { result : ( Validation error parsed, FieldErrors error ), view : Context error data -> subView }
toParser decider =
case forms decider of
Form definitions parseFn toInitialValues ->
@ -161,15 +162,15 @@ dynamic forms formBuilder =
}
myFn =
let
deciderToParsed : decider -> ( parsed, FieldErrors error )
deciderToParsed : decider -> Validation error parsed
deciderToParsed decider =
decider
|> toParser
|> .result
|> mergeResults
newThing :
{ result :
( (decider -> ( parsed, FieldErrors error )) -> combined
( (decider -> Validation error parsed) -> combined
, Dict String (List error)
)
, view : Context error data -> (decider -> subView) -> combinedView
@ -555,19 +556,15 @@ type alias AppContext app =
mergeResults :
{ a | result : ( ( Maybe parsed, Dict comparable (List error) ), Dict comparable (List error) ) }
-> ( Maybe parsed, Dict comparable (List error) )
{ a | result : ( Validation error parsed, Dict String (List error) ) }
-> Validation error parsed
mergeResults parsed =
case parsed.result of
( ( parsedThing, combineErrors ), individualFieldErrors ) ->
( parsedThing
, mergeErrors combineErrors individualFieldErrors
)
--( Nothing, individualFieldErrors ) ->
-- ( Nothing, individualFieldErrors )
( Validation ( parsedThing, combineErrors ), individualFieldErrors ) ->
Validation
( parsedThing
, mergeErrors combineErrors individualFieldErrors
)
mergeErrors : Dict comparable (List value) -> Dict comparable (List value) -> Dict comparable (List value)
@ -591,14 +588,13 @@ mergeErrors errors1 errors2 =
parse :
AppContext app
-> data
-> Form error ( Maybe parsed, FieldErrors error ) data (Context error data -> view)
-> Form error (Validation error parsed) data (Context error data -> view)
-> ( Maybe parsed, FieldErrors error )
parse app data (Form 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 : { result : ( ( Maybe parsed, FieldErrors error ), Dict String (List error) ), view : Context error data -> view }
parsed : { result : ( Validation error parsed, Dict String (List error) ), view : Context error data -> view }
parsed =
parser (Just data) thisFormState
@ -608,7 +604,7 @@ parse app data (Form fieldDefinitions parser _) =
|> Dict.get "test"
|> Maybe.withDefault initFormState
in
parsed |> mergeResults
parsed |> mergeResults |> unwrapValidation
insertIfNonempty : comparable -> List value -> Dict comparable (List value) -> Dict comparable (List value)
@ -624,11 +620,11 @@ insertIfNonempty key values dict =
{-| -}
runServerSide :
List ( String, String )
-> Form error ( Maybe parsed, FieldErrors error ) data (Context error data -> view)
-> Form error (Validation error parsed) data (Context error data -> view)
-> ( Maybe parsed, FieldErrors error )
runServerSide rawFormData (Form fieldDefinitions parser _) =
let
parsed : { result : ( ( Maybe parsed, FieldErrors error ), Dict String (List error) ), view : Context error data -> view }
parsed : { result : ( Validation error parsed, Dict String (List error) ), view : Context error data -> view }
parsed =
parser Nothing thisFormState
@ -648,13 +644,20 @@ runServerSide rawFormData (Form fieldDefinitions parser _) =
|> Dict.fromList
}
in
parsed |> mergeResults
parsed
|> mergeResults
|> unwrapValidation
unwrapValidation : Validation error parsed -> ( Maybe parsed, FieldErrors error )
unwrapValidation (Validation ( maybeParsed, errors )) =
( maybeParsed, errors )
{-| -}
runOneOfServerSide :
List ( String, String )
-> List (Form error ( Maybe parsed, FieldErrors error ) data (Context error data -> view))
-> List (Form error (Validation error parsed) data (Context error data -> view))
-> ( Maybe parsed, FieldErrors error )
runOneOfServerSide rawFormData parsers =
case parsers of
@ -690,7 +693,7 @@ renderHtml :
->
Form
error
( Maybe parsed, FieldErrors error )
(Validation error parsed)
data
(Context error data
-> ( List (Html.Attribute (Pages.Msg.Msg msg)), List (Html (Pages.Msg.Msg msg)) )
@ -707,7 +710,7 @@ renderStyledHtml :
->
Form
error
( Maybe parsed, FieldErrors error )
(Validation error parsed)
data
(Context error data
-> ( List (Html.Styled.Attribute (Pages.Msg.Msg msg)), List (Html.Styled.Html (Pages.Msg.Msg msg)) )
@ -721,7 +724,7 @@ renderHelper :
RenderOptions
-> AppContext app
-> data
-> Form error ( Maybe parsed, FieldErrors error ) data (Context error data -> ( List (Html.Attribute (Pages.Msg.Msg msg)), List (Html (Pages.Msg.Msg msg)) ))
-> Form error (Validation error parsed) data (Context error data -> ( List (Html.Attribute (Pages.Msg.Msg msg)), List (Html (Pages.Msg.Msg msg)) ))
-> Html (Pages.Msg.Msg msg)
renderHelper options formState data (Form fieldDefinitions parser toInitialValues) =
-- TODO Get transition context from `app` so you can check if the current form is being submitted
@ -751,13 +754,13 @@ renderHelper options formState data (Form fieldDefinitions parser toInitialValue
|> Dict.union part2
parsed :
{ result : ( ( Maybe parsed, FieldErrors error ), Dict String (List error) )
{ result : ( Validation error parsed, Dict String (List error) )
, view : Context error data -> ( List (Html.Attribute (Pages.Msg.Msg msg)), List (Html (Pages.Msg.Msg msg)) )
}
parsed =
parser (Just data) thisFormState
merged : ( Maybe parsed, Dict String (List error) )
merged : Validation error parsed
merged =
mergeResults parsed
@ -771,7 +774,7 @@ renderHelper options formState data (Form fieldDefinitions parser toInitialValue
context : Context error data
context =
{ errors =
merged |> Tuple.second
merged |> unwrapValidation |> Tuple.second
, isTransitioning =
case formState.transition of
Just transition ->
@ -854,7 +857,7 @@ isValid parser data fields =
renderStyledHelper :
AppContext app
-> data
-> Form error ( Maybe parsed, FieldErrors error ) data (Context error data -> ( List (Html.Styled.Attribute (Pages.Msg.Msg msg)), List (Html.Styled.Html (Pages.Msg.Msg msg)) ))
-> Form error (Validation error parsed) data (Context error data -> ( List (Html.Styled.Attribute (Pages.Msg.Msg msg)), List (Html.Styled.Html (Pages.Msg.Msg msg)) ))
-> Html.Styled.Html (Pages.Msg.Msg msg)
renderStyledHelper formState data (Form fieldDefinitions parser toInitialValues) =
-- TODO Get transition context from `app` so you can check if the current form is being submitted
@ -884,13 +887,13 @@ renderStyledHelper formState data (Form fieldDefinitions parser toInitialValues)
|> Dict.union part2
parsed :
{ result : ( ( Maybe parsed, FieldErrors error ), Dict String (List error) )
{ result : ( Validation error parsed, Dict String (List error) )
, view : Context error data -> ( List (Html.Styled.Attribute (Pages.Msg.Msg msg)), List (Html.Styled.Html (Pages.Msg.Msg msg)) )
}
parsed =
parser (Just data) thisFormState
merged : ( Maybe parsed, Dict String (List error) )
merged : Validation error parsed
merged =
mergeResults parsed
@ -904,7 +907,7 @@ renderStyledHelper formState data (Form fieldDefinitions parser toInitialValues)
context : Context error data
context =
{ errors =
merged |> Tuple.second
merged |> unwrapValidation |> Tuple.second
, isTransitioning =
case formState.transition of
Just transition ->
@ -1008,7 +1011,7 @@ toResult ( maybeParsed, fieldErrors ) =
type alias HtmlForm error parsed data msg =
Form
error
( Maybe parsed, FieldErrors error )
(Validation error parsed)
data
(Context error data -> ( List (Html.Attribute (Pages.Msg.Msg msg)), List (Html (Pages.Msg.Msg msg)) ))
@ -1017,7 +1020,7 @@ type alias HtmlForm error parsed data msg =
type alias HtmlSubForm error parsed data msg =
Form
error
( Maybe parsed, FieldErrors error )
(Validation error parsed)
data
(Context error data -> List (Html (Pages.Msg.Msg msg)))
@ -1026,7 +1029,7 @@ type alias HtmlSubForm error parsed data msg =
type alias StyledHtmlForm error parsed data msg =
Form
error
( Maybe parsed, FieldErrors error )
(Validation error parsed)
data
(Context error data -> ( List (Html.Styled.Attribute (Pages.Msg.Msg msg)), List (Html.Styled.Html (Pages.Msg.Msg msg)) ))

3
src/Server/Request.elm
View File

@ -106,6 +106,7 @@ import Pages.Form
import QueryParams
import Time
import Url
import Validation exposing (Validation)
{-| A `Server.Request.Parser` lets you send a `Server.Response.Response` based on an incoming HTTP request. For example,
@ -916,7 +917,7 @@ fileField_ name =
{-| -}
formParserResultNew :
List (Pages.Form.Form error ( Maybe combined, Pages.Form.FieldErrors error ) data (Pages.Form.Context error data -> viewFn))
List (Pages.Form.Form error (Validation error combined) data (Pages.Form.Context error data -> viewFn))
-> Parser (Result { fields : List ( String, String ), errors : Dict String (List error) } combined)
formParserResultNew formParsers =
formData

58
src/Validation.elm
View File

@ -1,56 +1,57 @@
module Validation exposing (Validation, andMap, andThen, fail, fromMaybe, fromResult, map, map2, parseWithError, succeed, withError, withErrorIf, withField)
module Validation exposing (Validation(..), andMap, andThen, fail, fromMaybe, fromResult, map, map2, parseWithError, succeed, withError, withErrorIf, withField)
import Dict exposing (Dict)
type alias Validation error parsed =
( Maybe parsed, Dict String (List error) )
type Validation error parsed
= Validation ( Maybe parsed, Dict String (List error) )
succeed : parsed -> Validation error parsed
succeed parsed =
( Just parsed, Dict.empty )
Validation ( Just parsed, Dict.empty )
parseWithError : parsed -> ( String, error ) -> Validation error parsed
parseWithError parsed ( key, error ) =
( Just parsed, Dict.singleton key [ error ] )
Validation ( Just parsed, Dict.singleton key [ error ] )
fail : String -> error -> Validation error parsed
fail key parsed =
( Nothing, Dict.singleton key [ parsed ] )
Validation ( Nothing, Dict.singleton key [ parsed ] )
withError : String -> error -> Validation error parsed -> Validation error parsed
withError key error ( maybeParsedA, errorsA ) =
( maybeParsedA, errorsA |> insertIfNonempty key [ error ] )
withError key error (Validation ( maybeParsedA, errorsA )) =
Validation ( maybeParsedA, errorsA |> insertIfNonempty key [ error ] )
withErrorIf : Bool -> String -> error -> Validation error parsed -> Validation error parsed
withErrorIf includeError key error ( maybeParsedA, errorsA ) =
( maybeParsedA
, if includeError then
errorsA |> insertIfNonempty key [ error ]
withErrorIf includeError key error (Validation ( maybeParsedA, errorsA )) =
Validation
( maybeParsedA
, if includeError then
errorsA |> insertIfNonempty key [ error ]
else
errorsA
)
else
errorsA
)
map : (parsed -> mapped) -> Validation error parsed -> Validation error mapped
map mapFn ( maybeParsedA, errorsA ) =
( Maybe.map mapFn maybeParsedA, errorsA )
map mapFn (Validation ( maybeParsedA, errorsA )) =
Validation ( Maybe.map mapFn maybeParsedA, errorsA )
fromResult : Result ( String, error ) parsed -> Validation error parsed
fromResult result =
case result of
Ok parsed ->
( Just parsed, Dict.empty )
Validation ( Just parsed, Dict.empty )
Err ( key, error ) ->
( Nothing, Dict.singleton key [ error ] )
Validation ( Nothing, Dict.singleton key [ error ] )
andMap : Validation error a -> Validation error (a -> b) -> Validation error b
@ -64,26 +65,29 @@ withField field =
andThen : (parsed -> Validation error mapped) -> Validation error parsed -> Validation error mapped
andThen andThenFn ( maybeParsed, errors ) =
andThen andThenFn (Validation ( maybeParsed, errors )) =
case maybeParsed of
Just parsed ->
andThenFn parsed
|> Tuple.mapSecond (mergeErrors errors)
|> (\(Validation ( andThenParsed, andThenErrors )) ->
Validation ( andThenParsed, mergeErrors errors andThenErrors )
)
Nothing ->
( Nothing, errors )
Validation ( Nothing, errors )
map2 : (a -> b -> c) -> Validation error a -> Validation error b -> Validation error c
map2 f ( maybeParsedA, errorsA ) ( maybeParsedB, errorsB ) =
( Maybe.map2 f maybeParsedA maybeParsedB
, mergeErrors errorsA errorsB
)
map2 f (Validation ( maybeParsedA, errorsA )) (Validation ( maybeParsedB, errorsB )) =
Validation
( Maybe.map2 f maybeParsedA maybeParsedB
, mergeErrors errorsA errorsB
)
fromMaybe : Maybe parsed -> Validation error parsed
fromMaybe maybe =
( maybe, Dict.empty )
Validation ( maybe, Dict.empty )
mergeErrors : Dict comparable (List value) -> Dict comparable (List value) -> Dict comparable (List value)