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

Checkpoint for merging API.

Browse Source
This commit is contained in:
Dillon Kearns 2023-03-30 09:45:52 -07:00
parent 6951bdbad7
commit a3f9b98409
24 changed files with 1761 additions and 1476 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
examples/end-to-end/app/Api.elm
View File

@ -1,11 +1,12 @@
module Api exposing (routes)
--import Form.Validation as Validation
import ApiRoute exposing (ApiRoute)
import BackendTask exposing (BackendTask)
import FatalError exposing (FatalError)
import Form
import Form.Field as Field
import Form.Validation as Validation
import Html exposing (Html)
import Json.Decode as Decode
import Json.Encode as Encode

59
examples/end-to-end/app/Effect.elm
View File

@ -1,7 +1,8 @@
module Effect exposing (Effect(..), batch, fromCmd, map, none, perform)
--import Form.FormData exposing (FormData)
import Browser.Navigation
import Form.FormData exposing (FormData)
import Http
import Json.Decode as Decode
import Pages.Fetcher
@ -14,14 +15,14 @@ type Effect msg
| Batch (List (Effect msg))
| GetStargazers (Result Http.Error Int -> msg)
| SetField { formId : String, name : String, value : String }
| FetchRouteData
{ data : Maybe FormData
, toMsg : Result Http.Error Url -> msg
}
| Submit
{ values : FormData
, toMsg : Result Http.Error Url -> msg
}
--| FetchRouteData
-- { data : Maybe FormData
-- , toMsg : Result Http.Error Url -> msg
-- }
--| Submit
-- { values : FormData
-- , toMsg : Result Http.Error Url -> msg
-- }
| SubmitFetcher (Pages.Fetcher.Fetcher msg)
@ -61,18 +62,17 @@ map fn effect =
GetStargazers toMsg ->
GetStargazers (toMsg >> fn)
FetchRouteData fetchInfo ->
FetchRouteData
{ data = fetchInfo.data
, toMsg = fetchInfo.toMsg >> fn
}
Submit fetchInfo ->
Submit
{ values = fetchInfo.values
, toMsg = fetchInfo.toMsg >> fn
}
--FetchRouteData fetchInfo ->
-- FetchRouteData
-- { data = fetchInfo.data
-- , toMsg = fetchInfo.toMsg >> fn
-- }
--
--Submit fetchInfo ->
-- Submit
-- { values = fetchInfo.values
-- , toMsg = fetchInfo.toMsg >> fn
-- }
SetField info ->
SetField info
@ -84,12 +84,12 @@ map fn effect =
perform :
{ fetchRouteData :
{ data : Maybe FormData
{ data : Maybe a
, toMsg : Result Http.Error Url -> pageMsg
}
-> Cmd msg
, submit :
{ values : FormData
{ values : b
, toMsg : Result Http.Error Url -> pageMsg
}
-> Cmd msg
@ -123,12 +123,11 @@ perform ({ fromPageMsg, key } as helpers) effect =
, expect = Http.expectJson (toMsg >> fromPageMsg) (Decode.field "stargazers_count" Decode.int)
}
FetchRouteData fetchInfo ->
helpers.fetchRouteData
fetchInfo
Submit record ->
helpers.submit record
--FetchRouteData fetchInfo ->
-- helpers.fetchRouteData
-- fetchInfo
--
--Submit record ->
-- helpers.submit record
SubmitFetcher record ->
helpers.runFetcher record

37
examples/end-to-end/app/Route/DarkMode.elm
View File

@ -9,10 +9,10 @@ import ErrorPage
import FatalError exposing (FatalError)
import Form
import Form.Field as Field
import Form.Handler
import Form.Validation as Validation
import Form.Value as Value
import Head
import Html.Styled as Html
import Html.Styled as Html exposing (Html)
import Html.Styled.Attributes exposing (css)
import PagesMsg exposing (PagesMsg)
import Platform.Sub
@ -125,7 +125,7 @@ action :
action routeParams =
Server.Request.formData
(form
|> Form.initCombined identity
|> Form.Handler.init identity
)
|> Session.withSessionResult sessionOptions
(\( response, formPost ) sessionResult ->
@ -165,7 +165,7 @@ head app =
form : Form.StyledHtmlForm String Bool Bool Msg
form =
Form.init
Form.form
(\darkMode ->
{ combine =
Validation.succeed identity
@ -210,8 +210,17 @@ view app shared model =
)
]
[ form
|> Form.toDynamicFetcher
|> Form.renderStyledHtml "dark-mode" [] (.formResponse >> Just) app app.data.isDarkMode
--|> Form.toDynamicFetcher
|> Form.renderStyledHtml "dark-mode"
[]
--(.formResponse >> Just)
--app
--app.data.isDarkMode
{ serverResponse = Nothing
, submitting = False
, state = Debug.todo ""
}
app.data.isDarkMode
, Html.text <|
"Current mode: "
++ (if app.data.isDarkMode then
@ -223,3 +232,19 @@ view app shared model =
]
]
}
renderPagesForm : RouteBuilder.App Data ActionData RouteParams -> Bool -> Html (Form.Msg Msg)
renderPagesForm app input =
form
--|> Form.toDynamicFetcher
|> Form.renderStyledHtml "dark-mode"
[]
--(.formResponse >> Just)
--app
--app.data.isDarkMode
{ serverResponse = Nothing
, submitting = False
, state = Debug.todo ""
}
input

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

@ -163,7 +163,9 @@ view app shared model =
-- TODO should there be a helper function to easily invoke a form submission to a different route?
[ Attr.method "post"
, Attr.action "/logout"
, PagesMsg.onSubmit |> Attr.fromUnstyled
-- TODO remove this example? Or find a way to do it with the new API?
--, PagesMsg.onSubmit |> Attr.fromUnstyled
]
[ Html.button [] [ Html.text "Logout" ] ]
]

4
generator/src/RouteBuilder.elm
View File

@ -90,11 +90,11 @@ import Dict exposing (Dict)
import Effect exposing (Effect)
import ErrorPage exposing (ErrorPage)
import FatalError exposing (FatalError)
import Form
import Head
import Http
import Json.Decode
import Pages.Fetcher
import Pages.FormState
import Pages.Internal.NotFoundReason exposing (NotFoundReason)
import Pages.Internal.RoutePattern exposing (RoutePattern)
import Pages.PageUrl exposing (PageUrl)
@ -147,7 +147,7 @@ type alias App data action routeParams =
-> Pages.Fetcher.Fetcher (Result Http.Error action)
, transition : Maybe Pages.Transition.Transition
, fetchers : Dict String (Pages.Transition.FetcherState (Maybe action))
, pageFormState : Pages.FormState.PageFormState
, pageFormState : Form.Model
}

1113
src/Form.elm
View File

File diff suppressed because it is too large Load Diff

424
src/Form/Field.elm
View File

@ -1,16 +1,22 @@
module Form.Field exposing
( text, checkbox, int, float
, select, range, OutsideRange(..)
( Field
, text, checkbox, int, float
, select, OutsideRange(..)
, date, time, TimeOfDay
, Field(..), FieldInfo, exactValue
, required, withClientValidation, withInitialValue, withOptionalInitialValue, map
, withInitialValue, withOptionalInitialValue
, exactValue
, required, withClientValidation, map
, email, password, search, telephone, url, textarea
, withMax, withMin, withStep, withMinLength, withMaxLength
, range, withMin, withMax
, withMinLength, withMaxLength
, withStep, withFloatStep
, No, Yes
)
{-|
@docs Field
## Base Fields
@ -19,7 +25,7 @@ module Form.Field exposing
## Multiple Choice Fields
@docs select, range, OutsideRange
@docs select, OutsideRange
## Date/Time Fields
@ -27,14 +33,19 @@ module Form.Field exposing
@docs date, time, TimeOfDay
## Initial Values
@docs withInitialValue, withOptionalInitialValue
## Other
@docs Field, FieldInfo, exactValue
@docs exactValue
## Field Configuration
@docs required, withClientValidation, withInitialValue, withOptionalInitialValue, map
@docs required, withClientValidation, map
## Text Field Display Options
@ -44,7 +55,11 @@ module Form.Field exposing
## Numeric Field Options
@docs withMax, withMin, withStep, withMinLength, withMaxLength
@docs range, withMin, withMax
@docs withMinLength, withMaxLength
@docs withStep, withFloatStep
## Phantom Options
@ -55,22 +70,15 @@ module Form.Field exposing
import Date exposing (Date)
import Dict exposing (Dict)
import Form.FieldView as FieldView exposing (Input, Options(..))
import Form.Value
import Form.FieldView exposing (Input)
import Internal.Field
import Internal.Input exposing (Options(..))
import Json.Encode as Encode
{-| -}
type Field error parsed data kind constraints
= Field (FieldInfo error parsed data) kind
{-| -}
type alias FieldInfo error parsed data =
{ initialValue : Maybe (data -> Maybe String)
, decode : Maybe String -> ( Maybe parsed, List error )
, properties : List ( String, Encode.Value )
}
type alias Field error parsed input initial kind constraints =
Internal.Field.Field error parsed input initial kind constraints
{-| -}
@ -90,16 +98,18 @@ required :
Field
error
(Maybe parsed)
data
kind
input
initial
{ constraints
| required : ()
, wasMapped : No
}
-> Field error parsed data kind { constraints | wasMapped : No }
required missingError (Field field kind) =
Field
-> Field error parsed kind input initial { constraints | wasMapped : No }
required missingError (Internal.Field.Field field kind) =
Internal.Field.Field
{ initialValue = field.initialValue
, initialToString = field.initialToString
, decode =
\rawValue ->
let
@ -118,6 +128,7 @@ required missingError (Field field kind) =
allErrors
)
, properties = field.properties
, compare = field.compare
}
kind
@ -127,18 +138,19 @@ text :
Field
error
(Maybe String)
data
input
String
Input
{ required : ()
, plainText : ()
, wasMapped : No
, initial : String
, minlength : ()
, maxlength : ()
}
text =
Field
{ initialValue = Nothing
Internal.Field.Field
{ initialValue = \_ -> Nothing
, initialToString = identity
, decode =
\rawValue ->
( if rawValue == Just "" then
@ -149,8 +161,9 @@ text =
, []
)
, properties = []
, compare = Basics.compare
}
(FieldView.Input FieldView.Text)
(Internal.Input.Input Internal.Input.Text)
{-| -}
@ -160,17 +173,19 @@ date :
Field
error
(Maybe Date)
data
input
Date
Input
{ min : Date
, max : Date
, required : ()
, wasMapped : No
, initial : Date
, step : Int
}
date toError =
Field
{ initialValue = Nothing
Internal.Field.Field
{ initialValue = \_ -> Nothing
, initialToString = Date.toIsoString
, decode =
\rawString ->
if (rawString |> Maybe.withDefault "") == "" then
@ -189,8 +204,14 @@ date toError =
Err error ->
( Nothing, [ error ] )
, properties = []
, compare =
\raw value ->
Result.map2 Date.compare
(Ok value)
(Date.fromIsoString raw)
|> Result.withDefault LT
}
(FieldView.Input FieldView.Date)
(Internal.Input.Input Internal.Input.Date)
{-| -}
@ -208,17 +229,18 @@ time :
Field
error
(Maybe TimeOfDay)
data
input
TimeOfDay
Input
{ -- TODO support min/max
--min : ???,
--, max : ???,
required : ()
{ min : TimeOfDay
, max : TimeOfDay
, required : ()
, wasMapped : No
}
time toError =
Field
{ initialValue = Nothing
Internal.Field.Field
{ initialValue = \_ -> Nothing
, initialToString = timeOfDayToString
, decode =
\rawString ->
if (rawString |> Maybe.withDefault "") == "" then
@ -237,13 +259,43 @@ time toError =
Err error ->
( Nothing, [ error ] )
, properties = []
, compare =
\raw value ->
parseTimeOfDay raw
|> Result.map
(\parsedRaw ->
if parsedRaw.hours == value.hours then
Basics.compare parsedRaw.minutes value.minutes
else
Basics.compare parsedRaw.hours value.hours
)
|> Result.withDefault LT
}
(FieldView.Input FieldView.Time)
(Internal.Input.Input Internal.Input.Time)
timeOfDayToString : TimeOfDay -> String
timeOfDayToString { hours, minutes } =
paddedInt hours ++ ":" ++ paddedInt minutes
paddedInt : Int -> String
paddedInt intValue =
intValue
|> String.fromInt
|> String.padLeft 2 '0'
parseTimeOfDay : String -> Result () { hours : Int, minutes : Int }
parseTimeOfDay rawTimeOfDay =
case rawTimeOfDay |> String.split ":" |> List.map String.toInt of
[ Just hours, Just minutes, Just _ ] ->
Ok
{ hours = hours
, minutes = minutes
}
[ Just hours, Just minutes ] ->
Ok
{ hours = hours
@ -262,7 +314,8 @@ select :
Field
error
(Maybe option)
data
input
option
(Options option)
{ required : ()
, wasMapped : No
@ -277,8 +330,9 @@ select optionsMapping invalidError =
fromString string =
Dict.get string dict
in
Field
{ initialValue = Nothing
Internal.Field.Field
{ initialValue = \_ -> Nothing
, initialToString = enumToString optionsMapping
, decode =
\rawValue ->
case rawValue of
@ -306,10 +360,24 @@ select optionsMapping invalidError =
]
)
, properties = []
, compare =
\_ _ ->
-- min/max properties aren't allowed for this field type
EQ
}
(Options fromString (optionsMapping |> List.map Tuple.first))
enumToString : List ( String, enum ) -> enum -> String
enumToString optionsMapping a =
case optionsMapping |> List.filter (\( _, b ) -> b == a) |> List.head of
Just ( str, _ ) ->
str
Nothing ->
"Missing enum"
{-| -}
exactValue :
String
@ -318,16 +386,17 @@ exactValue :
Field
error
String
data
input
Never
Input
{ required : ()
, plainText : ()
, wasMapped : No
, initial : String
}
exactValue initialValue error =
Field
{ initialValue = Just (\_ -> Just initialValue)
Internal.Field.Field
{ initialValue = \_ -> Nothing
, initialToString = never
, decode =
\rawValue ->
if rawValue == Just initialValue then
@ -336,8 +405,12 @@ exactValue initialValue error =
else
( rawValue, [ error ] )
, properties = []
, compare =
\_ _ ->
-- min/max properties aren't allowed for this field type
EQ
}
(FieldView.Input FieldView.Text)
(Internal.Input.Input Internal.Input.Text)
{-| -}
@ -345,14 +418,21 @@ checkbox :
Field
error
Bool
data
input
Bool
Input
{ required : ()
, initial : Bool
}
checkbox =
Field
{ initialValue = Nothing
Internal.Field.Field
{ initialValue = \_ -> Nothing
, initialToString =
\bool ->
if bool then
"on"
else
""
, decode =
\rawString ->
( (rawString == Just "on")
@ -360,8 +440,12 @@ checkbox =
, []
)
, properties = []
, compare =
\_ _ ->
-- min/max properties aren't allowed for this field type
EQ
}
(FieldView.Input FieldView.Checkbox)
(Internal.Input.Input Internal.Input.Checkbox)
{-| -}
@ -371,18 +455,19 @@ int :
Field
error
(Maybe Int)
data
input
Int
Input
{ min : Int
, max : Int
, required : ()
, wasMapped : No
, step : Int
, initial : Int
}
int toError =
Field
{ initialValue = Nothing
Internal.Field.Field
{ initialValue = \_ -> Nothing
, initialToString = String.fromInt
, decode =
\rawString ->
case rawString of
@ -400,8 +485,16 @@ int toError =
Nothing ->
( Nothing, [ toError.invalid string ] )
, properties = []
, compare =
\raw value ->
case String.toInt raw of
Just parsed ->
Basics.compare parsed value
_ ->
LT
}
(FieldView.Input FieldView.Number)
(Internal.Input.Input Internal.Input.Number)
{-| -}
@ -411,17 +504,18 @@ float :
Field
error
(Maybe Float)
data
input
Float
Input
{ min : Float
, max : Float
, required : ()
, wasMapped : No
, initial : Float
}
float toError =
Field
{ initialValue = Nothing
Internal.Field.Field
{ initialValue = \_ -> Nothing
, initialToString = String.fromFloat
, decode =
\rawString ->
case rawString of
@ -439,62 +533,70 @@ float toError =
Nothing ->
( Nothing, [ toError.invalid string ] )
, properties = []
, compare =
\raw value ->
case String.toFloat raw of
Just parsed ->
Basics.compare parsed value
_ ->
LT
}
(FieldView.Input FieldView.Number)
(Internal.Input.Input Internal.Input.Number)
{-| -}
telephone :
Field error parsed data Input { constraints | plainText : () }
-> Field error parsed data Input constraints
telephone (Field field _) =
Field field
(FieldView.Input FieldView.Tel)
Field error parsed input initial Input { constraints | plainText : () }
-> Field error parsed input initial Input constraints
telephone (Internal.Field.Field field _) =
Internal.Field.Field field
(Internal.Input.Input Internal.Input.Tel)
{-| -}
search :
Field error parsed data Input { constraints | plainText : () }
-> Field error parsed data Input constraints
search (Field field _) =
Field field
(FieldView.Input FieldView.Search)
Field error parsed input initial Input { constraints | plainText : () }
-> Field error parsed input initial Input constraints
search (Internal.Field.Field field _) =
Internal.Field.Field field
(Internal.Input.Input Internal.Input.Search)
{-| -}
password :
Field error parsed data Input { constraints | plainText : () }
-> Field error parsed data Input constraints
password (Field field _) =
Field field
(FieldView.Input FieldView.Password)
Field error parsed input initial Input { constraints | plainText : () }
-> Field error parsed input initial Input constraints
password (Internal.Field.Field field _) =
Internal.Field.Field field
(Internal.Input.Input Internal.Input.Password)
{-| -}
email :
Field error parsed data Input { constraints | plainText : () }
-> Field error parsed data Input constraints
email (Field field _) =
Field field
(FieldView.Input FieldView.Email)
Field error parsed input initial Input { constraints | plainText : () }
-> Field error parsed input initial Input constraints
email (Internal.Field.Field field _) =
Internal.Field.Field field
(Internal.Input.Input Internal.Input.Email)
{-| -}
url :
Field error parsed data Input { constraints | plainText : () }
-> Field error parsed data Input constraints
url (Field field _) =
Field field
(FieldView.Input FieldView.Url)
Field error parsed input initial Input { constraints | plainText : () }
-> Field error parsed input initial Input constraints
url (Internal.Field.Field field _) =
Internal.Field.Field field
(Internal.Input.Input Internal.Input.Url)
{-| -}
textarea :
{ rows : Maybe Int, cols : Maybe Int }
-> Field error parsed data Input { constraints | plainText : () }
-> Field error parsed data Input constraints
textarea options (Field field _) =
Field field (FieldView.Input (FieldView.Textarea options))
-> Field error parsed input initial Input { constraints | plainText : () }
-> Field error parsed input initial Input constraints
textarea options (Internal.Field.Field field _) =
Internal.Field.Field field (Internal.Input.Input (Internal.Input.Textarea options))
{-| -}
@ -505,9 +607,8 @@ type OutsideRange
{-| -}
range :
{ min : Form.Value.Value valueType
, max : Form.Value.Value valueType
, initial : data -> Form.Value.Value valueType
{ min : numberInitial
, max : numberInitial
, missing : error
, invalid : OutsideRange -> error
}
@ -515,32 +616,34 @@ range :
Field
error
(Maybe valueType)
data
input
numberInitial
kind
{ constraints
| required : ()
, initial : valueType
, min : valueType
, max : valueType
, min : numberInitial
, max : numberInitial
, wasMapped : No
}
->
Field
error
valueType
data
input
numberInitial
Input
{ constraints | wasMapped : No }
range info field =
-- TODO set the default value (if not overridden) using this https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input/range#value
field
|> required info.missing
|> withMin info.min (info.invalid BelowRange)
|> withMax info.max (info.invalid AboveRange)
|> (\(Field innerField _) -> Field { innerField | initialValue = Just (info.initial >> Form.Value.toString >> Just) } (FieldView.Input FieldView.Range))
|> (\(Internal.Field.Field innerField _) -> Internal.Field.Field innerField (Internal.Input.Input Internal.Input.Range))
{-| -}
map : (parsed -> mapped) -> Field error parsed data kind constraints -> Field error mapped data kind { constraints | wasMapped : Yes }
map : (parsed -> mapped) -> Field error parsed input initial kind constraints -> Field error mapped input initial kind { constraints | wasMapped : Yes }
map mapFn field_ =
withClientValidation
(\value -> ( Just (mapFn value), [] ))
@ -548,10 +651,11 @@ map mapFn field_ =
{-| -}
withClientValidation : (parsed -> ( Maybe mapped, List error )) -> Field error parsed data kind constraints -> Field error mapped data kind { constraints | wasMapped : Yes }
withClientValidation mapFn (Field field kind) =
Field
withClientValidation : (parsed -> ( Maybe mapped, List error )) -> Field error parsed input initial kind constraints -> Field error mapped input initial kind { constraints | wasMapped : Yes }
withClientValidation mapFn (Internal.Field.Field field kind) =
Internal.Field.Field
{ initialValue = field.initialValue
, initialToString = field.initialToString
, decode =
\value ->
value
@ -567,41 +671,17 @@ withClientValidation mapFn (Field field kind) =
|> Tuple.mapSecond ((++) errors)
)
, properties = field.properties
, compare = field.compare
}
kind
{-| -}
withInitialValue : (data -> Form.Value.Value valueType) -> Field error value data kind { constraints | initial : valueType } -> Field error value data kind constraints
withInitialValue toInitialValue (Field field kind) =
Field
{ field
| initialValue =
Just (toInitialValue >> Form.Value.toString >> Just)
}
kind
{-| -}
withOptionalInitialValue : (data -> Maybe (Form.Value.Value valueType)) -> Field error value data kind { constraints | initial : valueType } -> Field error value data kind constraints
withOptionalInitialValue toInitialValue (Field field kind) =
Field
{ field
| initialValue =
Just (toInitialValue >> Maybe.map Form.Value.toString)
}
kind
-- Input Properties
{-| -}
withMin : Form.Value.Value valueType -> error -> Field error parsed data kind { constraints | min : valueType } -> Field error parsed data kind constraints
withMin min error (Field field kind) =
Field
withMin : initial -> error -> Field error parsed input initial kind { constraints | min : initial } -> Field error parsed input initial kind constraints
withMin min error (Internal.Field.Field field kind) =
Internal.Field.Field
{ initialValue = field.initialValue
, initialToString = field.initialToString
, decode =
\value ->
value
@ -616,23 +696,25 @@ withMin min error (Field field kind) =
( Just okValue, errors )
else
case Form.Value.compare (value |> Maybe.withDefault "") min of
case field.compare (value |> Maybe.withDefault "") min of
LT ->
( Just okValue, error :: errors )
_ ->
( Just okValue, errors )
)
, properties = ( "min", Encode.string (Form.Value.toString min) ) :: field.properties
, properties = ( "min", Encode.string (field.initialToString min) ) :: field.properties
, compare = field.compare
}
kind
{-| -}
withMinLength : Int -> error -> Field error parsed data kind { constraints | minlength : () } -> Field error parsed data kind constraints
withMinLength minLength error (Field field kind) =
Field
withMinLength : Int -> error -> Field error parsed input initial kind { constraints | minlength : () } -> Field error parsed input initial kind constraints
withMinLength minLength error (Internal.Field.Field field kind) =
Internal.Field.Field
{ initialValue = field.initialValue
, initialToString = field.initialToString
, decode =
\value ->
value
@ -650,15 +732,17 @@ withMinLength minLength error (Field field kind) =
( Just okValue, error :: errors )
)
, properties = ( "minlength", Encode.string (String.fromInt minLength) ) :: field.properties
, compare = field.compare
}
kind
{-| -}
withMaxLength : Int -> error -> Field error parsed data kind { constraints | maxlength : () } -> Field error parsed data kind constraints
withMaxLength maxLength error (Field field kind) =
Field
withMaxLength : Int -> error -> Field error parsed input initial kind { constraints | maxlength : () } -> Field error parsed input initial kind constraints
withMaxLength maxLength error (Internal.Field.Field field kind) =
Internal.Field.Field
{ initialValue = field.initialValue
, initialToString = field.initialToString
, decode =
\value ->
value
@ -676,6 +760,7 @@ withMaxLength maxLength error (Field field kind) =
( Just okValue, error :: errors )
)
, properties = ( "maxlength", Encode.string (String.fromInt maxLength) ) :: field.properties
, compare = field.compare
}
kind
@ -686,10 +771,11 @@ isEmptyValue value =
{-| -}
withMax : Form.Value.Value valueType -> error -> Field error parsed data kind { constraints | max : valueType } -> Field error parsed data kind constraints
withMax max error (Field field kind) =
Field
withMax : initial -> error -> Field error parsed input initial kind { constraints | max : initial } -> Field error parsed input initial kind constraints
withMax max error (Internal.Field.Field field kind) =
Internal.Field.Field
{ initialValue = field.initialValue
, initialToString = field.initialToString
, decode =
\value ->
value
@ -704,26 +790,52 @@ withMax max error (Field field kind) =
( Just okValue, errors )
else
case Form.Value.compare (value |> Maybe.withDefault "") max of
case field.compare (value |> Maybe.withDefault "") max of
GT ->
( Just okValue, error :: errors )
_ ->
( Just okValue, errors )
)
, properties = ( "max", Encode.string (Form.Value.toString max) ) :: field.properties
, properties = ( "max", Encode.string (field.initialToString max) ) :: field.properties
, compare = field.compare
}
kind
{-| -}
withStep : Form.Value.Value valueType -> Field msg error value view { constraints | step : valueType } -> Field msg error value view constraints
withStep max field =
withStringProperty ( "step", Form.Value.toString max ) field
withStep : Int -> Field error value input initial view { constraints | step : Int } -> Field error value input initial view constraints
withStep step (Internal.Field.Field info kind) =
withStringProperty ( "step", String.fromInt step ) (Internal.Field.Field info kind)
withStringProperty : ( String, String ) -> Field error parsed data kind constraints1 -> Field error parsed data kind constraints2
withStringProperty ( key, value ) (Field field kind) =
Field
{-| -}
withFloatStep : Float -> Field error value input initial view { constraints | step : Float } -> Field error value input initial view constraints
withFloatStep step (Internal.Field.Field info kind) =
withStringProperty ( "step", String.fromFloat step ) (Internal.Field.Field info kind)
withStringProperty : ( String, String ) -> Field error parsed input initial kind constraints1 -> Field error parsed input initial kind constraints2
withStringProperty ( key, value ) (Internal.Field.Field field kind) =
Internal.Field.Field
{ field | properties = ( key, Encode.string value ) :: field.properties }
kind
{-| -}
withInitialValue : (input -> initial) -> Field error value input initial kind constraints -> Field error value input initial kind constraints
withInitialValue toInitialValue (Internal.Field.Field field kind) =
Internal.Field.Field
{ field | initialValue = toInitialValue >> field.initialToString >> Just }
kind
{-| -}
withOptionalInitialValue : (input -> Maybe initial) -> Field error value input initial kind constraints -> Field error value input initial kind constraints
withOptionalInitialValue toInitialValue (Internal.Field.Field field kind) =
Internal.Field.Field
{ field
| initialValue =
toInitialValue >> Maybe.map field.initialToString
}
kind

49
src/Form/FieldStatus.elm
View File

@ -1,36 +1,35 @@
module Form.FieldStatus exposing (FieldStatus(..), fieldStatusToString)
{-| elm-pages manages the client-side state of fields, including Status which you can use to determine when
in the user's workflow to show validation errors.
module Form.FieldStatus exposing
( FieldStatus
, blurred
, changed
, focused
, notVisited
)
## Field Status
@docs FieldStatus, fieldStatusToString
-}
type alias FieldStatus =
Int
{-| -}
type FieldStatus
= NotVisited
| Focused
| Changed
| Blurred
notVisited : Int
notVisited =
0
{-| -}
fieldStatusToString : FieldStatus -> String
fieldStatusToString fieldStatus =
case fieldStatus of
NotVisited ->
"NotVisited"
focused : Int
focused =
1
Focused ->
"Focused"
Changed ->
"Changed"
{-| -}
changed : Int
changed =
2
Blurred ->
"Blurred"
{-| -}
blurred : Int
blurred =
3

182
src/Form/FieldView.elm
View File

@ -1,16 +1,16 @@
module Form.FieldView exposing
( Input(..), InputType(..), Options(..), input, inputTypeToString, radio, toHtmlProperties, Hidden(..), select, valueButton
, radioStyled, inputStyled, valueButtonStyled
( Input, Options, input, radio, Hidden, select, valueButton
, radioStyled, selectStyled, inputStyled, valueButtonStyled
)
{-|
@docs Input, InputType, Options, input, inputTypeToString, radio, toHtmlProperties, Hidden, select, valueButton
@docs Input, Options, input, radio, Hidden, select, valueButton
## Html.Styled Helpers
@docs radioStyled, inputStyled, valueButtonStyled
@docs radioStyled, selectStyled, inputStyled, valueButtonStyled
-}
@ -19,88 +19,25 @@ import Html exposing (Html)
import Html.Attributes as Attr
import Html.Styled
import Html.Styled.Attributes as StyledAttr
import Internal.Input
import Json.Encode as Encode
import Pages.Internal.Form exposing (Validation(..), ViewField)
{-| -}
type InputType
= Text
| Number
-- TODO should range have arguments for initial, min, and max?
| Range
| Radio
-- TODO should submit be a special type, or an Input type?
-- TODO have an option for a submit with a name/value?
| Date
| Time
| Checkbox
| Tel
| Search
| Password
| Email
| Url
| Textarea { rows : Maybe Int, cols : Maybe Int }
{-| -}
inputTypeToString : InputType -> String
inputTypeToString inputType =
case inputType of
Text ->
"text"
Textarea _ ->
"text"
Number ->
"number"
Range ->
"range"
Radio ->
"radio"
Date ->
"date"
Time ->
"time"
Checkbox ->
"checkbox"
Tel ->
"tel"
Search ->
"search"
Password ->
"password"
Email ->
"email"
Url ->
"url"
{-| -}
type Input
= Input InputType
type alias Input =
Internal.Input.Input
{-| There are no render helpers for hidden fields because the `Form.renderHtml` helper functions automatically render hidden fields for you.
-}
type Hidden
= Hidden
type alias Hidden =
Internal.Input.Hidden
{-| -}
type Options a
= Options (String -> Maybe a) (List String)
type alias Options a =
Internal.Input.Options a
{-| Gives you a submit button that will submit the form with a specific value for the given Field.
@ -190,7 +127,7 @@ input attrs (Validation viewField fieldName _) =
}
in
case rawField.kind of
( Input (Textarea { rows, cols }), properties ) ->
( Internal.Input.Input (Internal.Input.Textarea { rows, cols }), properties ) ->
Html.textarea
(attrs
++ toHtmlProperties properties
@ -206,12 +143,12 @@ input attrs (Validation viewField fieldName _) =
Html.text (rawField.value |> Maybe.withDefault "")
]
( Input inputType, properties ) ->
( Internal.Input.Input inputType, properties ) ->
Html.input
(attrs
++ toHtmlProperties properties
++ [ (case inputType of
Checkbox ->
Internal.Input.Checkbox ->
Attr.checked ((rawField.value |> Maybe.withDefault "") == "on")
_ ->
@ -219,7 +156,7 @@ input attrs (Validation viewField fieldName _) =
-- TODO is this an okay default?
)
, Attr.name rawField.name
, inputType |> inputTypeToString |> Attr.type_
, inputType |> Internal.Input.inputTypeToString |> Attr.type_
]
)
[]
@ -244,7 +181,7 @@ inputStyled attrs (Validation viewField fieldName _) =
}
in
case rawField.kind of
( Input (Textarea { rows, cols }), properties ) ->
( Internal.Input.Input (Internal.Input.Textarea { rows, cols }), properties ) ->
Html.Styled.textarea
(attrs
++ (toHtmlProperties properties |> List.map StyledAttr.fromUnstyled)
@ -262,12 +199,12 @@ inputStyled attrs (Validation viewField fieldName _) =
Html.Styled.text (rawField.value |> Maybe.withDefault "")
]
( Input inputType, properties ) ->
( Internal.Input.Input inputType, properties ) ->
Html.Styled.input
(attrs
++ (toHtmlProperties properties |> List.map StyledAttr.fromUnstyled)
++ ([ (case inputType of
Checkbox ->
Internal.Input.Checkbox ->
Attr.checked ((rawField.value |> Maybe.withDefault "") == "on")
_ ->
@ -275,7 +212,7 @@ inputStyled attrs (Validation viewField fieldName _) =
-- TODO is this an okay default?
)
, Attr.name rawField.name
, inputType |> inputTypeToString |> Attr.type_
, inputType |> Internal.Input.inputTypeToString |> Attr.type_
]
|> List.map StyledAttr.fromUnstyled
)
@ -308,7 +245,7 @@ select selectAttrs enumToOption (Validation viewField fieldName _) =
, kind = justViewField.kind
}
(Options parseValue possibleValues) =
(Internal.Input.Options parseValue possibleValues) =
rawField.kind |> Tuple.first
in
Html.select
@ -332,7 +269,79 @@ select selectAttrs enumToOption (Validation viewField fieldName _) =
( optionAttrs, content ) =
enumToOption justParsed
in
Html.option (Attr.value possibleValue :: optionAttrs) [ Html.text content ]
Html.option
(if rawField.value == Just possibleValue then
Attr.selected True :: Attr.value possibleValue :: optionAttrs
else
Attr.value possibleValue :: optionAttrs
)
[ Html.text content ]
|> Just
Nothing ->
Nothing
)
)
{-| -}
selectStyled :
List (Html.Styled.Attribute msg)
->
(parsed
->
( List (Html.Styled.Attribute msg)
, String
)
)
-> Form.Validation.Field error parsed2 (Options parsed)
-> Html.Styled.Html msg
selectStyled selectAttrs enumToOption (Validation viewField fieldName _) =
let
justViewField : ViewField (Options parsed)
justViewField =
viewField |> expectViewField
rawField : { name : String, value : Maybe String, kind : ( Options parsed, List ( String, Encode.Value ) ) }
rawField =
{ name = fieldName |> Maybe.withDefault ""
, value = justViewField.value
, kind = justViewField.kind
}
(Internal.Input.Options parseValue possibleValues) =
rawField.kind |> Tuple.first
in
Html.Styled.select
(selectAttrs
++ [ StyledAttr.value (rawField.value |> Maybe.withDefault "")
, StyledAttr.name rawField.name
]
)
(possibleValues
|> List.filterMap
(\possibleValue ->
let
parsed : Maybe parsed
parsed =
possibleValue
|> parseValue
in
case parsed of
Just justParsed ->
let
( optionAttrs, content ) =
enumToOption justParsed
in
Html.Styled.option
(if rawField.value == Just possibleValue then
StyledAttr.selected True :: StyledAttr.value possibleValue :: optionAttrs
else
StyledAttr.value possibleValue :: optionAttrs
)
[ Html.Styled.text content ]
|> Just
Nothing ->
@ -364,7 +373,7 @@ radio selectAttrs enumToOption (Validation viewField fieldName _) =
, kind = justViewField.kind
}
(Options parseValue possibleValues) =
(Internal.Input.Options parseValue possibleValues) =
rawField.kind |> Tuple.first
in
Html.fieldset
@ -441,7 +450,7 @@ radioStyled selectAttrs enumToOption (Validation viewField fieldName _) =
, kind = justViewField.kind
}
(Options parseValue possibleValues) =
(Internal.Input.Options parseValue possibleValues) =
rawField.kind |> Tuple.first
in
Html.Styled.fieldset
@ -487,7 +496,6 @@ radioStyled selectAttrs enumToOption (Validation viewField fieldName _) =
)
{-| -}
toHtmlProperties : List ( String, Encode.Value ) -> List (Html.Attribute msg)
toHtmlProperties properties =
properties

282
src/Form/Handler.elm Normal file
View File

@ -0,0 +1,282 @@
module Form.Handler exposing
( Handler
, init, with
, run
)
{-|
@docs Handler
@docs init, with
@docs run
-}
import Dict exposing (Dict)
import Form exposing (Validated)
import Form.FieldStatus
import Form.Validation exposing (Combined, Validation)
import Internal.Form exposing (Form)
import Pages.FormState exposing (FormState)
import Pages.Internal.Form
{-| -}
type Handler error parsed
= Handler
(List
(Form
error
(Combined error parsed)
Never
Never
Never
)
)
{-| -}
init :
(parsed -> combined)
->
Form
error
{ combineAndView
| combine : Validation error parsed kind constraints
}
parsed
input
msg
-> Handler error combined
init mapFn form =
Handler [ normalizeServerForm mapFn form ]
{-| -}
with :
(parsed -> combined)
->
Form
error
{ combineAndView
| combine : Validation error parsed kind constraints
}
parsed
input
msg
-> Handler error combined
-> Handler error combined
with mapFn form (Handler serverForms) =
Handler (serverForms ++ [ normalizeServerForm mapFn form ])
--{-| -}
--initCombinedServer :
-- (parsed -> combined)
-- ->
-- Form
-- error
-- { combineAndView
-- | combine : Combined error (BackendTask backendTaskError (Form.Validation.Validation error parsed kind constraints))
-- }
-- parsed
-- input
-- msg
-- -> ServerForms error (BackendTask backendTaskError (Form.Validation.Validation error combined kind constraints))
--initCombinedServer mapFn serverForms =
-- init (BackendTask.map (Form.Validation.map mapFn)) serverForms
--
--
--{-| -}
--combineServer :
-- (parsed -> combined)
-- ->
-- Form
-- error
-- { combineAndView
-- | combine :
-- Combined error (BackendTask backendTaskError (Form.Validation.Validation error parsed kind constraints))
-- }
-- parsed
-- input
-- msg
-- -> ServerForms error (BackendTask backendTaskError (Form.Validation.Validation error combined kind constraints))
-- -> ServerForms error (BackendTask backendTaskError (Form.Validation.Validation error combined kind constraints))
--combineServer mapFn a b =
-- combine (BackendTask.map (Form.Validation.map mapFn)) a b
normalizeServerForm :
(parsed -> combined)
-> Form error { combineAndView | combine : Validation error parsed kind constraints } parsed input msg
-> Form error (Combined error combined) Never Never Never
normalizeServerForm mapFn (Internal.Form.Form options _ parseFn _) =
Internal.Form.Form
{ onSubmit = Nothing
, method = options.method
}
[]
(\_ formState ->
let
parsed :
{ result : Dict String (List error)
, isMatchCandidate : Bool
, combineAndView : { combineAndView | combine : Validation error parsed kind constraints }
}
parsed =
parseFn Nothing formState
in
{ result = parsed.result
, combineAndView = parsed.combineAndView.combine |> Form.Validation.mapToCombined mapFn
, isMatchCandidate = parsed.isMatchCandidate
}
)
(\_ -> [])
{-| -}
run :
List ( String, String )
-> Handler error parsed
-> Validated error parsed
run rawFormData forms =
case runOneOfServerSideHelp rawFormData Nothing forms of
( Just parsed, errors ) ->
if Dict.isEmpty errors then
Form.Valid parsed
else
Form.Invalid (Just parsed) errors
( Nothing, errors ) ->
Form.Invalid Nothing errors
{-| -}
runOneOfServerSideHelp :
List ( String, String )
-> Maybe (List ( String, List error ))
-> Handler error parsed
-> ( Maybe parsed, Dict String (List error) )
runOneOfServerSideHelp rawFormData firstFoundErrors (Handler parsers) =
case parsers of
firstParser :: remainingParsers ->
let
( isMatchCandidate, thing1 ) =
runServerSide rawFormData firstParser
thing : ( Maybe parsed, List ( String, List error ) )
thing =
thing1
|> Tuple.mapSecond
(\errors ->
errors
|> Dict.toList
|> List.filter (Tuple.second >> List.isEmpty >> not)
)
in
case ( isMatchCandidate, thing ) of
( True, ( Just parsed, errors ) ) ->
( Just parsed, errors |> Dict.fromList )
( _, ( _, errors ) ) ->
runOneOfServerSideHelp rawFormData
(firstFoundErrors
-- TODO is this logic what we want here? Might need to think through the semantics a bit more
-- of which errors to parse into - could be the first errors, the last, or some other way of
-- having higher precedence for deciding which form should be used
|> Maybe.withDefault errors
|> Just
)
(Handler remainingParsers)
[] ->
-- TODO need to pass errors
( Nothing, firstFoundErrors |> Maybe.withDefault [] |> Dict.fromList )
{-| -}
runServerSide :
List ( String, String )
-> Form error (Validation error parsed kind constraints) Never input msg
-> ( Bool, ( Maybe parsed, Dict String (List error) ) )
runServerSide rawFormData (Internal.Form.Form _ _ parser _) =
let
parsed :
{ result : Dict String (List error)
, isMatchCandidate : Bool
, combineAndView : Validation error parsed kind constraints
}
parsed =
parser Nothing thisFormState
thisFormState : FormState
thisFormState =
{ fields =
rawFormData
|> List.map
(Tuple.mapSecond
(\value ->
{ value = value
, status = Form.FieldStatus.notVisited
}
)
)
|> Dict.fromList
, submitAttempted = False
}
in
( parsed.isMatchCandidate
, { result = ( parsed.combineAndView, parsed.result )
}
|> mergeResults
|> unwrapValidation
)
mergeResults :
{ a | result : ( Validation error parsed named constraints1, Dict String (List error) ) }
-> Validation error parsed unnamed constraints2
mergeResults parsed =
case parsed.result of
( Pages.Internal.Form.Validation _ name ( parsedThing, combineErrors ), individualFieldErrors ) ->
Pages.Internal.Form.Validation Nothing
name
( parsedThing
, mergeErrors combineErrors individualFieldErrors
)
unwrapValidation : Validation error parsed named constraints -> ( Maybe parsed, Dict String (List error) )
unwrapValidation (Pages.Internal.Form.Validation _ _ ( maybeParsed, errors )) =
( maybeParsed, errors )
mergeErrors : Dict comparable (List value) -> Dict comparable (List value) -> Dict comparable (List value)
mergeErrors errors1 errors2 =
Dict.merge
(\key entries soFar ->
soFar |> insertIfNonempty key entries
)
(\key entries1 entries2 soFar ->
soFar |> insertIfNonempty key (entries1 ++ entries2)
)
(\key entries soFar ->
soFar |> insertIfNonempty key entries
)
errors1
errors2
Dict.empty
insertIfNonempty : comparable -> List value -> Dict comparable (List value) -> Dict comparable (List value)
insertIfNonempty key values dict =
if values |> List.isEmpty then
dict
else
dict
|> Dict.insert key values

101
src/Form/Validation.elm
View File

@ -1,10 +1,12 @@
module Form.Validation exposing
( Combined, Field, Validation
, andMap, andThen, fail, fromMaybe, fromResult, map, map2, parseWithError, succeed, succeed2, withError, withErrorIf, withFallback
, value, fieldName, fieldStatus
, andMap, andThen, fail, fromMaybe, fromResult, map, map2, parseWithError, succeed, withError, withErrorIf, withFallback
, value, fieldName
, FieldStatus(..), fieldStatus, fieldStatusToString
, statusAtLeast
, map3, map4, map5, map6, map7, map8, map9
, mapToCombined
, global
, mapWithNever
)
{-|
@ -14,28 +16,29 @@ module Form.Validation exposing
@docs Combined, Field, Validation
@docs andMap, andThen, fail, fromMaybe, fromResult, map, map2, parseWithError, succeed, succeed2, withError, withErrorIf, withFallback
@docs andMap, andThen, fail, fromMaybe, fromResult, map, map2, parseWithError, succeed, withError, withErrorIf, withFallback
## Field Metadata
@docs value, fieldName, fieldStatus
@docs value, fieldName
@docs FieldStatus, fieldStatus, fieldStatusToString
@docs statusAtLeast
## Mapping
@docs map3, map4, map5, map6, map7, map8, map9
@docs mapToCombined
## Global Validation
@docs global
## Temporary?
@docs mapWithNever
-}
import Dict exposing (Dict)
@ -71,6 +74,74 @@ fieldStatus (Pages.Internal.Form.Validation viewField _ _) =
viewField
|> expectViewField
|> .status
|> statusFromRank
{-| -}
fieldStatusToString : FieldStatus -> String
fieldStatusToString status =
case status of
NotVisited ->
"NotVisited"
Focused ->
"Focused"
Changed ->
"Changed"
Blurred ->
"Blurred"
{-| -}
statusAtLeast : FieldStatus -> Field error parsed kind -> Bool
statusAtLeast status field =
(field |> fieldStatus |> statusRank) >= statusRank status
{-| -}
type FieldStatus
= NotVisited
| Focused
| Changed
| Blurred
statusFromRank : Int -> FieldStatus
statusFromRank int =
case int of
0 ->
NotVisited
1 ->
Focused
2 ->
Changed
3 ->
Blurred
_ ->
Blurred
{-| -}
statusRank : FieldStatus -> Int
statusRank status =
case status of
NotVisited ->
0
Focused ->
1
Changed ->
2
Blurred ->
3
expectViewField : Maybe (ViewField kind) -> ViewField kind
@ -89,12 +160,6 @@ succeed parsed =
Pages.Internal.Form.Validation Nothing Nothing ( Just parsed, Dict.empty )
{-| -}
succeed2 : parsed -> Validation error parsed kind constraints
succeed2 parsed =
Pages.Internal.Form.Validation Nothing Nothing ( Just parsed, Dict.empty )
{-| -}
global : Field error () Never
global =
@ -166,8 +231,8 @@ map mapFn (Pages.Internal.Form.Validation _ name ( maybeParsedA, errorsA )) =
{-| -}
mapWithNever : (parsed -> mapped) -> Validation error parsed named constraint -> Validation error mapped Never Never
mapWithNever mapFn (Pages.Internal.Form.Validation _ name ( maybeParsedA, errorsA )) =
mapToCombined : (parsed -> mapped) -> Validation error parsed named constraint -> Combined error mapped
mapToCombined mapFn (Pages.Internal.Form.Validation _ name ( maybeParsedA, errorsA )) =
Pages.Internal.Form.Validation Nothing name ( Maybe.map mapFn maybeParsedA, errorsA )

118
src/Form/Value.elm
View File

@ -1,118 +0,0 @@
module Form.Value exposing
( Value, date, float, int, string, bool, toString
, compare
)
{-|
@docs Value, date, float, int, string, bool, toString
## Comparison
@docs compare
-}
import Date exposing (Date)
type Kind
= StringValue
| DateValue
| IntValue
| FloatValue
| BoolValue
{-| -}
type Value dataType
= Value Kind String
{-| -}
toString : Value dataType -> String
toString (Value _ rawValue) =
rawValue
{-| -}
date : Date -> Value Date
date date_ =
date_
|> Date.toIsoString
|> Value DateValue
{-| -}
float : Float -> Value Float
float float_ =
float_
|> String.fromFloat
|> Value FloatValue
{-| -}
int : Int -> Value Int
int int_ =
int_
|> String.fromInt
|> Value IntValue
{-| -}
bool : Bool -> Value Bool
bool bool_ =
(case bool_ of
True ->
"on"
False ->
""
)
|> Value BoolValue
{-| -}
string : String -> Value String
string string_ =
string_
|> Value StringValue
{-| You probably don't need this helper as it's mostly useful for internal implementation.
-}
compare : String -> Value value -> Order
compare a (Value kind rawValue) =
case kind of
IntValue ->
case ( String.toInt a, String.toInt rawValue ) of
( Just parsedA, Just parsedB ) ->
Basics.compare parsedA parsedB
_ ->
LT
StringValue ->
-- the phantom types in the Field API don't ever run this, so it won't be called there
-- Just in case anyone calls it, it delegates to Basics.compare
Basics.compare a rawValue
BoolValue ->
-- the phantom types in the Field API don't ever run this, so it won't be called there
-- Just in case anyone calls it, it delegates to Basics.compare
Basics.compare a rawValue
DateValue ->
Result.map2 Date.compare
(Date.fromIsoString a)
(Date.fromIsoString rawValue)
|> Result.withDefault LT
FloatValue ->
case ( String.toFloat a, String.toFloat rawValue ) of
( Just parsedA, Just parsedB ) ->
Basics.compare parsedA parsedB
_ ->
LT

102
src/FormDecoder.elm
View File

@ -1,102 +0,0 @@
module FormDecoder exposing (encodeFormData, formDataOnSubmit, methodToString)
import Form.FormData as FormData exposing (FormData)
import Html
import Html.Events
import Json.Decode as Decode
import Json.Encode
import Url
formDataOnSubmit : Html.Attribute FormData
formDataOnSubmit =
Html.Events.preventDefaultOn "submit"
(Decode.map4 FormData
(Decode.value
|> Decode.andThen
(\decodeValue ->
case Decode.decodeValue tuplesDecoder (decoder decodeValue) of
Ok decoded ->
Decode.succeed decoded
Err error ->
Decode.succeed
[ ( "error"
, Decode.errorToString error
)
]
)
)
(currentForm "method" methodDecoder)
(currentForm "action" Decode.string)
(currentForm "id" (Decode.nullable Decode.string))
|> Decode.map alwaysPreventDefault
)
currentForm : String -> Decode.Decoder a -> Decode.Decoder a
currentForm field decoder_ =
Decode.oneOf
[ Decode.at [ "submitter", "form" ] decoder_
, Decode.at [ "currentTarget", field ] decoder_
]
methodDecoder : Decode.Decoder FormData.Method
methodDecoder =
Decode.string
|> Decode.map
(\methodString ->
case methodString |> String.toUpper of
"GET" ->
FormData.Get
"POST" ->
FormData.Post
_ ->
-- TODO what about "dialog" method? Is it okay for that to be interpreted as GET,
-- or should there be a variant for that?
FormData.Get
)
decoder : Decode.Value -> Decode.Value
decoder event =
Json.Encode.string "REPLACE_ME_WITH_FORM_TO_STRING"
alwaysPreventDefault : msg -> ( msg, Bool )
alwaysPreventDefault msg =
( msg, True )
tuplesDecoder : Decode.Decoder (List ( String, String ))
tuplesDecoder =
Decode.list
(Decode.map2 Tuple.pair
(Decode.index 0 Decode.string)
(Decode.index 1 Decode.string)
)
methodToString : FormData.Method -> String
methodToString method =
case method of
FormData.Get ->
"GET"
FormData.Post ->
"POST"
encodeFormData :
FormData
-> String
encodeFormData data =
data.fields
|> List.map
(\( name, value ) ->
Url.percentEncode name ++ "=" ++ Url.percentEncode value
)
|> String.join "&"

19
src/Internal/Field.elm Normal file
View File

@ -0,0 +1,19 @@
module Internal.Field exposing (Field(..), FieldInfo)
{-| -}
import Json.Encode as Encode
type Field error parsed input initial kind constraints
= Field (FieldInfo error parsed input initial) kind
{-| -}
type alias FieldInfo error parsed input initial =
{ initialValue : input -> Maybe String
, decode : Maybe String -> ( Maybe parsed, List error )
, properties : List ( String, Encode.Value )
, initialToString : initial -> String
, compare : String -> initial -> Order
}

105
src/Internal/FieldEvent.elm Normal file
View File

@ -0,0 +1,105 @@
module Internal.FieldEvent exposing (Event(..), FieldEvent, FormData, Method(..), Msg(..), formDataOnSubmit)
import Html
import Html.Events
import Json.Decode as Decode exposing (Decoder)
type alias FieldEvent =
{ value : String
, formId : String
, name : String
, event : Event
}
type Event
= InputEvent String
| FocusEvent
--| ChangeEvent
| BlurEvent
type Msg msg
= Submit FormData (Maybe msg)
| FormFieldEvent FieldEvent
| UserMsg msg
type alias FormData =
{ fields : Maybe (List ( String, String ))
, method : Method
, action : String
, id : Maybe String
}
type Method
= Get
| Post
formDataOnSubmit : Html.Attribute FormData
formDataOnSubmit =
Html.Events.preventDefaultOn "submit"
(Decode.map4
(\fields method action id ->
{ fields = fields
, method = method
, action = action
, id = id
}
)
fieldsDecoder
(currentForm "method" methodDecoder)
(currentForm "action" Decode.string)
(currentForm "id" (Decode.nullable Decode.string))
|> Decode.map alwaysPreventDefault
)
fieldsDecoder : Decoder (Maybe (List ( String, String )))
fieldsDecoder =
Decode.maybe
(Decode.field "fields" tuplesDecoder)
alwaysPreventDefault : msg -> ( msg, Bool )
alwaysPreventDefault msg =
( msg, True )
tuplesDecoder : Decoder (List ( String, String ))
tuplesDecoder =
Decode.list
(Decode.map2 Tuple.pair
(Decode.index 0 Decode.string)
(Decode.index 1 Decode.string)
)
currentForm : String -> Decoder a -> Decoder a
currentForm field_ decoder_ =
Decode.oneOf
[ Decode.at [ "submitter", "form" ] decoder_
, Decode.at [ "currentTarget", field_ ] decoder_
]
methodDecoder : Decoder Method
methodDecoder =
Decode.string
|> Decode.map
(\methodString ->
case methodString |> String.toUpper of
"GET" ->
Get
"POST" ->
Get
_ ->
-- TODO what about "dialog" method? Is it okay for that to be interpreted as GET,
-- or should there be a variant for that?
Get
)

49
src/Internal/Form.elm Normal file
View File

@ -0,0 +1,49 @@
module Internal.Form exposing (FieldDefinition(..), Form(..), Method(..), RenderOptions, methodToString)
{-| -}
import Dict exposing (Dict)
import Pages.FormState exposing (FormState)
type Form error combineAndView parsed input userMsg
= Form
(RenderOptions error parsed userMsg)
(List ( String, FieldDefinition ))
(Maybe input
-> FormState
->
{ result : Dict String (List error)
, isMatchCandidate : Bool
, combineAndView : combineAndView
}
)
(input -> List ( String, Maybe String ))
type alias RenderOptions error parsed userMsg =
{ method : Method
, onSubmit : Maybe ({ fields : List ( String, String ), parsed : ( Maybe parsed, Dict String (List error) ) } -> userMsg)
}
{-| -}
type Method
= Post
| Get
{-| -}
type FieldDefinition
= RegularField
| HiddenField
methodToString : Method -> String
methodToString method =
case method of
Post ->
"POST"
Get ->
"GET"

81
src/Internal/Input.elm Normal file
View File

@ -0,0 +1,81 @@
module Internal.Input exposing
( Hidden(..)
, Input(..)
, InputType(..)
, Options(..)
, inputTypeToString
)
type InputType
= Text
| Number
-- TODO should range have arguments for initial, min, and max?
| Range
| Radio
-- TODO should submit be a special type, or an Input type?
-- TODO have an option for a submit with a name/value?
| Date
| Time
| Checkbox
| Tel
| Search
| Password
| Email
| Url
| Textarea { rows : Maybe Int, cols : Maybe Int }
inputTypeToString : InputType -> String
inputTypeToString inputType =
case inputType of
Text ->
"text"
Textarea _ ->
"text"
Number ->
"number"
Range ->
"range"
Radio ->
"radio"
Date ->
"date"
Time ->
"time"
Checkbox ->
"checkbox"
Tel ->
"tel"
Search ->
"search"
Password ->
"password"
Email ->
"email"
Url ->
"url"
type Input
= Input InputType
type Hidden
= Hidden
type Options a
= Options (String -> Maybe a) (List String)

195
src/Pages/FormState.elm
View File

@ -1,55 +1,40 @@
module Pages.FormState exposing (Event(..), FieldEvent, FieldState, FormState, PageFormState, init, listeners, setField, setSubmitAttempted, update)
{-|
@docs Event, FieldEvent, FieldState, FormState, PageFormState, init, listeners, setField, setSubmitAttempted, update
-}
module Pages.FormState exposing (FieldState, FormState, listeners)
import Dict exposing (Dict)
import Form.FieldStatus as FieldStatus exposing (FieldStatus)
import Form.FieldStatus exposing (FieldStatus)
import Html exposing (Attribute)
import Html.Attributes as Attr
import Html.Events
import Internal.FieldEvent exposing (Event(..), FieldEvent)
import Json.Decode as Decode exposing (Decoder)
import Pages.Internal.Msg
import PagesMsg exposing (PagesMsg)
{-| -}
listeners : String -> List (Attribute (PagesMsg userMsg))
listeners : String -> List (Attribute FieldEvent)
listeners formId =
[ Html.Events.on "focusin" (Decode.value |> Decode.map Pages.Internal.Msg.FormFieldEvent)
, Html.Events.on "focusout" (Decode.value |> Decode.map Pages.Internal.Msg.FormFieldEvent)
, Html.Events.on "input" (Decode.value |> Decode.map Pages.Internal.Msg.FormFieldEvent)
[ Html.Events.on "focusin" fieldEventDecoder
, Html.Events.on "focusout" fieldEventDecoder
, Html.Events.on "input" fieldEventDecoder
, Attr.id formId
]
{-| -}
type Event
= InputEvent String
| FocusEvent
--| ChangeEvent
| BlurEvent
{-| -}
type alias FieldEvent =
{ value : String
, formId : String
, name : String
, event : Event
}
{-| -}
fieldEventDecoder : Decoder FieldEvent
fieldEventDecoder =
Decode.map4 FieldEvent
inputValueDecoder
(Decode.at [ "currentTarget", "id" ] Decode.string)
(Decode.at [ "target", "name" ] Decode.string)
(Decode.at [ "target", "name" ] Decode.string
|> Decode.andThen
(\name ->
if name == "" then
Decode.fail "Events only run on fields with names."
else
Decode.succeed name
)
)
fieldDecoder
@ -60,6 +45,9 @@ inputValueDecoder =
|> Decode.andThen
(\targetType ->
case targetType of
"button" ->
Decode.fail "Input and focus events don't run on buttons."
"checkbox" ->
Decode.map2
(\valueWhenChecked isChecked ->
@ -100,122 +88,6 @@ fieldDecoder =
)
{-| -}
update : Decode.Value -> PageFormState -> PageFormState
update eventObject pageFormState =
--if Dict.isEmpty pageFormState then
-- -- TODO get all initial field values
-- pageFormState
--
--else
case eventObject |> Decode.decodeValue fieldEventDecoder of
Ok fieldEvent ->
pageFormState
|> Dict.update fieldEvent.formId
(\previousValue_ ->
let
previousValue : FormState
previousValue =
previousValue_
|> Maybe.withDefault init
in
previousValue
|> updateForm fieldEvent
|> Just
)
Err _ ->
pageFormState
{-| -}
setField : { formId : String, name : String, value : String } -> PageFormState -> PageFormState
setField info pageFormState =
pageFormState
|> Dict.update info.formId
(\previousValue_ ->
let
previousValue : FormState
previousValue =
previousValue_
|> Maybe.withDefault init
in
{ previousValue
| fields =
previousValue.fields
|> Dict.update info.name
(\previousFieldValue_ ->
let
previousFieldValue : FieldState
previousFieldValue =
previousFieldValue_
|> Maybe.withDefault { value = "", status = FieldStatus.NotVisited }
in
{ previousFieldValue | value = info.value }
|> Just
)
}
|> Just
)
{-| -}
updateForm : FieldEvent -> FormState -> FormState
updateForm fieldEvent formState =
{ formState
| fields =
formState.fields
|> Dict.update fieldEvent.name
(\previousValue_ ->
let
previousValue : FieldState
previousValue =
previousValue_
|> Maybe.withDefault { value = fieldEvent.value, status = FieldStatus.NotVisited }
in
(case fieldEvent.event of
InputEvent newValue ->
{ previousValue | value = newValue }
FocusEvent ->
{ previousValue | status = previousValue.status |> increaseStatusTo FieldStatus.Focused }
BlurEvent ->
{ previousValue | status = previousValue.status |> increaseStatusTo FieldStatus.Blurred }
)
|> Just
)
}
{-| -}
setSubmitAttempted : String -> PageFormState -> PageFormState
setSubmitAttempted fieldId pageFormState =
pageFormState
|> Dict.update fieldId
(\maybeForm ->
case maybeForm of
Just formState ->
Just { formState | submitAttempted = True }
Nothing ->
Just { init | submitAttempted = True }
)
{-| -}
init : FormState
init =
{ fields = Dict.empty
, submitAttempted = False
}
{-| -}
type alias PageFormState =
Dict String FormState
{-| -}
type alias FormState =
{ fields : Dict String FieldState
@ -228,30 +100,3 @@ type alias FieldState =
{ value : String
, status : FieldStatus
}
{-| -}
increaseStatusTo : FieldStatus -> FieldStatus -> FieldStatus
increaseStatusTo increaseTo currentStatus =
if statusRank increaseTo > statusRank currentStatus then
increaseTo
else
currentStatus
{-| -}
statusRank : FieldStatus -> Int
statusRank status =
case status of
FieldStatus.NotVisited ->
0
FieldStatus.Focused ->
1
FieldStatus.Changed ->
2
FieldStatus.Blurred ->
3

22
src/Pages/Internal/Form.elm
View File

@ -1,4 +1,4 @@
module Pages.Internal.Form exposing (Response(..), Validation(..), ViewField, unwrapResponse)
module Pages.Internal.Form exposing (Validation(..), ViewField)
import Dict exposing (Dict)
import Form.FieldStatus exposing (FieldStatus)
@ -15,23 +15,3 @@ type alias ViewField kind =
, status : FieldStatus
, kind : ( kind, List ( String, Encode.Value ) )
}
{-| -}
type Response error
= Response
{ fields : List ( String, String )
, errors : Dict String (List error)
, clientErrors : Dict String (List error)
}
unwrapResponse :
Response error
->
{ fields : List ( String, String )
, errors : Dict String (List error)
, clientErrors : Dict String (List error)
}
unwrapResponse (Response response) =
response

126
src/Pages/Internal/Msg.elm
View File

@ -1,13 +1,17 @@
module Pages.Internal.Msg exposing
( Msg(..)
, fetcherOnSubmit
, map
, onSubmit
, submitIfValid
( Msg(..)
--, fetcherOnSubmit
, map
--, onSubmit
--, submitIfValid
)
import Form.FormData exposing (FormData)
import FormDecoder
--import Form.FormData exposing (FormData)
--import FormDecoder
import Form
import Html exposing (Attribute)
import Html.Attributes as Attr
import Json.Decode
@ -16,54 +20,56 @@ import Json.Decode
{-| -}
type Msg userMsg
= UserMsg userMsg
| Submit FormData
| SubmitIfValid String FormData Bool (Maybe userMsg)
| SubmitFetcher String FormData Bool (Maybe userMsg)
| FormFieldEvent Json.Decode.Value
| 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)
| NoOp
{-| -}
onSubmit : Attribute (Msg userMsg)
onSubmit =
FormDecoder.formDataOnSubmit
|> Attr.map Submit
{-| -}
submitIfValid : Maybe ({ fields : List ( String, String ) } -> userMsg) -> String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
submitIfValid userMsg formId isValid =
FormDecoder.formDataOnSubmit
|> Attr.map
(\formData ->
SubmitIfValid formId
formData
(isValid formData.fields)
(userMsg
|> Maybe.map
(\toUserMsg ->
toUserMsg { fields = formData.fields }
)
)
)
{-| -}
fetcherOnSubmit : Maybe ({ fields : List ( String, String ) } -> userMsg) -> String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
fetcherOnSubmit userMsg formId isValid =
FormDecoder.formDataOnSubmit
|> Attr.map
(\formData ->
SubmitFetcher formId
formData
(isValid formData.fields)
(userMsg
|> Maybe.map
(\toUserMsg ->
toUserMsg { fields = formData.fields }
)
)
)
--{-| -}
--onSubmit : Attribute (Msg userMsg)
--onSubmit =
-- FormDecoder.formDataOnSubmit
-- |> Attr.map Submit
--
--
--{-| -}
--submitIfValid : Maybe ({ fields : List ( String, String ) } -> userMsg) -> String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
--submitIfValid userMsg formId isValid =
-- FormDecoder.formDataOnSubmit
-- |> Attr.map
-- (\formData ->
-- SubmitIfValid formId
-- formData
-- (isValid formData.fields)
-- (userMsg
-- |> Maybe.map
-- (\toUserMsg ->
-- toUserMsg { fields = formData.fields }
-- )
-- )
-- )
--
--
--
--{-| -}
--fetcherOnSubmit : Maybe ({ fields : List ( String, String ) } -> userMsg) -> String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
--fetcherOnSubmit userMsg formId isValid =
-- FormDecoder.formDataOnSubmit
-- |> Attr.map
-- (\formData ->
-- SubmitFetcher formId
-- formData
-- (isValid formData.fields)
-- (userMsg
-- |> Maybe.map
-- (\toUserMsg ->
-- toUserMsg { fields = formData.fields }
-- )
-- )
-- )
{-| -}
@ -74,16 +80,16 @@ map mapFn msg =
UserMsg (mapFn userMsg)
Submit info ->
Submit info
Submit
{ valid = info.valid
, fields = info.fields
, id = info.id
, msg = Maybe.map mapFn info.msg
, useFetcher = info.useFetcher
}
SubmitIfValid formId info isValid toUserMsg ->
SubmitIfValid formId info isValid (Maybe.map mapFn toUserMsg)
SubmitFetcher formId info isValid toUserMsg ->
SubmitFetcher formId info isValid (Maybe.map mapFn toUserMsg)
FormFieldEvent value ->
FormFieldEvent value
FormMsg value ->
FormMsg (Form.mapMsg mapFn value)
NoOp ->
NoOp

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

@ -20,8 +20,8 @@ import BuildError exposing (BuildError)
import Bytes exposing (Bytes)
import Bytes.Decode
import Dict exposing (Dict)
import Form
import Form.FormData exposing (FormData, Method(..))
import FormDecoder
import Html exposing (Html)
import Html.Attributes as Attr
import Http
@ -30,7 +30,6 @@ import Json.Encode
import Pages.ContentCache as ContentCache
import Pages.Fetcher
import Pages.Flags
import Pages.FormState
import Pages.Internal.Msg
import Pages.Internal.NotFoundReason exposing (NotFoundReason)
import Pages.Internal.ResponseSketch as ResponseSketch exposing (ResponseSketch)
@ -311,7 +310,8 @@ type Msg userMsg pageData actionData sharedData errorPage
| UrlChanged Url
-- TODO rename to PagesMsg
| UserMsg (PagesMsg userMsg)
| SetField { formId : String, name : String, value : String }
--| SetField { formId : String, name : String, value : String }
| FormMsg (Form.Msg (Msg userMsg pageData actionData sharedData errorPage))
| UpdateCacheAndUrlNew Bool Url (Maybe userMsg) (Result Http.Error ( Url, ResponseSketch pageData actionData sharedData ))
| FetcherComplete Bool String Int (Result Http.Error ( Maybe userMsg, ActionDataOrRedirect actionData ))
| FetcherStarted String Int FormData Time.Posix
@ -344,7 +344,7 @@ type alias Model userModel pageData actionData sharedData =
, transition : Maybe ( Int, Pages.Transition.Transition )
, nextTransitionKey : Int
, inFlightFetchers : Dict String ( Int, Pages.Transition.FetcherState actionData )
, pageFormState : Pages.FormState.PageFormState
, pageFormState : Form.Model
, pendingRedirect : Bool
, pendingData : Maybe ( pageData, sharedData, Maybe actionData )
}
@ -373,6 +373,18 @@ update :
-> ( Model userModel pageData actionData sharedData, Effect userMsg pageData actionData sharedData userEffect errorPage )
update config appMsg model =
case appMsg of
FormMsg formMsg ->
let
-- TODO trigger formCmd
( newModel, formCmd ) =
Form.update formMsg model.pageFormState
in
( { model
| pageFormState = newModel
}
, NoEffect
)
LinkClicked urlRequest ->
case urlRequest of
Browser.Internal url ->
@ -398,11 +410,6 @@ update config appMsg model =
, BrowserLoadUrl href
)
SetField info ->
( { model | pageFormState = Pages.FormState.setField info model.pageFormState }
, NoEffect
)
UrlChanged url ->
case model.pendingData of
Just ( newPageData, newSharedData, newActionData ) ->
@ -509,62 +516,66 @@ update config appMsg model =
, Submit fields
)
Pages.Internal.Msg.SubmitIfValid formId fields isValid maybeUserMsg ->
if isValid then
( { model
-- TODO should I setSubmitAttempted here, too?
| transition =
Just
( -- TODO remove hardcoded number
-1
, Pages.Transition.Submitting fields
)
}
, Submit fields
)
|> (case maybeUserMsg of
Just justUserMsg ->
performUserMsg justUserMsg config
Nothing ->
identity
)
else
( { model
| pageFormState =
model.pageFormState
|> Pages.FormState.setSubmitAttempted formId
}
, NoEffect
)
Pages.Internal.Msg.SubmitFetcher fetcherKey fields isValid maybeUserMsg ->
if isValid then
-- TODO should I setSubmitAttempted here, too?
( { model | nextTransitionKey = model.nextTransitionKey + 1 }
, SubmitFetcher fetcherKey model.nextTransitionKey fields
)
|> (case maybeUserMsg of
Just justUserMsg ->
performUserMsg justUserMsg config
Nothing ->
identity
)
else
( { model
| pageFormState =
model.pageFormState
|> Pages.FormState.setSubmitAttempted fetcherKey
}
, NoEffect
)
Pages.Internal.Msg.FormFieldEvent value ->
--Pages.Internal.Msg.SubmitIfValid formId fields isValid maybeUserMsg ->
-- if isValid then
-- ( { model
-- -- TODO should I setSubmitAttempted here, too?
-- | transition =
-- Just
-- ( -- TODO remove hardcoded number
-- -1
-- , Pages.Transition.Submitting fields
-- )
-- }
-- , Submit fields
-- )
-- |> (case maybeUserMsg of
-- Just justUserMsg ->
-- performUserMsg justUserMsg config
--
-- Nothing ->
-- identity
-- )
--
-- else
-- ( { model
-- | pageFormState =
-- model.pageFormState
-- |> Pages.FormState.setSubmitAttempted formId
-- }
-- , NoEffect
-- )
--
--Pages.Internal.Msg.SubmitFetcher fetcherKey fields isValid maybeUserMsg ->
-- if isValid then
-- -- TODO should I setSubmitAttempted here, too?
-- ( { model | nextTransitionKey = model.nextTransitionKey + 1 }
-- , SubmitFetcher fetcherKey model.nextTransitionKey fields
-- )
-- |> (case maybeUserMsg of
-- Just justUserMsg ->
-- performUserMsg justUserMsg config
--
-- Nothing ->
-- identity
-- )
--
-- else
-- ( { model
-- | pageFormState =
-- model.pageFormState
-- |> Pages.FormState.setSubmitAttempted fetcherKey
-- }
-- , NoEffect
-- )
Pages.Internal.Msg.FormMsg formMsg ->
-- TODO when init is called for a new page, also need to clear out client-side `pageFormState`
( { model | pageFormState = Pages.FormState.update value model.pageFormState }
let
( formModel, formCmd ) =
-- TODO use formCmd
Form.update formMsg model.pageFormState
in
( { model | pageFormState = formModel }
, NoEffect
)

6
src/Pages/ProgramConfig.elm
View File

@ -8,6 +8,7 @@ import Bytes.Decode
import Bytes.Encode
import Dict exposing (Dict)
import FatalError exposing (FatalError)
import Form
import Form.FormData exposing (FormData)
import Head
import Html exposing (Html)
@ -17,7 +18,6 @@ import Json.Encode
import PageServerResponse exposing (PageServerResponse)
import Pages.Fetcher
import Pages.Flags
import Pages.FormState
import Pages.Internal.NotFoundReason exposing (NotFoundReason)
import Pages.Internal.Platform.ToJsPayload
import Pages.Internal.ResponseSketch exposing (ResponseSketch)
@ -47,14 +47,14 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
, pageUrl : Maybe PageUrl
}
-> ( userModel, effect )
, update : Pages.FormState.PageFormState -> Dict String (Pages.Transition.FetcherState actionData) -> Maybe Pages.Transition.Transition -> sharedData -> pageData -> Maybe Browser.Navigation.Key -> userMsg -> userModel -> ( userModel, effect )
, update : Form.Model -> Dict String (Pages.Transition.FetcherState actionData) -> Maybe Pages.Transition.Transition -> sharedData -> pageData -> Maybe Browser.Navigation.Key -> userMsg -> userModel -> ( userModel, effect )
, subscriptions : route -> Path -> userModel -> Sub userMsg
, sharedData : BackendTask FatalError sharedData
, data : Decode.Value -> route -> BackendTask FatalError (PageServerResponse pageData errorPage)
, action : Decode.Value -> route -> BackendTask FatalError (PageServerResponse actionData errorPage)
, onActionData : actionData -> Maybe userMsg
, view :
Pages.FormState.PageFormState
Form.Model
-> Dict String (Pages.Transition.FetcherState actionData)
-> Maybe Pages.Transition.Transition
->

8
src/PagesMsg.elm
View File

@ -2,7 +2,6 @@ module PagesMsg exposing
( PagesMsg
, fromMsg
, map, noOp
, onSubmit
)
{-| In `elm-pages`, Route modules have their own `Msg` type which can be used like a normal TEA (The Elm Architecture) app.
@ -20,7 +19,6 @@ You can wrap your Route Module's `Msg` using `fromMsg`.
-}
import Html exposing (Attribute)
import Pages.Internal.Msg
@ -84,9 +82,3 @@ noOp =
map : (a -> b) -> PagesMsg a -> PagesMsg b
map mapFn msg =
Pages.Internal.Msg.map mapFn msg
{-| -}
onSubmit : Attribute (PagesMsg userMsg)
onSubmit =
Pages.Internal.Msg.onSubmit

9
src/Server/Request.elm
View File

@ -91,6 +91,7 @@ import CookieParser
import Dict exposing (Dict)
import FatalError exposing (FatalError)
import Form
import Form.Handler
import Form.Validation as Validation
import FormData
import Internal.Request
@ -879,7 +880,7 @@ fileField_ name =
{-| -}
formDataWithServerValidation :
Form.ServerForms error (BackendTask FatalError (Validation.Validation error combined kind constraints))
Form.Handler.Handler error (BackendTask FatalError (Validation.Validation error combined kind constraints))
-> Parser (BackendTask FatalError (Result (Form.Response error) ( Form.Response error, combined )))
formDataWithServerValidation formParsers =
rawFormData
@ -887,7 +888,7 @@ formDataWithServerValidation formParsers =
(\rawFormData_ ->
let
( maybeDecoded, errors ) =
Form.runOneOfServerSide
Form.Handler.run
rawFormData_
formParsers
in
@ -938,7 +939,7 @@ formDataWithServerValidation formParsers =
{-| -}
formData :
Form.ServerForms error combined
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 )
formData formParsers =
rawFormData
@ -946,7 +947,7 @@ formData formParsers =
(\rawFormData_ ->
let
( maybeDecoded, errors ) =
Form.runOneOfServerSide
Form.Handler.run
rawFormData_
formParsers
in