Skip to content
2 changes: 1 addition & 1 deletion example/src/Main.elm
Original file line number Diff line number Diff line change
Expand Up @@ -111,7 +111,7 @@ updateExample msg fs =
)

Submit ->
( fs, Cmd.batch [ Cmd.perform (FormMsg Form.validateAllFieldsMsg) ] )
( fs, Cmd.perform (FormMsg Form.validateAllFieldsMsg) )

EditUiSchema s ->
case UiSchema.fromString s of
Expand Down
8 changes: 8 additions & 0 deletions src/Form/State.elm
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,14 @@ type alias FormState =
}


{-| Controls which widgets should show validation errors.

All - all widgets should show validation errors. Used after a form submission attempt.

Listed - only widgets in the set should show validation errors.
Widgets are added to the set when their value is updated.

-}
type ValidateWidgets
= All
| Listed (Set Pointer)
Expand Down
8 changes: 5 additions & 3 deletions src/Form/Widget.elm
Original file line number Diff line number Diff line change
Expand Up @@ -77,9 +77,10 @@ type alias CategoryButton =

Controls should be rendered in accordance with these options.

- `label` - Label of the control, to be shown above the control.
- `id` - Unique identifier for the control, to be used as the "id" attribute.
- `required` - Whether the control should be marked as required, with an asterisk or similar.
Note that the control may or may not actually be required.
Note that the control may or may not _actually_ be required.
- `validation` - Validation state of the control, possibly containing an error value.
- `description` - Description of the control, to be shown below the control.
- `onFocus` - Used only to show field descriptions on focus.
Expand All @@ -89,6 +90,7 @@ Controls should be rendered in accordance with these options.
-}
type alias Options =
{ label : Maybe String
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

For accessibility reasons it would be best to keep label not Maybe String, but just String, and then have a Bool option to hide the label. Because if label is not visible - we still need to add it as aria-label for screen readers to show which field it is

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I added another property, ariaLabel : String, so that consumers of the library don't need to have any logic, and can just insert supplied attributes into HTML elements.

, ariaLabel : String
, id : String
, disabled : Bool
, required : Bool
Expand Down Expand Up @@ -167,6 +169,7 @@ type FieldFormat
| Date
| Time
| DateTime
| Phone


{-| Text area control
Expand All @@ -184,8 +187,7 @@ type alias TextArea =
{-| Select control.
-}
type alias Select =
{ value : String
, valueList : List { label : String, selected : Bool }
{ valueList : List { label : String, selected : Bool }
, onChange : String -> Msg
}

Expand Down
133 changes: 71 additions & 62 deletions src/Form/Widget/Generate.elm
Original file line number Diff line number Diff line change
Expand Up @@ -145,74 +145,81 @@ controlWidget defaultOptions uiState wholeSchema control form =
defOptions =
UI.applyDefaults defaultOptions control.options

disabled =
defOptions.readonly == True || uiState.disabled
elementId =
inputElementId form.formId control.scope

dispRequired =
isRequired wholeSchema control.scope && not defOptions.hideRequiredAsterisk
controlOptions subSchema =
let
disabled =
defOptions.readonly == True || uiState.disabled

validation =
if validateWidget control.scope form.validateWidgets then
case F.getErrorAt control.scope form.errors of
Just e ->
Invalid e
dispRequired =
isRequired wholeSchema control.scope && not defOptions.hideRequiredAsterisk

Nothing ->
Valid
validation =
if validateWidget control.scope form.validateWidgets then
case F.getErrorAt control.scope form.errors of
Just e ->
Invalid e

else
NotValidated
Nothing ->
Valid

showDescription subSchema =
if defOptions.showUnfocusedDescription || form.focus == Just control.scope then
subSchema.description
else
NotValidated

else
Nothing
label =
fieldLabel control.label subSchema control.scope

showDescription =
if defOptions.showUnfocusedDescription || form.focus == Just control.scope then
subSchema.description

else
Nothing
in
{ id = elementId
, label = label.label
, ariaLabel = label.ariaLabel
, disabled = disabled
, validation = validation
, required = dispRequired
, description = showDescription
, onFocus = Focus control.scope
, trim = defOptions.trim
}

pointedValue =
Maybe.withDefault (FieldValue.String "") <|
FieldValue.pointedFieldValue control.scope form.value

elementId =
inputElementId form.formId control.scope

controlBody : SubSchema -> Maybe Widget
controlBody : SubSchema -> Maybe Control
controlBody subSchema =
Maybe.map
(WControl
{ id = elementId
, label = fieldLabel control.label subSchema control.scope
, disabled = disabled
, validation = validation
, required = dispRequired
, description = showDescription subSchema
, onFocus = Focus control.scope
, trim = defOptions.trim
}
)
<|
case subSchema.type_ of
SingleType IntegerType ->
Just <| textLikeControl IntField pointedValue control.scope elementId defOptions subSchema

SingleType NumberType ->
Just <| textLikeControl NumberField pointedValue control.scope elementId defOptions subSchema

SingleType StringType ->
Just <| textLikeControl (StringField <| formatFromSchema subSchema.format) pointedValue control.scope elementId defOptions subSchema

SingleType BooleanType ->
Just <|
CCheckbox
{ value = FieldValue.asBool pointedValue
, onCheck = Input control.scope << FieldValue.Bool
}
case subSchema.type_ of
SingleType IntegerType ->
Just <| textLikeControl IntField pointedValue control.scope elementId defOptions subSchema

_ ->
Nothing
SingleType NumberType ->
Just <| textLikeControl NumberField pointedValue control.scope elementId defOptions subSchema

SingleType StringType ->
Just <| textLikeControl (StringField <| formatFromSchema subSchema.format) pointedValue control.scope elementId defOptions subSchema

SingleType BooleanType ->
Just <|
CCheckbox
{ value = FieldValue.asBool pointedValue
, onCheck = Input control.scope << FieldValue.Bool
}

_ ->
Nothing

subSchemaWidget : SubSchema -> Maybe Widget
subSchemaWidget subSchema =
Maybe.map (WControl <| controlOptions subSchema) <| controlBody subSchema
in
Maybe.andThen controlBody <| UI.pointToSubSchema wholeSchema control.scope
Maybe.andThen subSchemaWidget <| UI.pointToSubSchema wholeSchema control.scope


textLikeControl : FieldType -> FieldValue -> Pointer -> String -> UI.DefOptions -> SubSchema -> Control
Expand All @@ -237,8 +244,7 @@ textLikeControl fieldType fieldValue pointer elementId defOptions subSchema =

else
CSelect
{ value = FieldValue.asString fieldValue
, valueList =
{ valueList =
Maybe.toList subSchema.enum
|> List.concat
|> List.map (Decode.decodeValue UI.decodeStringLike >> Result.withDefault "")
Expand Down Expand Up @@ -352,26 +358,26 @@ isRequired wholeSchema pointer =
isCheckboxRequired || isPropertyRequired


fieldLabel : Maybe UI.ControlLabel -> SubSchema -> Pointer -> Maybe String
fieldLabel : Maybe UI.ControlLabel -> SubSchema -> Pointer -> { label : Maybe String, ariaLabel : String }
fieldLabel label schema scope =
let
fallback =
schema.title
|> Maybe.orElse (List.last scope |> Maybe.map UI.fieldNameToTitle)
|> Maybe.withDefault ""
|> Maybe.withDefault "unreachable"
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Aria label must always be same as the label (if such is visible) or a descriptive label (if label is not visible / not present), so it makes sense to just have label and indication if that label is hidden (if label is hidden - we can use aria-label and if not - use label).
https://github.com/scrive/elm/blob/master/libs/scrive-ui/src/UI/Input.elm#L35
https://github.com/scrive/elm/blob/master/libs/scrive-ui/src/UI/Input.elm#L53

This currently will set some aria labels to "unreachable", which doesn't sound good for accessibility...

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Right, I misunderstood the purpose of aria-label a bit. I refactored the code to contain label : String and hideLabel : Bool.

The "unreachable" string is, in fact, never used -- it is unreachable, because scope is a non-empty list. Before, an empty string label ("") was used as a placeholder, but I thought it'd be better to make the failure more explicit.

Another fallback option would be to hide the whole widget, but that's more awkward in code and I'm not sure it's any better. I added a comment about it, do you think it's good enough?

-- `scope` is a non-empty list, so `fallback` is never "unreachable".

... Or I can revert it into an empty string again and pretend there's no issue 😆 🤷

Copy link
Contributor

@mary-prince mary-prince Jun 2, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The proper way would be to return a Maybe { label : String, hideLabel : Bool } I think, and then handle this situation whenever this function is called, but I will leave it up to you since it would require changing code that composes the control widget (you already return a maybe there, so indeed you could be not rendering the widget when an impossible state is reached).
But I think it is more issue-proof if we don't make impossible states possible with the unreachable placeholder - since there shouldn't be a widget without a label.

in
case label of
Just (UI.StringLabel s) ->
Just s
{ label = Just s, ariaLabel = s }

Just (UI.BoolLabel False) ->
Nothing
{ label = Nothing, ariaLabel = fallback }

Just (UI.BoolLabel True) ->
Just fallback
{ label = Just fallback, ariaLabel = fallback }

Nothing ->
Just fallback
{ label = Just fallback, ariaLabel = fallback }


inputElementId : String -> Pointer -> String
Expand Down Expand Up @@ -410,6 +416,9 @@ formatFromSchema =
"date-time" ->
DateTime

"phone" ->
Phone

_ ->
Text
)
Expand Down
5 changes: 4 additions & 1 deletion src/Form/Widget/View.elm
Original file line number Diff line number Diff line change
Expand Up @@ -203,7 +203,7 @@ viewCheckbox options checkbox =
, viewLabel options.label options.required
]

-- TODO: show description as tooltip
-- NOTE: description for checkboxes should be shown as a tooltip, but this is not implemented for now.
, viewErrorMessage options.validation
]

Expand Down Expand Up @@ -258,6 +258,9 @@ inputType fieldType =
DateTime ->
"datetime-local"

Phone ->
"tel"

NumberField ->
"number"

Expand Down