added labelledBy attribute to the tabs

This commit is contained in:
Nuno Ferreira 2021-05-26 14:29:25 +01:00
parent 021d553e45
commit 9a3f659418
3 changed files with 27 additions and 5 deletions

View File

@ -206,6 +206,7 @@ view config =
, tabView = [ viewIcon option.icon, option.label ] , tabView = [ viewIcon option.icon, option.label ]
, panelView = option.content , panelView = option.content
, spaHref = Maybe.map (\toUrl -> toUrl option.value) config.toUrl , spaHref = Maybe.map (\toUrl -> toUrl option.value) config.toUrl
, labelledBy = Nothing
} }
{ tabList, tabPanels } = { tabList, tabPanels } =

View File

@ -2,7 +2,7 @@ module Nri.Ui.Tabs.V7 exposing
( view ( view
, Alignment(..) , Alignment(..)
, Tab, Attribute, build , Tab, Attribute, build
, tabString, tabHtml, withTooltip , tabString, tabHtml, withTooltip, labelledBy
, panelHtml , panelHtml
, spaHref , spaHref
) )
@ -16,12 +16,13 @@ module Nri.Ui.Tabs.V7 exposing
@docs view @docs view
@docs Alignment @docs Alignment
@docs Tab, Attribute, build @docs Tab, Attribute, build
@docs tabString, tabHtml, withTooltip @docs tabString, tabHtml, withTooltip, labelledBy
@docs panelHtml @docs panelHtml
@docs spaHref @docs spaHref
-} -}
import Accessibility.Styled.Aria as Aria
import Css exposing (..) import Css exposing (..)
import Html.Styled as Html exposing (Html) import Html.Styled as Html exposing (Html)
import Html.Styled.Attributes as Attributes import Html.Styled.Attributes as Attributes
@ -62,6 +63,14 @@ withTooltip attributes =
Attribute (\tab -> { tab | tabTooltip = attributes }) Attribute (\tab -> { tab | tabTooltip = attributes })
{-| Sets an overriding labelledBy on the tab for an external tooltip.
This assumes an external tooltip is set and disables any internal tooltip configured.
-}
labelledBy : String -> Attribute id msg
labelledBy labelledById =
Attribute (\tab -> { tab | labelledBy = Just labelledById })
{-| -} {-| -}
panelHtml : Html msg -> Attribute id msg panelHtml : Html msg -> Attribute id msg
panelHtml content = panelHtml content =

View File

@ -44,6 +44,7 @@ type alias Tab id msg =
, tabView : List (Html msg) , tabView : List (Html msg)
, panelView : Html msg , panelView : Html msg
, spaHref : Maybe String , spaHref : Maybe String
, labelledBy : Maybe String
} }
@ -59,6 +60,7 @@ fromList { id, idString } attributes =
, tabView = [] , tabView = []
, panelView = Html.text "" , panelView = Html.text ""
, spaHref = Nothing , spaHref = Nothing
, labelledBy = Nothing
} }
in in
List.foldl (\applyAttr acc -> applyAttr acc) defaults attributes List.foldl (\applyAttr acc -> applyAttr acc) defaults attributes
@ -131,14 +133,24 @@ viewTab_ config index tab =
, Events.on "keyup" <| , Events.on "keyup" <|
Json.Decode.andThen (keyEvents config tab) Events.keyCode Json.Decode.andThen (keyEvents config tab) Events.keyCode
] ]
++ (case tab.labelledBy of
Nothing ->
[]
Just labelledById ->
[ Aria.labelledBy labelledById ]
)
) )
tab.tabView tab.tabView
in in
case tab.tabTooltip of -- If the labelledByAttribute gets passed in, we're using an external
[] -> -- tooltip, so we override any existing internal tooltip to not create
-- accessibility problems.
case ( tab.labelledBy, tab.tabTooltip ) of
( Just _, _ ) ->
buttonOrLink [] buttonOrLink []
tooltipAttributes -> ( Nothing, tooltipAttributes ) ->
Tooltip.view Tooltip.view
{ id = "tab-tooltip__" ++ tabToId tab.idString { id = "tab-tooltip__" ++ tabToId tab.idString
, trigger = \eventHandlers -> buttonOrLink eventHandlers , trigger = \eventHandlers -> buttonOrLink eventHandlers