From cfe27198a1a81b2b5497bb7d7d5d7e9f3ce0af8b Mon Sep 17 00:00:00 2001 From: James Robb <47126579+jamesrweb@users.noreply.github.com> Date: Sun, 11 Sep 2022 00:34:03 +0200 Subject: [PATCH 01/14] Expose unexposed custom role constructor --- src/Accessibility/Role.elm | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Accessibility/Role.elm b/src/Accessibility/Role.elm index e39563c..38119e5 100644 --- a/src/Accessibility/Role.elm +++ b/src/Accessibility/Role.elm @@ -13,6 +13,7 @@ module Accessibility.Role exposing , toolBar, toolTip , tree, treeGrid, treeItem , presentation, application + , custom ) {-| From 83751983b8736152b9be2b7a4c36e41bc76ad7f5 Mon Sep 17 00:00:00 2001 From: James Robb <47126579+jamesrweb@users.noreply.github.com> Date: Sun, 11 Sep 2022 00:34:36 +0200 Subject: [PATCH 02/14] Resolve duplicate test name warning for tests --- tests/SpecHelpers.elm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/SpecHelpers.elm b/tests/SpecHelpers.elm index 45ad35e..1d5fd01 100644 --- a/tests/SpecHelpers.elm +++ b/tests/SpecHelpers.elm @@ -11,16 +11,16 @@ import Test.Html.Selector as Selector expectAriaBoolAttribute : (Bool -> Html.Attribute msg) -> String -> List Test expectAriaBoolAttribute setter attribute = - [ test "True" <| expectAria ( setter, True ) ( attribute, "true" ) - , test "False" <| expectAria ( setter, False ) ( attribute, "false" ) + [ test "Aria bool is True" <| expectAria ( setter, True ) ( attribute, "true" ) + , test "Aria bool is False" <| expectAria ( setter, False ) ( attribute, "false" ) ] expectAriaTristateAttribute : (Maybe Bool -> Html.Attribute msg) -> String -> List Test expectAriaTristateAttribute setter attribute = - [ test "True" <| expectAria ( setter, Just True ) ( attribute, "true" ) - , test "False" <| expectAria ( setter, Just False ) ( attribute, "false" ) - , test "Mixed" <| expectAria ( setter, Nothing ) ( attribute, "mixed" ) + [ test "Aria state is True" <| expectAria ( setter, Just True ) ( attribute, "true" ) + , test "Aria state is False" <| expectAria ( setter, Just False ) ( attribute, "false" ) + , test "Aria state is Mixed" <| expectAria ( setter, Nothing ) ( attribute, "mixed" ) ] From 3cdf7f77610ddaf21c21806168279197ea53529f Mon Sep 17 00:00:00 2001 From: James Robb <47126579+jamesrweb@users.noreply.github.com> Date: Sun, 11 Sep 2022 00:35:21 +0200 Subject: [PATCH 03/14] Add inputColor and fix inputNumber implementation --- elm.json | 3 +- src/Accessibility.elm | 91 +++++++++++++++++++++++++++---------- tests/AccessibilitySpec.elm | 58 +++++++++++++++++++++++ 3 files changed, 128 insertions(+), 24 deletions(-) diff --git a/elm.json b/elm.json index 2de397d..b03ac9c 100644 --- a/elm.json +++ b/elm.json @@ -17,7 +17,8 @@ "dependencies": { "elm/core": "1.0.0 <= v < 2.0.0", "elm/html": "1.0.0 <= v < 2.0.0", - "elm/json": "1.0.0 <= v < 2.0.0" + "elm/json": "1.0.0 <= v < 2.0.0", + "elm/regex": "1.0.0 <= v < 2.0.0" }, "test-dependencies": { "elm-explorations/test": "1.2.1 <= v < 2.0.0" diff --git a/src/Accessibility.elm b/src/Accessibility.elm index c0cfa35..1a82358 100644 --- a/src/Accessibility.elm +++ b/src/Accessibility.elm @@ -22,6 +22,7 @@ module Accessibility exposing , mark, ruby, rt, rp, bdi, bdo, wbr , details, summary, menuitem, menu , Html, Attribute, map + , inputColor ) {-| @@ -47,7 +48,7 @@ Together, `tabList`, `tab`, and `tabPanel` describe the pieces of a tab componen import Accessibility exposing (Html, tab, tabList, tabPanel, text) import Accessibility.Aria exposing (controls, hidden, labelledBy, selected) - import Html.Attributes exposing (id) + import Html.Attributes exposing (id, hidden) view : Html msg view = @@ -69,14 +70,14 @@ Together, `tabList`, `tab`, and `tabPanel` describe the pieces of a tab componen [ id "panel-1" , labelledBy "tab-1" , hidden False - , Html.Attributes.hidden False + , hidden False ] [ text "Panel One Content" ] , tabPanel [ id "panel-2" , labelledBy "tab-2" , hidden True - , Html.Attributes.hidden True + , hidden True ] [ text "Panel Two Content" ] ] @@ -153,7 +154,8 @@ import Accessibility.Role as Role import Accessibility.Style as Style import Accessibility.Utils exposing (nonInteractive) import Html as Html -import Html.Attributes +import Html.Attributes exposing (alt, attribute, checked, for, name, pattern, type_, value) +import Regex {-| All inputs must be associated with a `label`. @@ -186,7 +188,7 @@ The id that's passed in must be added to the input! labelHidden : String -> List (Attribute Never) -> Html Never -> Html msg -> Html msg labelHidden id attributes labelContent input = span [] - [ label (Html.Attributes.for id :: Style.invisible ++ attributes) + [ label (for id :: Style.invisible ++ attributes) [ Html.map Basics.never labelContent ] , input ] @@ -202,14 +204,14 @@ labelHidden id attributes labelContent input = Use the HTML autocomplete attribute whenever possible. Read [Understanding Success Criterion 1.3.5: Identify Input Purpose](https://www.w3.org/WAI/WCAG21/Understanding/identify-input-purpose) and [Using HTML 5.2 autocomplete attributes (Technique H98)](https://www.w3.org/WAI/WCAG21/Techniques/html/H98) for more information. -You might notice that `Html.Attributes` and `Html.Attributes` don't provide full autocomplete support. This is tracked in [elm/html issue 189](https://github.com/elm/html/issues/189). +You might notice that `Html.Attributes` doesn't provide full autocomplete support. This is tracked in [elm/html issue 189](https://github.com/elm/html/issues/189). -} inputText : String -> List (Attribute msg) -> Html msg inputText value_ attributes = Html.input - ([ Html.Attributes.type_ "text" - , Html.Attributes.value value_ + ([ type_ "text" + , value value_ ] ++ attributes ) @@ -222,16 +224,16 @@ inputText value_ attributes = Use the HTML autocomplete attribute whenever possible. Read [Understanding Success Criterion 1.3.5: Identify Input Purpose](https://www.w3.org/WAI/WCAG21/Understanding/identify-input-purpose) and [Using HTML 5.2 autocomplete attributes (Technique H98)](https://www.w3.org/WAI/WCAG21/Techniques/html/H98) for more information. -You might notice that `Html.Attributes` and `Html.Attributes` don't provide full autocomplete support. This is tracked in [elm/html issue 189](https://github.com/elm/html/issues/189). +You might notice that `Html.Attributes` doesn't provide full autocomplete support. This is tracked in [elm/html issue 189](https://github.com/elm/html/issues/189). -} -inputNumber : String -> List (Attribute msg) -> Html msg +inputNumber : Int -> List (Attribute msg) -> Html msg inputNumber value_ attributes = Html.input - ([ Html.Attributes.type_ "text" - , Html.Attributes.attribute "inputmode" "numeric" - , Html.Attributes.pattern "[0-9]*" - , Html.Attributes.value value_ + ([ type_ "text" + , attribute "inputmode" "numeric" + , pattern "[0-9]*" + , value (String.fromInt value_) ] ++ attributes ) @@ -246,10 +248,10 @@ inputNumber value_ attributes = radio : String -> String -> Bool -> List (Attribute msg) -> Html msg radio name_ value_ checked_ attributes = Html.input - ([ Html.Attributes.type_ "radio" - , Html.Attributes.name name_ - , Html.Attributes.value value_ - , Html.Attributes.checked checked_ + ([ type_ "radio" + , name name_ + , value value_ + , checked checked_ ] ++ attributes ) @@ -267,15 +269,58 @@ checkbox : String -> Maybe Bool -> List (Attribute msg) -> Html msg checkbox value_ maybeChecked attributes = Html.input (nonInteractive - [ Html.Attributes.type_ "checkbox" - , Html.Attributes.value value_ - , Maybe.withDefault Aria.indeterminate (Maybe.map Html.Attributes.checked maybeChecked) + [ type_ "checkbox" + , value value_ + , Maybe.withDefault Aria.indeterminate (Maybe.map checked maybeChecked) ] ++ attributes ) [] +{-| Constructs an input of type "color". Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + +Color inputs don't require an initial value per specification and thus `Maybe String` is used as the value type. If the value is `Nothing` or the provided hex code is invalid then `#000000` will be used as per specification. + + checkbox (Just "#abc123") [] + + checkbox (Just "#FFFFF") [] + + checkbox Nothing [] + +-} +inputColor : Maybe String -> List (Attribute msg) -> Html msg +inputColor value_ attributes = + let + -- See: https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input/color#value + hexRegex = + Regex.fromString "^#[0-9a-fA-F]{6}$" |> Maybe.withDefault Regex.never + + isValidHex : String -> Bool + isValidHex value = + Regex.contains hexRegex value + + hexCode = + Maybe.map isValidHex value_ + |> Maybe.andThen + (\valid -> + if valid then + value_ + + else + Nothing + ) + |> Maybe.withDefault "#000000" + in + Html.input + ([ type_ "color" + , value hexCode + ] + ++ attributes + ) + [] + + {- *** Tabs *** -} @@ -320,7 +365,7 @@ For graphs and diagrams, see `figure` and `longDesc`. -} img : String -> List (Attribute Never) -> Html msg img alt_ attributes = - Html.img (Html.Attributes.alt alt_ :: nonInteractive attributes) [] + Html.img (alt alt_ :: nonInteractive attributes) [] {-| Use this tag when the image is decorative or provides redundant information. Read through [the w3 decorative image tutorial](https://www.w3.org/WAI/tutorials/images/decorative/) to learn more. @@ -330,7 +375,7 @@ img alt_ attributes = -} decorativeImg : List (Attribute Never) -> Html msg decorativeImg attributes = - Html.img (Html.Attributes.alt "" :: nonInteractive (Role.presentation :: attributes)) [] + Html.img (alt "" :: nonInteractive (Role.presentation :: attributes)) [] {-| Adds the group role to a figure. diff --git a/tests/AccessibilitySpec.elm b/tests/AccessibilitySpec.elm index ddb2852..fa8298a 100644 --- a/tests/AccessibilitySpec.elm +++ b/tests/AccessibilitySpec.elm @@ -96,6 +96,64 @@ inputSpec = (checkbox "the value" (Just True) [ Attribute.id "id" ]) ] ] + , describe "color inputs" <| + let + expected = + { label = "the label" + , value = "#abc123" + , type_ = "color" + } + in + [ describe "fallback when a shorthex value is provided" + [ baseInputTests { expected | value = "#000000" } <| + labelBefore [] + (text "the label") + (inputColor (Just "#xyz") []) + ] + , describe "fallback when a hex without a hashtag is provided" + [ baseInputTests { expected | value = "#000000" } <| + labelBefore [] + (text "the label") + (inputColor (Just "123abc") []) + ] + , describe "fallback when a rgba hex is provided" + [ baseInputTests { expected | value = "#000000" } <| + labelBefore [] + (text "the label") + (inputColor (Just "#009900aa") []) + ] + , describe "fallback when an invalid value is provided" + [ baseInputTests { expected | value = "#000000" } <| + labelBefore [] + (text "the label") + (inputColor (Just "123") []) + ] + , describe "fallback when no initial value is provided" + [ baseInputTests { expected | value = "#000000" } <| + labelBefore [] + (text "the label") + (inputColor Nothing []) + ] + , describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputColor (Just "#abc123") []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputColor (Just "#abc123") []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputColor (Just "#abc123") [ Attribute.id "id" ]) + ] + ] ] From ee745e6f059d4d107aba215791782e1cdba8eb76 Mon Sep 17 00:00:00 2001 From: James Robb <47126579+jamesrweb@users.noreply.github.com> Date: Sun, 11 Sep 2022 00:35:37 +0200 Subject: [PATCH 04/14] Formatting --- src/Accessibility.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Accessibility.elm b/src/Accessibility.elm index 1a82358..13470fd 100644 --- a/src/Accessibility.elm +++ b/src/Accessibility.elm @@ -48,7 +48,7 @@ Together, `tabList`, `tab`, and `tabPanel` describe the pieces of a tab componen import Accessibility exposing (Html, tab, tabList, tabPanel, text) import Accessibility.Aria exposing (controls, hidden, labelledBy, selected) - import Html.Attributes exposing (id, hidden) + import Html.Attributes exposing (hidden, id) view : Html msg view = From 5ba6520dc0bf93def7e1ee83101a7ff5c85be569 Mon Sep 17 00:00:00 2001 From: James Robb <47126579+jamesrweb@users.noreply.github.com> Date: Sun, 11 Sep 2022 01:04:12 +0200 Subject: [PATCH 05/14] Remove unused exposed roleToString function --- src/Accessibility/Utils.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Accessibility/Utils.elm b/src/Accessibility/Utils.elm index 9985746..510cca5 100644 --- a/src/Accessibility/Utils.elm +++ b/src/Accessibility/Utils.elm @@ -1,4 +1,4 @@ -module Accessibility.Utils exposing (Role(..), aria, nonInteractive, role, roleToString, toBoolString, toListString, toTriStateString) +module Accessibility.Utils exposing (Role(..), aria, nonInteractive, role, toBoolString, toListString, toTriStateString) import Html import Html.Attributes exposing (..) From 7378f35d9a5a658b2491e2d193e1cdc00fdb24a4 Mon Sep 17 00:00:00 2001 From: James Robb <47126579+jamesrweb@users.noreply.github.com> Date: Sun, 11 Sep 2022 01:04:49 +0200 Subject: [PATCH 06/14] Stop aliasing Html to itself --- src/Accessibility/Aria.elm | 2 +- src/Accessibility/Key.elm | 2 +- src/Accessibility/Landmark.elm | 2 +- src/Accessibility/Live.elm | 2 +- src/Accessibility/Role.elm | 2 +- src/Accessibility/Style.elm | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Accessibility/Aria.elm b/src/Accessibility/Aria.elm index c0cf7ea..ff38e06 100644 --- a/src/Accessibility/Aria.elm +++ b/src/Accessibility/Aria.elm @@ -136,7 +136,7 @@ See [the spec](https://www.w3.org/TR/wai-aria-1.1/#aria-haspopup). -} import Accessibility.Utils exposing (..) -import Html as Html +import Html import Html.Attributes exposing (..) import Json.Encode diff --git a/src/Accessibility/Key.elm b/src/Accessibility/Key.elm index 97762eb..9657017 100644 --- a/src/Accessibility/Key.elm +++ b/src/Accessibility/Key.elm @@ -41,7 +41,7 @@ module Accessibility.Key exposing -} -import Html as Html exposing (Attribute) +import Html exposing (Attribute) import Html.Attributes import Html.Events exposing (keyCode, on) import Json.Decode as Json diff --git a/src/Accessibility/Landmark.elm b/src/Accessibility/Landmark.elm index 725fcab..53ed924 100644 --- a/src/Accessibility/Landmark.elm +++ b/src/Accessibility/Landmark.elm @@ -15,7 +15,7 @@ The landmark you're most likely to need to set directly is `search`, as it does -} import Accessibility.Utils exposing (Role(..), role) -import Html as Html +import Html {-| Creates a [`role="banner"`](https://www.w3.org/TR/wai-aria-1.1/#banner) attribute. diff --git a/src/Accessibility/Live.elm b/src/Accessibility/Live.elm index 442b0bc..ade6c45 100644 --- a/src/Accessibility/Live.elm +++ b/src/Accessibility/Live.elm @@ -20,7 +20,7 @@ Learn more about how to use live regions [here](https://www.w3.org/TR/wai-aria-p -} import Accessibility.Utils exposing (..) -import Html as Html +import Html {-| Supported for all elements. diff --git a/src/Accessibility/Role.elm b/src/Accessibility/Role.elm index 38119e5..d3ab779 100644 --- a/src/Accessibility/Role.elm +++ b/src/Accessibility/Role.elm @@ -91,7 +91,7 @@ module Accessibility.Role exposing -} import Accessibility.Utils exposing (Role(..), role) -import Html as Html +import Html import Html.Attributes diff --git a/src/Accessibility/Style.elm b/src/Accessibility/Style.elm index 767b4bf..d73f5d8 100644 --- a/src/Accessibility/Style.elm +++ b/src/Accessibility/Style.elm @@ -16,7 +16,7 @@ For more information on hiding/semi-hiding elements, please see [the a11y projec -} -import Html as Html +import Html import Html.Attributes From 341ca55a9323ddffcb97a4c4f8dcfd9b9b1568ad Mon Sep 17 00:00:00 2001 From: James Robb <47126579+jamesrweb@users.noreply.github.com> Date: Sun, 11 Sep 2022 01:15:44 +0200 Subject: [PATCH 07/14] Implement input type date and datetime-local inputs --- elm.json | 3 +- src/Accessibility.elm | 76 ++++++++++++++++++++++++++++++++++--- src/DateUtils.elm | 48 +++++++++++++++++++++++ tests/AccessibilitySpec.elm | 63 ++++++++++++++++++++++++++++++ 4 files changed, 183 insertions(+), 7 deletions(-) create mode 100644 src/DateUtils.elm diff --git a/elm.json b/elm.json index b03ac9c..5ea7cae 100644 --- a/elm.json +++ b/elm.json @@ -18,7 +18,8 @@ "elm/core": "1.0.0 <= v < 2.0.0", "elm/html": "1.0.0 <= v < 2.0.0", "elm/json": "1.0.0 <= v < 2.0.0", - "elm/regex": "1.0.0 <= v < 2.0.0" + "elm/regex": "1.0.0 <= v < 2.0.0", + "elm/time": "1.0.0 <= v < 2.0.0" }, "test-dependencies": { "elm-explorations/test": "1.2.1 <= v < 2.0.0" diff --git a/src/Accessibility.elm b/src/Accessibility.elm index 13470fd..4cf0a45 100644 --- a/src/Accessibility.elm +++ b/src/Accessibility.elm @@ -22,7 +22,7 @@ module Accessibility exposing , mark, ruby, rt, rp, bdi, bdo, wbr , details, summary, menuitem, menu , Html, Attribute, map - , inputColor + , inputColor, inputDate, inputDateTimeLocal ) {-| @@ -152,10 +152,12 @@ import Accessibility.Aria as Aria import Accessibility.Key as Key import Accessibility.Role as Role import Accessibility.Style as Style -import Accessibility.Utils exposing (nonInteractive) -import Html as Html +import Accessibility.Utils exposing (..) +import DateUtils exposing (padNumberToDoubleDigit, toMonthNumber) +import Html import Html.Attributes exposing (alt, attribute, checked, for, name, pattern, type_, value) import Regex +import Time exposing (Posix, Zone, toDay, toHour, toMinute, toMonth, toYear) {-| All inputs must be associated with a `label`. @@ -290,7 +292,7 @@ Color inputs don't require an initial value per specification and thus `Maybe St -} inputColor : Maybe String -> List (Attribute msg) -> Html msg -inputColor value_ attributes = +inputColor maybeHexCode attributes = let -- See: https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input/color#value hexRegex = @@ -301,11 +303,11 @@ inputColor value_ attributes = Regex.contains hexRegex value hexCode = - Maybe.map isValidHex value_ + Maybe.map isValidHex maybeHexCode |> Maybe.andThen (\valid -> if valid then - value_ + maybeHexCode else Nothing @@ -321,6 +323,68 @@ inputColor value_ attributes = [] +{-| Constructs an input of type "date". Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + import Time exposing (millisToPosix, utc) + + inputDate (millisToPosix 0) utc [] + +-} +inputDate : Posix -> Zone -> List (Attribute msg) -> Html msg +inputDate timestamp timezone attributes = + let + day = + toDay timezone timestamp |> padNumberToDoubleDigit + + month = + toMonth timezone timestamp |> toMonthNumber |> padNumberToDoubleDigit + + year = + toYear timezone timestamp |> String.fromInt + in + Html.input + ([ type_ "date" + , value (String.join "-" [ year, month, day ]) + ] + ++ attributes + ) + [] + + +{-| Constructs an input of type "datetime-local". Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + import Time exposing (millisToPosix, utc) + + inputDateTimeLocal (millisToPosix 0) utc [] + +-} +inputDateTimeLocal : Posix -> Zone -> List (Attribute msg) -> Html msg +inputDateTimeLocal timestamp timezone attributes = + let + day = + toDay timezone timestamp |> padNumberToDoubleDigit + + month = + toMonth timezone timestamp |> toMonthNumber |> padNumberToDoubleDigit + + year = + toYear timezone timestamp |> String.fromInt + + hour = + toHour timezone timestamp |> padNumberToDoubleDigit + + minute = + toMinute timezone timestamp |> padNumberToDoubleDigit + in + Html.input + ([ type_ "datetime-local" + , value (String.join "-" [ year, month, day ] ++ "T" ++ String.join ":" [ hour, minute ]) + ] + ++ attributes + ) + [] + + {- *** Tabs *** -} diff --git a/src/DateUtils.elm b/src/DateUtils.elm new file mode 100644 index 0000000..f234d5d --- /dev/null +++ b/src/DateUtils.elm @@ -0,0 +1,48 @@ +module DateUtils exposing (..) + +import Time exposing (Month(..)) + + +toMonthNumber : Month -> Int +toMonthNumber month_ = + case month_ of + Jan -> + 1 + + Feb -> + 2 + + Mar -> + 3 + + Apr -> + 4 + + May -> + 5 + + Jun -> + 6 + + Jul -> + 7 + + Aug -> + 8 + + Sep -> + 9 + + Oct -> + 10 + + Nov -> + 11 + + Dec -> + 12 + + +padNumberToDoubleDigit : Int -> String +padNumberToDoubleDigit = + String.fromInt >> String.padLeft 2 '0' diff --git a/tests/AccessibilitySpec.elm b/tests/AccessibilitySpec.elm index fa8298a..8bb8a17 100644 --- a/tests/AccessibilitySpec.elm +++ b/tests/AccessibilitySpec.elm @@ -7,6 +7,7 @@ import Test exposing (..) import Test.Html.Event as Event import Test.Html.Query as Query import Test.Html.Selector as Selector +import Time exposing (millisToPosix, utc) inputSpec : Test @@ -154,6 +155,68 @@ inputSpec = (inputColor (Just "#abc123") [ Attribute.id "id" ]) ] ] + , describe "date inputs" <| + let + posix = + millisToPosix 1640995200000 + + expected = + { label = "the label" + , value = "2022-01-01" + , type_ = "date" + } + in + [ describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputDate posix utc []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputDate posix utc []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputDate posix utc [ Attribute.id "id" ]) + ] + ] + , describe "datetime-local inputs" <| + let + posix = + millisToPosix 1640995200000 + + expected = + { label = "the label" + , value = "2022-01-01T00:00" + , type_ = "datetime-local" + } + in + [ describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputDateTimeLocal posix utc []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputDateTimeLocal posix utc []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputDateTimeLocal posix utc [ Attribute.id "id" ]) + ] + ] ] From c26cd5cda5d0384b89d35b013bd8de7e39248a16 Mon Sep 17 00:00:00 2001 From: James Robb <47126579+jamesrweb@users.noreply.github.com> Date: Sun, 11 Sep 2022 01:42:02 +0200 Subject: [PATCH 08/14] Implement input type email --- src/Accessibility.elm | 35 ++++++++++++++++++++++++++++++++++- tests/AccessibilitySpec.elm | 34 ++++++++++++++++++++++++++++++++++ 2 files changed, 68 insertions(+), 1 deletion(-) diff --git a/src/Accessibility.elm b/src/Accessibility.elm index 4cf0a45..1a88ce2 100644 --- a/src/Accessibility.elm +++ b/src/Accessibility.elm @@ -22,7 +22,7 @@ module Accessibility exposing , mark, ruby, rt, rp, bdi, bdo, wbr , details, summary, menuitem, menu , Html, Attribute, map - , inputColor, inputDate, inputDateTimeLocal + , inputColor, inputDate, inputDateTimeLocal, inputEmail ) {-| @@ -385,6 +385,39 @@ inputDateTimeLocal timestamp timezone attributes = [] +{-| Constructs an input of type `email`. Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + inputEmail "hello@example.com" [ property "autocomplete" "email" ] + +Note: Emails are validated in accordance with the [basic email validation the HTML spec implements](https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input/email#basic_validation). + +Use the HTML autocomplete attribute whenever possible. Read [Understanding Success Criterion 1.3.5: Identify Input Purpose](https://www.w3.org/WAI/WCAG21/Understanding/identify-input-purpose) and [Using HTML 5.2 autocomplete attributes (Technique H98)](https://www.w3.org/WAI/WCAG21/Techniques/html/H98) for more information. + +You might notice that `Html.Attributes` doesn't provide full autocomplete support. This is tracked in [elm/html issue 189](https://github.com/elm/html/issues/189). + +-} +inputEmail : String -> List (Attribute msg) -> Html msg +inputEmail value_ attributes = + let + htmlSpecEmailRegex = + Regex.fromString "^[a-zA-Z0-9.!#$%&'*+/=?^_`{|}~-]+@[a-zA-Z0-9](?:[a-zA-Z0-9-]{0,61}[a-zA-Z0-9])?(?:.[a-zA-Z0-9](?:[a-zA-Z0-9-]{0,61}[a-zA-Z0-9])?)*$" |> Maybe.withDefault Regex.never + + email = + if Regex.contains htmlSpecEmailRegex value_ then + value_ + + else + "" + in + Html.input + ([ type_ "email" + , value email + ] + ++ attributes + ) + [] + + {- *** Tabs *** -} diff --git a/tests/AccessibilitySpec.elm b/tests/AccessibilitySpec.elm index 8bb8a17..e159a19 100644 --- a/tests/AccessibilitySpec.elm +++ b/tests/AccessibilitySpec.elm @@ -217,6 +217,40 @@ inputSpec = (inputDateTimeLocal posix utc [ Attribute.id "id" ]) ] ] + , describe "email inputs" <| + let + expected = + { label = "the label" + , value = "hello@example.com" + , type_ = "email" + } + in + [ describe "Invalid emails default to empty values" + [ baseInputTests { expected | value = "" } <| + labelBefore [] + (text "the label") + (inputEmail "email" []) + ] + , describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputEmail "hello@example.com" []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputEmail "hello@example.com" []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputEmail "hello@example.com" [ Attribute.id "id" ]) + ] + ] ] From 87bfb2d7648bdbd2933202b3adfb8fb276180fa5 Mon Sep 17 00:00:00 2001 From: James Robb <47126579+jamesrweb@users.noreply.github.com> Date: Tue, 13 Sep 2022 16:42:10 +0200 Subject: [PATCH 09/14] Add file, hidden and image inputs --- elm.json | 3 +- src/Accessibility.elm | 101 +++++++++++++++++++++--------------- tests/AccessibilitySpec.elm | 101 ++++++++++++++++++++++++++++++++++++ 3 files changed, 162 insertions(+), 43 deletions(-) diff --git a/elm.json b/elm.json index 5ea7cae..eeeee2a 100644 --- a/elm.json +++ b/elm.json @@ -19,7 +19,8 @@ "elm/html": "1.0.0 <= v < 2.0.0", "elm/json": "1.0.0 <= v < 2.0.0", "elm/regex": "1.0.0 <= v < 2.0.0", - "elm/time": "1.0.0 <= v < 2.0.0" + "elm/time": "1.0.0 <= v < 2.0.0", + "elm/url": "1.0.0 <= v < 2.0.0" }, "test-dependencies": { "elm-explorations/test": "1.2.1 <= v < 2.0.0" diff --git a/src/Accessibility.elm b/src/Accessibility.elm index 1a88ce2..4773578 100644 --- a/src/Accessibility.elm +++ b/src/Accessibility.elm @@ -1,6 +1,6 @@ module Accessibility exposing ( labelBefore, labelAfter, labelHidden - , inputText, inputNumber, radio, checkbox + , inputText, inputNumber, radio, checkbox, inputColor, inputDate, inputDateTimeLocal, inputEmail, inputFile, inputHidden, inputImage , tabList, tab, tabPanel , img, decorativeImg , button, textarea, select @@ -22,7 +22,6 @@ module Accessibility exposing , mark, ruby, rt, rp, bdi, bdo, wbr , details, summary, menuitem, menu , Html, Attribute, map - , inputColor, inputDate, inputDateTimeLocal, inputEmail ) {-| @@ -39,7 +38,7 @@ Right now, this library only supports a few input types. Many more input types e See [MDN's input information](https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input) for more options. -@docs inputText, inputNumber, radio, checkbox +@docs inputText, inputNumber, radio, checkbox, inputColor, inputDate, inputDateTimeLocal, inputEmail, inputFile, inputHidden, inputImage ## Tabs @@ -155,9 +154,10 @@ import Accessibility.Style as Style import Accessibility.Utils exposing (..) import DateUtils exposing (padNumberToDoubleDigit, toMonthNumber) import Html -import Html.Attributes exposing (alt, attribute, checked, for, name, pattern, type_, value) +import Html.Attributes exposing (alt, attribute, checked, for, multiple, name, pattern, src, type_, value) import Regex import Time exposing (Posix, Zone, toDay, toHour, toMinute, toMonth, toYear) +import Url exposing (Url) {-| All inputs must be associated with a `label`. @@ -212,11 +212,7 @@ You might notice that `Html.Attributes` doesn't provide full autocomplete suppor inputText : String -> List (Attribute msg) -> Html msg inputText value_ attributes = Html.input - ([ type_ "text" - , value value_ - ] - ++ attributes - ) + ([ type_ "text", value value_ ] ++ attributes) [] @@ -232,13 +228,7 @@ You might notice that `Html.Attributes` doesn't provide full autocomplete suppor inputNumber : Int -> List (Attribute msg) -> Html msg inputNumber value_ attributes = Html.input - ([ type_ "text" - , attribute "inputmode" "numeric" - , pattern "[0-9]*" - , value (String.fromInt value_) - ] - ++ attributes - ) + ([ type_ "text", attribute "inputmode" "numeric", pattern "[0-9]*", value (String.fromInt value_) ] ++ attributes) [] @@ -250,13 +240,7 @@ inputNumber value_ attributes = radio : String -> String -> Bool -> List (Attribute msg) -> Html msg radio name_ value_ checked_ attributes = Html.input - ([ type_ "radio" - , name name_ - , value value_ - , checked checked_ - ] - ++ attributes - ) + ([ type_ "radio", name name_, value value_, checked checked_ ] ++ attributes) [] @@ -271,10 +255,7 @@ checkbox : String -> Maybe Bool -> List (Attribute msg) -> Html msg checkbox value_ maybeChecked attributes = Html.input (nonInteractive - [ type_ "checkbox" - , value value_ - , Maybe.withDefault Aria.indeterminate (Maybe.map checked maybeChecked) - ] + [ type_ "checkbox", value value_, Maybe.withDefault Aria.indeterminate (Maybe.map checked maybeChecked) ] ++ attributes ) [] @@ -315,11 +296,7 @@ inputColor maybeHexCode attributes = |> Maybe.withDefault "#000000" in Html.input - ([ type_ "color" - , value hexCode - ] - ++ attributes - ) + ([ type_ "color", value hexCode ] ++ attributes) [] @@ -343,11 +320,7 @@ inputDate timestamp timezone attributes = toYear timezone timestamp |> String.fromInt in Html.input - ([ type_ "date" - , value (String.join "-" [ year, month, day ]) - ] - ++ attributes - ) + ([ type_ "date", value (String.join "-" [ year, month, day ]) ] ++ attributes) [] @@ -410,11 +383,55 @@ inputEmail value_ attributes = "" in Html.input - ([ type_ "email" - , value email - ] - ++ attributes - ) + ([ type_ "email", value email ] ++ attributes) + [] + + +{-| Constructs an input of type `file`. Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + inputFile True [] + + inputFile False [ property "id" "abc123" ] + +-} +inputFile : Bool -> List (Attribute msg) -> Html msg +inputFile multiple_ attributes = + Html.input + ([ type_ "file", value "", multiple multiple_ ] ++ attributes) + [] + + +{-| Constructs an input of type `hidden`. Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + inputHidden "key" "value" [] + +-} +inputHidden : String -> String -> List (Attribute msg) -> Html msg +inputHidden name_ value_ attributes = + Html.input + ([ type_ "hidden", name name_, value value_ ] ++ attributes) + [] + + +{-| Constructs an input of type `image`. Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + source : Url + source = + { protocol = Https + , host = "example.com" + , path = "/image.jpg" + , port_ = Nothing + , query = Nothing + , fragment = Nothing + } + + inputImage source [] + +-} +inputImage : Url -> List (Attribute msg) -> Html msg +inputImage src_ attributes = + Html.input + ([ type_ "image", Url.toString src_ |> src, value "" ] ++ attributes) [] diff --git a/tests/AccessibilitySpec.elm b/tests/AccessibilitySpec.elm index e159a19..0ccd898 100644 --- a/tests/AccessibilitySpec.elm +++ b/tests/AccessibilitySpec.elm @@ -8,6 +8,7 @@ import Test.Html.Event as Event import Test.Html.Query as Query import Test.Html.Selector as Selector import Time exposing (millisToPosix, utc) +import Url exposing (Protocol(..), Url) inputSpec : Test @@ -251,6 +252,106 @@ inputSpec = (inputEmail "hello@example.com" [ Attribute.id "id" ]) ] ] + , describe "file inputs" <| + let + expected = + { label = "the label" + , value = "" + , type_ = "file" + } + in + [ describe "multiple false" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputFile False []) + ] + , describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputFile True []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputFile True []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputFile True [ Attribute.id "id" ]) + ] + ] + , describe "hidden inputs" <| + let + expected = + { label = "the label" + , value = "the value" + , type_ = "hidden" + } + in + [ describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputHidden "the name" "the value" []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputHidden "the name" "the value" []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputHidden "the name" "the value" [ Attribute.id "id" ]) + ] + ] + , describe "image inputs" <| + let + expected = + { label = "the label" + , value = "" + , type_ = "image" + } + + source : Url + source = + { protocol = Https + , host = "example.com" + , port_ = Nothing + , path = "/image.jpg" + , query = Nothing + , fragment = Nothing + } + in + [ describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputImage source []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputImage source []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputImage source [ Attribute.id "id" ]) + ] + ] ] From 1a44044aa9729950c3f403d2055b8c043799440c Mon Sep 17 00:00:00 2001 From: James Robb <47126579+jamesrweb@users.noreply.github.com> Date: Thu, 15 Sep 2022 23:35:58 +0200 Subject: [PATCH 10/14] Apply changes based on feedback --- elm.json | 1 - src/Accessibility.elm | 57 +++++++++---------------------------- tests/AccessibilitySpec.elm | 46 ++++-------------------------- 3 files changed, 18 insertions(+), 86 deletions(-) diff --git a/elm.json b/elm.json index eeeee2a..3a1db7f 100644 --- a/elm.json +++ b/elm.json @@ -18,7 +18,6 @@ "elm/core": "1.0.0 <= v < 2.0.0", "elm/html": "1.0.0 <= v < 2.0.0", "elm/json": "1.0.0 <= v < 2.0.0", - "elm/regex": "1.0.0 <= v < 2.0.0", "elm/time": "1.0.0 <= v < 2.0.0", "elm/url": "1.0.0 <= v < 2.0.0" }, diff --git a/src/Accessibility.elm b/src/Accessibility.elm index 4773578..3341de3 100644 --- a/src/Accessibility.elm +++ b/src/Accessibility.elm @@ -155,7 +155,6 @@ import Accessibility.Utils exposing (..) import DateUtils exposing (padNumberToDoubleDigit, toMonthNumber) import Html import Html.Attributes exposing (alt, attribute, checked, for, multiple, name, pattern, src, type_, value) -import Regex import Time exposing (Posix, Zone, toDay, toHour, toMinute, toMonth, toYear) import Url exposing (Url) @@ -218,17 +217,19 @@ inputText value_ attributes = {-| Constructs an input of type "text" but constricting the input to allow only numbers as recommended by [gov.uk](https://technology.blog.gov.uk/2020/02/24/why-the-gov-uk-design-system-team-changed-the-input-type-for-numbers/). Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). - inputNumber 1950 [ property "autocomplete" "bday-year" ] + inputNumber "1950" [ property "autocomplete" "bday-year" ] + + inputNumber "3.141579" [ property "autocomplete" "pi" ] Use the HTML autocomplete attribute whenever possible. Read [Understanding Success Criterion 1.3.5: Identify Input Purpose](https://www.w3.org/WAI/WCAG21/Understanding/identify-input-purpose) and [Using HTML 5.2 autocomplete attributes (Technique H98)](https://www.w3.org/WAI/WCAG21/Techniques/html/H98) for more information. You might notice that `Html.Attributes` doesn't provide full autocomplete support. This is tracked in [elm/html issue 189](https://github.com/elm/html/issues/189). -} -inputNumber : Int -> List (Attribute msg) -> Html msg +inputNumber : String -> List (Attribute msg) -> Html msg inputNumber value_ attributes = Html.input - ([ type_ "text", attribute "inputmode" "numeric", pattern "[0-9]*", value (String.fromInt value_) ] ++ attributes) + ([ type_ "text", attribute "inputmode" "numeric", pattern "[0-9]*", value value_ ] ++ attributes) [] @@ -263,40 +264,19 @@ checkbox value_ maybeChecked attributes = {-| Constructs an input of type "color". Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). -Color inputs don't require an initial value per specification and thus `Maybe String` is used as the value type. If the value is `Nothing` or the provided hex code is invalid then `#000000` will be used as per specification. +Color inputs don't require an initial value per specification and defaults to `#000000` if the value is empty or invalid. - checkbox (Just "#abc123") [] + inputColor "#abc123" [] - checkbox (Just "#FFFFF") [] + inputColor "#FFFFF" [] - checkbox Nothing [] + inputColor "" [] -} -inputColor : Maybe String -> List (Attribute msg) -> Html msg -inputColor maybeHexCode attributes = - let - -- See: https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input/color#value - hexRegex = - Regex.fromString "^#[0-9a-fA-F]{6}$" |> Maybe.withDefault Regex.never - - isValidHex : String -> Bool - isValidHex value = - Regex.contains hexRegex value - - hexCode = - Maybe.map isValidHex maybeHexCode - |> Maybe.andThen - (\valid -> - if valid then - maybeHexCode - - else - Nothing - ) - |> Maybe.withDefault "#000000" - in +inputColor : String -> List (Attribute msg) -> Html msg +inputColor value_ attributes = Html.input - ([ type_ "color", value hexCode ] ++ attributes) + ([ type_ "color", value value_ ] ++ attributes) [] @@ -371,19 +351,8 @@ You might notice that `Html.Attributes` doesn't provide full autocomplete suppor -} inputEmail : String -> List (Attribute msg) -> Html msg inputEmail value_ attributes = - let - htmlSpecEmailRegex = - Regex.fromString "^[a-zA-Z0-9.!#$%&'*+/=?^_`{|}~-]+@[a-zA-Z0-9](?:[a-zA-Z0-9-]{0,61}[a-zA-Z0-9])?(?:.[a-zA-Z0-9](?:[a-zA-Z0-9-]{0,61}[a-zA-Z0-9])?)*$" |> Maybe.withDefault Regex.never - - email = - if Regex.contains htmlSpecEmailRegex value_ then - value_ - - else - "" - in Html.input - ([ type_ "email", value email ] ++ attributes) + ([ type_ "email", value value_ ] ++ attributes) [] diff --git a/tests/AccessibilitySpec.elm b/tests/AccessibilitySpec.elm index 0ccd898..300acaa 100644 --- a/tests/AccessibilitySpec.elm +++ b/tests/AccessibilitySpec.elm @@ -106,54 +106,24 @@ inputSpec = , type_ = "color" } in - [ describe "fallback when a shorthex value is provided" - [ baseInputTests { expected | value = "#000000" } <| - labelBefore [] - (text "the label") - (inputColor (Just "#xyz") []) - ] - , describe "fallback when a hex without a hashtag is provided" - [ baseInputTests { expected | value = "#000000" } <| - labelBefore [] - (text "the label") - (inputColor (Just "123abc") []) - ] - , describe "fallback when a rgba hex is provided" - [ baseInputTests { expected | value = "#000000" } <| - labelBefore [] - (text "the label") - (inputColor (Just "#009900aa") []) - ] - , describe "fallback when an invalid value is provided" - [ baseInputTests { expected | value = "#000000" } <| - labelBefore [] - (text "the label") - (inputColor (Just "123") []) - ] - , describe "fallback when no initial value is provided" - [ baseInputTests { expected | value = "#000000" } <| - labelBefore [] - (text "the label") - (inputColor Nothing []) - ] - , describe "labelBefore" + [ describe "labelBefore" [ baseInputTests expected <| labelBefore [] (text "the label") - (inputColor (Just "#abc123") []) + (inputColor "#abc123" []) ] , describe "labelAfter" [ baseInputTests expected <| labelAfter [] (text "the label") - (inputColor (Just "#abc123") []) + (inputColor "#abc123" []) ] , describe "labelHidden" [ baseInputTests expected <| labelHidden "id" [] (text "the label") - (inputColor (Just "#abc123") [ Attribute.id "id" ]) + (inputColor "#abc123" [ Attribute.id "id" ]) ] ] , describe "date inputs" <| @@ -226,13 +196,7 @@ inputSpec = , type_ = "email" } in - [ describe "Invalid emails default to empty values" - [ baseInputTests { expected | value = "" } <| - labelBefore [] - (text "the label") - (inputEmail "email" []) - ] - , describe "labelBefore" + [ describe "labelBefore" [ baseInputTests expected <| labelBefore [] (text "the label") From 1ea1cb7027666354b9e5671f9ec9ce2583b88c47 Mon Sep 17 00:00:00 2001 From: James Robb <47126579+jamesrweb@users.noreply.github.com> Date: Thu, 27 Oct 2022 17:31:51 +0200 Subject: [PATCH 11/14] Add remaining input variants --- elm.json | 5 +- src/Accessibility.elm | 201 ++++++++++++++++++---- tests/Accessibility/LandmarkSpec.elm | 11 +- tests/Accessibility/RoleSpec.elm | 11 +- tests/AccessibilitySpec.elm | 241 ++++++++++++++++++++++++++- 5 files changed, 416 insertions(+), 53 deletions(-) diff --git a/elm.json b/elm.json index 3a1db7f..fd33d7a 100644 --- a/elm.json +++ b/elm.json @@ -18,10 +18,9 @@ "elm/core": "1.0.0 <= v < 2.0.0", "elm/html": "1.0.0 <= v < 2.0.0", "elm/json": "1.0.0 <= v < 2.0.0", - "elm/time": "1.0.0 <= v < 2.0.0", - "elm/url": "1.0.0 <= v < 2.0.0" + "elm/time": "1.0.0 <= v < 2.0.0" }, "test-dependencies": { - "elm-explorations/test": "1.2.1 <= v < 2.0.0" + "elm-explorations/test": "2.0.0 <= v < 3.0.0" } } diff --git a/src/Accessibility.elm b/src/Accessibility.elm index 3341de3..904874e 100644 --- a/src/Accessibility.elm +++ b/src/Accessibility.elm @@ -1,10 +1,10 @@ module Accessibility exposing ( labelBefore, labelAfter, labelHidden - , inputText, inputNumber, radio, checkbox, inputColor, inputDate, inputDateTimeLocal, inputEmail, inputFile, inputHidden, inputImage + , inputText, inputNumber, radio, checkbox, inputColor, inputDate, inputDateTimeLocal, inputEmail, inputFile, inputHidden, inputImage, inputMonth, inputPassword, inputRange, inputSearch, inputTel, inputTime, inputUrl, inputWeek , tabList, tab, tabPanel , img, decorativeImg , button, textarea, select - , text + , text, empty , h1, h2, h3, h4, h5, h6 , div, p, hr, pre, blockquote , span, a, code, em, strong, i, b, u, sub, sup, br @@ -21,7 +21,7 @@ module Accessibility exposing , small, cite, dfn, abbr, time, var, samp, kbd, s, q , mark, ruby, rt, rp, bdi, bdo, wbr , details, summary, menuitem, menu - , Html, Attribute, map + , map ) {-| @@ -38,7 +38,7 @@ Right now, this library only supports a few input types. Many more input types e See [MDN's input information](https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input) for more options. -@docs inputText, inputNumber, radio, checkbox, inputColor, inputDate, inputDateTimeLocal, inputEmail, inputFile, inputHidden, inputImage +@docs inputText, inputNumber, radio, checkbox, inputColor, inputDate, inputDateTimeLocal, inputEmail, inputFile, inputHidden, inputImage, inputMonth, inputPassword, inputRange, inputSearch, inputTel, inputTime, inputUrl, inputWeek ## Tabs @@ -118,7 +118,7 @@ These elements will prevent you from adding event listeners. import Accessibility exposing (..) -@docs text +@docs text, empty @docs h1, h2, h3, h4, h5, h6 @docs div, p, hr, pre, blockquote @docs span, a, code, em, strong, i, b, u, sub, sup, br @@ -153,10 +153,9 @@ import Accessibility.Role as Role import Accessibility.Style as Style import Accessibility.Utils exposing (..) import DateUtils exposing (padNumberToDoubleDigit, toMonthNumber) -import Html +import Html exposing (Attribute, Html) import Html.Attributes exposing (alt, attribute, checked, for, multiple, name, pattern, src, type_, value) import Time exposing (Posix, Zone, toDay, toHour, toMinute, toMonth, toYear) -import Url exposing (Url) {-| All inputs must be associated with a `label`. @@ -384,23 +383,163 @@ inputHidden name_ value_ attributes = {-| Constructs an input of type `image`. Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). - source : Url - source = - { protocol = Https - , host = "example.com" - , path = "/image.jpg" - , port_ = Nothing - , query = Nothing - , fragment = Nothing - } - - inputImage source [] + inputImage "/image.jpg" [] -} -inputImage : Url -> List (Attribute msg) -> Html msg +inputImage : String -> List (Attribute msg) -> Html msg inputImage src_ attributes = Html.input - ([ type_ "image", Url.toString src_ |> src, value "" ] ++ attributes) + ([ type_ "image", src src_, value "" ] ++ attributes) + [] + + +{-| Constructs an input of type "month". Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + import Time exposing (millisToPosix, utc) + + inputMonth (millisToPosix 0) utc [] + +-} +inputMonth : Posix -> Zone -> List (Attribute msg) -> Html msg +inputMonth timestamp timezone attributes = + let + month = + toMonth timezone timestamp |> toMonthNumber |> padNumberToDoubleDigit + + year = + toYear timezone timestamp |> String.fromInt + in + Html.input + ([ type_ "month" + , value (String.join "-" [ year, month ]) + ] + ++ attributes + ) + [] + + +{-| Constructs an input of type "password". Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + inputPassword "abc123" [] + +-} +inputPassword : String -> List (Attribute msg) -> Html msg +inputPassword value_ attributes = + Html.input + ([ type_ "password" + , value value_ + ] + ++ attributes + ) + [] + + +{-| Constructs an input of type "range". Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + inputRange 5 [] + +-} +inputRange : Int -> List (Attribute msg) -> Html msg +inputRange value_ attributes = + Html.input + ([ type_ "range" + , value (String.fromInt value_) + ] + ++ attributes + ) + [] + + +{-| Constructs an input of type "search". Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + inputSearch "abc123" [] + +-} +inputSearch : String -> List (Attribute msg) -> Html msg +inputSearch value_ attributes = + Html.input + ([ type_ "search" + , value value_ + ] + ++ attributes + ) + [] + + +{-| Constructs an input of type "tel". Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + inputTel "123-456-7890" "[0-9]{3}-[0-9]{3}-[0-9]{4}" [] + + As per the [MDN docs](https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input/tel), the input value is not automatically validated to a particular format like other input types such as "email" or "url" before the form can be submitted, because formats for telephone numbers vary so much around the world. To this end, a pattern should be provided when using this element. + +-} +inputTel : String -> String -> List (Attribute msg) -> Html msg +inputTel value_ pattern_ attributes = + Html.input + ([ type_ "tel" + , value value_ + , pattern pattern_ + ] + ++ attributes + ) + [] + + +{-| Constructs an input of type "time". Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + inputTime "21:00" [] + + As per the [MDN docs](https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input/time), the value of the time input is always in 24-hour format that includes leading zeros: hh:mm, regardless of the input format, which is likely to be selected based on the user's locale (or by the user agent). If the time includes seconds, the format is always hh:mm:ss. + +-} +inputTime : String -> List (Attribute msg) -> Html msg +inputTime value_ attributes = + Html.input + ([ type_ "time" + , value value_ + ] + ++ attributes + ) + [] + + +{-| Constructs an input of type "url". Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + inputUrl "https://example.com" [] + +-} +inputUrl : String -> List (Attribute msg) -> Html msg +inputUrl value_ attributes = + Html.input + ([ type_ "url" + , value value_ + ] + ++ attributes + ) + [] + + +{-| Constructs an input of type "week". Use in conjunction with one of the label helpers (`labelBefore`, `labelAfter`, `labelHidden`). + + import Time exposing (millisToPosix, utc) + + inputWeek (millisToPosix 0) utc 2 [] + + Since we cannot calculate the week number with the `elm/time` package and a custom implementation would be quite complex outside of it, the week number must be provided. + +-} +inputWeek : Posix -> Zone -> Int -> List (Attribute msg) -> Html msg +inputWeek timestamp timezone weekNumber attributes = + let + year = + toYear timezone timestamp |> String.fromInt + in + Html.input + ([ type_ "week" + , value (year ++ "-W" ++ String.fromInt weekNumber) + ] + ++ attributes + ) [] @@ -472,16 +611,6 @@ figure attributes = {- *** Aliasing Html Elements *** -} -{-| -} -type alias Html msg = - Html.Html msg - - -{-| -} -type alias Attribute msg = - Html.Attribute msg - - {-| `map` directly aliases the function of the same name from rtfeldman/elm-css. Please see [the docs for the Html.map](https://package.elm-lang.org/packages/rtfeldman/elm-css/17.0.1/Html-Styled#map). @@ -493,11 +622,21 @@ map = {-| -} -text : String -> Html.Html msg +text : String -> Html msg text = Html.text +{-| + + Creates an empty HTML node, useful for fallback or maybe cases when validations fail for example. + +-} +empty : Html msg +empty = + text "" + + -- INTERACTABLE diff --git a/tests/Accessibility/LandmarkSpec.elm b/tests/Accessibility/LandmarkSpec.elm index fcced62..4ad74ef 100644 --- a/tests/Accessibility/LandmarkSpec.elm +++ b/tests/Accessibility/LandmarkSpec.elm @@ -1,8 +1,9 @@ module Accessibility.LandmarkSpec exposing (spec) -import Accessibility as Html +import Accessibility exposing (div) import Accessibility.Landmark exposing (..) -import Html.Attributes +import Html exposing (Attribute) +import Html.Attributes exposing (property) import Json.Encode import Test exposing (..) import Test.Html.Query as Query @@ -24,13 +25,13 @@ spec = ] -addsRole : Html.Attribute Never -> String -> Test +addsRole : Attribute Never -> String -> Test addsRole role_ expected = test ("sets the role attribute: " ++ expected) <| \() -> - Html.div [] [ Html.div [ role_ ] [] ] + div [] [ div [ role_ ] [] ] |> Query.fromHtml |> Query.has [ Selector.attribute <| - Html.Attributes.property "role" (Json.Encode.string expected) + property "role" (Json.Encode.string expected) ] diff --git a/tests/Accessibility/RoleSpec.elm b/tests/Accessibility/RoleSpec.elm index c99d4b0..df07af5 100644 --- a/tests/Accessibility/RoleSpec.elm +++ b/tests/Accessibility/RoleSpec.elm @@ -1,8 +1,9 @@ module Accessibility.RoleSpec exposing (spec) -import Accessibility as Html +import Accessibility exposing (div) import Accessibility.Role exposing (..) -import Html.Attributes +import Html exposing (Attribute) +import Html.Attributes exposing (property) import Json.Encode import Test exposing (..) import Test.Html.Query as Query @@ -69,13 +70,13 @@ spec = ] -addsRole : Html.Attribute Never -> String -> Test +addsRole : Attribute Never -> String -> Test addsRole role_ expected = test ("sets the role attribute: " ++ expected) <| \() -> - Html.div [] [ Html.div [ role_ ] [] ] + div [] [ div [ role_ ] [] ] |> Query.fromHtml |> Query.has [ Selector.attribute <| - Html.Attributes.property "role" (Json.Encode.string expected) + property "role" (Json.Encode.string expected) ] diff --git a/tests/AccessibilitySpec.elm b/tests/AccessibilitySpec.elm index 300acaa..8c1a32d 100644 --- a/tests/AccessibilitySpec.elm +++ b/tests/AccessibilitySpec.elm @@ -1,6 +1,7 @@ module AccessibilitySpec exposing (htmlSpec, imageSpec, inputSpec) import Accessibility exposing (..) +import Html exposing (Html) import Html.Attributes as Attribute import Html.Events exposing (onClick) import Test exposing (..) @@ -8,7 +9,6 @@ import Test.Html.Event as Event import Test.Html.Query as Query import Test.Html.Selector as Selector import Time exposing (millisToPosix, utc) -import Url exposing (Protocol(..), Url) inputSpec : Test @@ -286,15 +286,8 @@ inputSpec = , type_ = "image" } - source : Url source = - { protocol = Https - , host = "example.com" - , port_ = Nothing - , path = "/image.jpg" - , query = Nothing - , fragment = Nothing - } + "/image.jpg" in [ describe "labelBefore" [ baseInputTests expected <| @@ -316,6 +309,236 @@ inputSpec = (inputImage source [ Attribute.id "id" ]) ] ] + , describe "month inputs" <| + let + posix = + millisToPosix 1640995200000 + + expected = + { label = "the label" + , value = "2022-01" + , type_ = "month" + } + in + [ describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputMonth posix utc []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputMonth posix utc []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputMonth posix utc [ Attribute.id "id" ]) + ] + ] + , describe "week inputs" <| + let + posix = + millisToPosix 1640995200000 + + expected = + { label = "the label" + , value = "2022-W2" + , type_ = "week" + } + in + [ describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputWeek posix utc 2 []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputWeek posix utc 2 []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputWeek posix utc 2 [ Attribute.id "id" ]) + ] + ] + , describe "password inputs" <| + let + expected = + { label = "the label" + , value = "the value" + , type_ = "password" + } + in + [ describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputPassword "the value" []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputPassword "the value" []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputPassword "the value" []) + ] + ] + , describe "range inputs" <| + let + expected = + { label = "the label" + , value = "5" + , type_ = "range" + } + in + [ describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputRange 5 []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputRange 5 []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputRange 5 []) + ] + ] + , describe "search inputs" <| + let + expected = + { label = "the label" + , value = "the value" + , type_ = "search" + } + in + [ describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputSearch "the value" []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputSearch "the value" []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputSearch "the value" []) + ] + ] + , describe "tel inputs" <| + let + expected = + { label = "the label" + , value = "123-456-7890" + , type_ = "tel" + } + in + [ describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputTel "123-456-7890" "[0-9]{3}-[0-9]{3}-[0-9]{4}" []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputTel "123-456-7890" "[0-9]{3}-[0-9]{3}-[0-9]{4}" []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputTel "123-456-7890" "[0-9]{3}-[0-9]{3}-[0-9]{4}" []) + ] + ] + , describe "time inputs" <| + let + expected = + { label = "the label" + , value = "21:00" + , type_ = "time" + } + in + [ describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputTime "21:00" []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputTime "21:00" []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputTime "21:00" []) + ] + ] + , describe "url inputs" <| + let + expected = + { label = "the label" + , value = "https://example.com" + , type_ = "url" + } + in + [ describe "labelBefore" + [ baseInputTests expected <| + labelBefore [] + (text "the label") + (inputUrl "https://example.com" []) + ] + , describe "labelAfter" + [ baseInputTests expected <| + labelAfter [] + (text "the label") + (inputUrl "https://example.com" []) + ] + , describe "labelHidden" + [ baseInputTests expected <| + labelHidden "id" + [] + (text "the label") + (inputUrl "https://example.com" []) + ] + ] ] From f25b01fb4483d627fa9ac2597d89aa24ab143084 Mon Sep 17 00:00:00 2001 From: James Robb <47126579+jamesrweb@users.noreply.github.com> Date: Tue, 18 Jun 2024 09:58:23 +0200 Subject: [PATCH 12/14] Re-export the Attribute type --- src/Accessibility.elm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/Accessibility.elm b/src/Accessibility.elm index df7abff..49cf748 100644 --- a/src/Accessibility.elm +++ b/src/Accessibility.elm @@ -1,5 +1,6 @@ module Accessibility exposing - ( labelBefore, labelAfter, labelHidden + ( Attribute, + , labelBefore, labelAfter, labelHidden , inputText, inputNumber, radio, checkbox, inputColor, inputDate, inputDateTimeLocal, inputEmail, inputFile, inputHidden, inputImage, inputMonth, inputPassword, inputRange, inputSearch, inputTel, inputTime, inputUrl, inputWeek , tabList, tab, tabPanel , img, decorativeImg @@ -153,10 +154,13 @@ import Accessibility.Role as Role import Accessibility.Style as Style import Accessibility.Utils exposing (..) import DateUtils exposing (padNumberToDoubleDigit, toMonthNumber) -import Html exposing (Attribute, Html) +import Html exposing (Html) import Html.Attributes exposing (alt, attribute, checked, for, multiple, name, pattern, src, type_, value) import Time exposing (Posix, Zone, toDay, toHour, toMinute, toMonth, toYear) +{-| -} +type alias Attribute msg = + Html.Attribute msg {-| All inputs must be associated with a `label`. From ed5d29348ff31491fe85927d8d6a0065fb78bf1a Mon Sep 17 00:00:00 2001 From: jamesrweb <47126579+jamesrweb@users.noreply.github.com> Date: Tue, 18 Jun 2024 10:03:50 +0200 Subject: [PATCH 13/14] Fix formatting and re-export the Html helper also --- src/Accessibility.elm | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/Accessibility.elm b/src/Accessibility.elm index 49cf748..c2b694d 100644 --- a/src/Accessibility.elm +++ b/src/Accessibility.elm @@ -1,6 +1,5 @@ module Accessibility exposing - ( Attribute, - , labelBefore, labelAfter, labelHidden + ( labelBefore, labelAfter, labelHidden , inputText, inputNumber, radio, checkbox, inputColor, inputDate, inputDateTimeLocal, inputEmail, inputFile, inputHidden, inputImage, inputMonth, inputPassword, inputRange, inputSearch, inputTel, inputTime, inputUrl, inputWeek , tabList, tab, tabPanel , img, decorativeImg @@ -22,7 +21,7 @@ module Accessibility exposing , small, cite, dfn, abbr, time, var, samp, kbd, s, q , mark, ruby, rt, rp, bdi, bdo, wbr , details, summary, menuitem, menu - , map + , Html, Attribute, map ) {-| @@ -154,14 +153,21 @@ import Accessibility.Role as Role import Accessibility.Style as Style import Accessibility.Utils exposing (..) import DateUtils exposing (padNumberToDoubleDigit, toMonthNumber) -import Html exposing (Html) +import Html import Html.Attributes exposing (alt, attribute, checked, for, multiple, name, pattern, src, type_, value) import Time exposing (Posix, Zone, toDay, toHour, toMinute, toMonth, toYear) + +{-| -} +type alias Html msg = + Html.Html msg + + {-| -} type alias Attribute msg = Html.Attribute msg + {-| All inputs must be associated with a `label`. labelBefore [] viewLabel viewInput From 6dd3eba249064d066921fb890c3791b5263f059c Mon Sep 17 00:00:00 2001 From: jamesrweb <47126579+jamesrweb@users.noreply.github.com> Date: Tue, 18 Jun 2024 10:08:36 +0200 Subject: [PATCH 14/14] Resolve conflicting elm.json --- elm.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elm.json b/elm.json index 0f653be..665a429 100644 --- a/elm.json +++ b/elm.json @@ -3,7 +3,7 @@ "name": "tesk9/accessible-html", "summary": "view helpers enforcing accessible practices", "license": "BSD-3-Clause", - "version": "6.1.0", + "version": "6.2.0", "exposed-modules": [ "Accessibility", "Accessibility.Aria",