R/inputs.R

In a11yShiny: Accessibility Enhancements to Popular R Shiny Functions

#' Accessible action button
#'
#' A wrapper for [shiny::actionButton()] with ARIA attributes according to
#' BITV 2.0, enforced visible label or `aria-label`, and custom CSS class.
#'
#' @param inputId Button ID
#' @param label (optional) Visible label
#' @param icon (optional) Icon, e.g. `shiny::icon("check")`
#' @param aria_label (optional, but required if `label` is missing or empty)
#'   ARIA label for buttons without text
#' @param aria_controls (optional) ARIA controls attribute
#' @param ... Additional arguments for [shiny::actionButton()]
#' @return HTML `<button>` tag with appropriate ARIA attributes
#'
#' @examples
#' # Button with a visible label
#' a11y_actionButton("btn1", label = "Submit")
#'
#' # Icon-only button (aria_label required)
#' a11y_actionButton("btn2",
#'   icon = shiny::icon("search"),
#'   aria_label = "Search"
#' )
#'
#' # Button with aria-controls linking to another element
#' a11y_actionButton("btn3",
#'   label = "Toggle",
#'   aria_controls = "panel1"
#' )
#'
#' # Button with visible label, icon, and additional aria-label
#' a11y_actionButton("refresh",
#'   label = "Refresh",
#'   icon = shiny::icon("refresh"),
#'   aria_label = "Click to refresh data"
#' )
#'
#' @export

a11y_actionButton <- function(
  inputId,
  label = NULL,
  icon = NULL,
  aria_label = NULL,
  aria_controls = NULL,
  ...
) {
  btn_args <- list(inputId = inputId, label = label, ...)

  # Append the a11y class for consistent styling, preserving any user-supplied classes
  existing_class <- btn_args[["class"]]
  btn_args[["class"]] <- if (!is.null(existing_class)) {
    paste("a11y-btn", existing_class)
  } else {
    "a11y-btn"
  }

  # Mark the icon as decorative (aria-hidden) so screen readers skip it
  # and rely on the button's text or aria-label instead
  if (!is.null(icon)) {
    icon <- add_aria(icon, hidden = "true")
    btn_args$icon <- icon
  }

  btn <- do.call(shiny::actionButton, btn_args)

  # Buttons without visible text need an aria-label so screen readers
  # can announce a meaningful name; error if neither is provided
  label_is_empty <- !is_nonblank_string(label)
  if (label_is_empty) {
    if (!is_nonblank_string(aria_label)) {
      id_msg <- if (!is.null(inputId)) paste0(" (inputId: ", inputId, ")") else ""
      stop(paste0("a11y_actionButton: Buttons without a visible label require an 'aria_label' for accessibility", id_msg), call. = FALSE)
    }
    btn <- add_aria(btn, label = aria_label)
  }
  # Link this button to the element it controls (e.g. a panel or input)
  if (!is.null(aria_controls)) {
    btn <- add_aria(btn, controls = aria_controls)
  }

  # Ensure the a11y stylesheet/JS is loaded
  htmltools::attachDependencies(btn, list(use_a11y()))
}

#' Accessible select input
#'
#' A wrapper for [shiny::selectInput()] with ARIA attributes according to
#' BITV 2.0, enforced visible label, optional heading annotation, custom CSS
#' class, and sr-only description support.
#'
#' @param inputId Input ID
#' @param label Visible label (required)
#' @param choices Choice list (as in [shiny::selectInput()])
#' @param selected Preselection (optional)
#' @param multiple Multiple selection (default: `FALSE`)
#' @param describedby ID of an element for `aria-describedby` (optional)
#' @param describedby_text Creates an sr-only `<div>` that serves as a
#'   description and is linked via `aria-describedby`. If `describedby` is set,
#'   its ID is used, otherwise an ID is generated (`<inputId>-desc`). (optional)
#' @param heading_level 1--6, marks the visible `<label>` as a heading via
#'   `role="heading"` and `aria-level` (optional)
#' @param aria_controls (optional) ARIA controls attribute
#' @param ... Additional arguments for [shiny::selectInput()]
#' @return HTML tag of the input component (possibly with sr-only description)
#'
#' @examples
#' # Basic select input
#' a11y_selectInput("colour", "Colour",
#'   choices = c("Red", "Green", "Blue")
#' )
#'
#' # With a screen-reader-only description
#' a11y_selectInput("size", "Size",
#'   choices = c("S", "M", "L"),
#'   describedby_text = "Choose a t-shirt size"
#' )
#'
#' # Label promoted to a heading (useful for sectioned forms)
#' a11y_selectInput("n_breaks", "Number of bins",
#'   choices = c(10, 20, 35, 50),
#'   selected = 20,
#'   heading_level = 3
#' )
#'
#' # Linking to an existing description element via its ID
#' htmltools::tags$p(id = "n_breaks_help", "Choose how many bins to display")
#' a11y_selectInput("n_breaks2", "Number of bins",
#'   choices = c(10, 20, 35, 50),
#'   describedby = "n_breaks_help"
#' )
#'
#' @export
a11y_selectInput <- function(inputId,
                             label,
                             choices,
                             selected = NULL,
                             multiple = FALSE,
                             ...,
                             describedby = NULL,
                             describedby_text = NULL,
                             heading_level = NULL,
                             aria_controls = NULL) {
  dots <- list(...)
  selectize_used <- if (!is.null(dots$selectize)) isTRUE(dots$selectize) else TRUE

  # BITV 2.0 requires a visible label for every form control
  label_visible <- !missing(label) && is_nonblank_string(label)
  if (!label_visible) {
    id_msg <- if (!is.null(inputId)) paste0(" (inputId: ", inputId, ")") else ""
    stop(paste0("a11y_selectInput: A visible `label` is required", id_msg), call. = FALSE)
  }

  # Create the standard Shiny select input as a starting point
  si <- shiny::selectInput(
    inputId = inputId,
    label = label,
    choices = choices,
    selected = selected,
    multiple = multiple,
    ...
  )

  # Add a11y class for consistent focus ring and contrast styling
  si <- htmltools::tagAppendAttributes(si, class = "a11y-select")

  # Build a visually hidden description that screen readers announce
  # via aria-describedby (use caller's ID if given, otherwise generate one)
  sr_desc_div <- NULL
  desc_id <- NULL
  if (is_nonblank_string(describedby_text)) {
    desc_id <- if (is_nonblank_string(describedby)) describedby else paste0(inputId, "-desc")
    sr_desc_div <- htmltools::tags$div(id = desc_id, class = "a11y-sr-only", describedby_text)
  } else if (is_nonblank_string(describedby)) {
    desc_id <- describedby
  }

  # Set aria-describedby on the outer container as a fallback
  if (is_nonblank_string(desc_id)) {
    si <- add_aria(si, describedby = desc_id)
  }

  # Apply ARIA attributes on the actual interactive element, which differs
  # between selectize (rendered as a combobox input) and native <select>
  if (selectize_used) {
    si <- add_aria_inside(si, ".selectize-control .selectize-input input", role = "combobox")
    if (is_nonblank_string(desc_id)) {
      si <- add_aria_inside(si, ".selectize-control .selectize-input input", describedby = desc_id)
    }
  } else {
    if (is_nonblank_string(desc_id)) {
      si <- add_aria_inside(si, "select", describedby = desc_id)
    }
  }

  # Promote the label to a heading so it appears in the document outline
  # (useful when the select starts a new form section)
  if (!is.null(heading_level)) {
    if (!is.numeric(heading_level) || !(heading_level %in% 1:6)) {
      stop("a11y_selectInput: heading_level must be number 1-6", call. = FALSE)
    }
    if (label_visible) {
      si <- add_aria_inside(
        si, "label.control-label",
        role = "heading", "aria-level" = as.integer(heading_level)
      )
    }
  }

  # Combine the select input with the optional hidden description
  out <- if (!is.null(sr_desc_div)) htmltools::tagList(si, sr_desc_div) else si

  # Link this input to the element it controls (e.g. a chart or table)
  if (!is.null(aria_controls)) {
    out <- add_aria(out, controls = aria_controls)
  }
  # Ensure the a11y stylesheet/JS is loaded
  htmltools::attachDependencies(out, list(use_a11y()))
}

#' Accessible numeric input
#'
#' A wrapper for [shiny::numericInput()] with ARIA attributes according to
#' BITV 2.0, enforced visible label, optional heading annotation, custom CSS
#' class, and sr-only description support.
#'
#' @param inputId Input ID
#' @param label Visible label (required)
#' @param value Initial numeric value
#' @param min Minimum value (optional; `NA` for none)
#' @param max Maximum value (optional; `NA` for none)
#' @param step Step size (optional; `NA` for none)
#' @param describedby ID of help text for `aria-describedby` (optional)
#' @param describedby_text Creates an sr-only `<div>` that serves as a
#'   description and is linked via `aria-describedby`. If `describedby` is set,
#'   its ID is used, otherwise an ID is generated (`<inputId>-desc`). (optional)
#' @param heading_level 1--6, marks the visible `<label>` as a heading via
#'   `role="heading"` and `aria-level` (optional)
#' @param aria_controls (optional) ARIA controls attribute
#' @param ... Additional arguments for [shiny::numericInput()]
#' @return HTML tag of the input component
#'
#' @examples
#' # Basic numeric input
#' a11y_numericInput("age", "Age", value = 30, min = 0, max = 120)
#'
#' # With heading-level annotation and description
#' a11y_numericInput("score", "Score",
#'   value = 0,
#'   min = 0, max = 100,
#'   heading_level = 3,
#'   describedby_text = "Enter a value between 0 and 100"
#' )
#'
#' # Linking to an existing help-text element by its ID
#' a11y_numericInput("seed", "Seed",
#'   value = 123,
#'   describedby = "seed_help"
#' )
#'
#' @export
a11y_numericInput <- function(inputId,
                              label,
                              value,
                              min = NA,
                              max = NA,
                              step = NA,
                              ...,
                              describedby = NULL,
                              describedby_text = NULL,
                              heading_level = NULL,
                              aria_controls = NULL) {
  # BITV 2.0 requires a visible label for every form control
  label_visible <- !missing(label) && is_nonblank_string(label)
  if (!label_visible) {
    id_msg <- if (!is.null(inputId)) paste0(" (inputId: ", inputId, ")") else ""
    stop(paste0("a11y_numericInput: A visible `label` is required", id_msg), call. = FALSE)
  }

  # Create the standard Shiny numeric input as a starting point
  ni <- shiny::numericInput(
    inputId = inputId,
    label   = label,
    value   = value,
    min     = min,
    max     = max,
    step    = step,
    ...
  )

  # Add a11y class for consistent focus ring and contrast styling
  ni <- htmltools::tagAppendAttributes(ni, class = "a11y-numeric")

  # Build a visually hidden description that screen readers announce
  # via aria-describedby (use caller's ID if given, otherwise generate one)
  sr_desc_div <- NULL
  desc_id <- NULL
  if (is_nonblank_string(describedby_text)) {
    desc_id <- if (is_nonblank_string(describedby)) describedby else paste0(inputId, "-desc")
    sr_desc_div <- htmltools::tags$div(id = desc_id, class = "a11y-sr-only", describedby_text)
  } else if (is_nonblank_string(describedby)) {
    desc_id <- describedby
  }

  # Set aria-describedby on the outer container as a fallback
  if (is_nonblank_string(desc_id)) {
    ni <- add_aria(ni, describedby = desc_id)
  }

  # Target the actual <input> element (Shiny's wrapper DIV is not interactive)
  input_sel <- paste0("#", inputId)

  # Mark aria-valuemin, aria-valuemax, and aria-valuenow so screen readers
  # expose the allowed range and current value
  if (!is.null(min) && !is.na(min)) ni <- add_aria_inside(ni, input_sel, "aria-valuemin" = as.numeric(min))
  if (!is.null(max) && !is.na(max)) ni <- add_aria_inside(ni, input_sel, "aria-valuemax" = as.numeric(max))
  if (!is.null(value) && !is.na(value)) ni <- add_aria_inside(ni, input_sel, "aria-valuenow" = as.numeric(value))

  # Also set aria-describedby directly on the <input> so the description
  # is announced when the control receives focus (not just on the wrapper)
  if (is_nonblank_string(desc_id)) {
    ni <- add_aria_inside(ni, input_sel, describedby = desc_id)
  }

  # Promote the label to a heading so it appears in the document outline
  # (useful when the numeric input starts a new form section)
  if (!is.null(heading_level)) {
    if (!is.numeric(heading_level) || !(heading_level %in% 1:6)) {
      stop("a11y_numericInput: heading_level must be a number 1-6", call. = FALSE)
    }
    if (label_visible) {
      ni <- add_aria_inside(
        ni, "label.control-label",
        role = "heading", "aria-level" = as.integer(heading_level)
      )
    }
  }

  # Combine the numeric input with the optional hidden description
  out <- if (!is.null(sr_desc_div)) htmltools::tagList(ni, sr_desc_div) else ni

  # Link this input to the element it controls (e.g. a chart or table)
  if (!is.null(aria_controls)) {
    out <- add_aria(out, controls = aria_controls)
  }
  # Ensure the a11y stylesheet/JS is loaded
  htmltools::attachDependencies(out, list(use_a11y()))
}

#' Accessible text input
#'
#' A wrapper for [shiny::textInput()] with ARIA attributes according to
#' BITV 2.0, enforced visible label, optional heading annotation, custom CSS
#' class, and sr-only description support.
#'
#' @param inputId Input ID
#' @param label Visible label (required)
#' @param value Initial text value (default: `""`)
#' @param width Control width (optional)
#' @param placeholder Placeholder text (optional)
#' @param describedby ID of an element for `aria-describedby` (optional)
#' @param describedby_text Creates an sr-only `<div>` that serves as a
#'   description and is linked via `aria-describedby`. If `describedby` is set,
#'   its ID is used, otherwise an ID is generated (`<inputId>-desc`). (optional)
#' @param heading_level 1--6, marks the visible `<label>` as a heading via
#'   `role="heading"` and `aria-level` (optional)
#' @param aria_controls (optional) ARIA controls attribute
#' @param ... Additional arguments for [shiny::textInput()]
#'
#' @return HTML tag of the input component (possibly with sr-only description)
#'
#' @examples
#' # Basic text input
#' a11y_textInput("name", "Full name")
#'
#' # With placeholder and screen-reader description
#' a11y_textInput("email", "E-mail address",
#'   placeholder = "user@example.com",
#'   describedby_text = "We will never share your e-mail"
#' )
#'
#' # With heading-level annotation (for sectioned forms)
#' a11y_textInput("company", "Company name",
#'   heading_level = 3
#' )
#'
#' # Linking to an existing description element via its ID
#' a11y_textInput("query", "Search query",
#'   describedby = "query_help"
#' )
#'
#' @export
a11y_textInput <- function(inputId,
                           label,
                           value = "",
                           width = NULL,
                           placeholder = NULL,
                           ...,
                           describedby = NULL,
                           describedby_text = NULL,
                           heading_level = NULL,
                           aria_controls = NULL) {
  # BITV 2.0 requires a visible label for every form control
  label_visible <- !missing(label) && is_nonblank_string(label)
  if (!label_visible) {
    id_msg <- if (!is.null(inputId)) paste0(" (inputId: ", inputId, ")") else ""
    stop(paste0("a11y_textInput: A visible `label` is required", id_msg), call. = FALSE)
  }

  # Create the standard Shiny text input as a starting point
  ti <- shiny::textInput(
    inputId     = inputId,
    label       = label,
    value       = value,
    width       = width,
    placeholder = placeholder,
    ...
  )

  # Add a11y class for consistent focus ring and contrast styling
  ti <- htmltools::tagAppendAttributes(ti, class = "a11y-text")

  # Build a visually hidden description that screen readers announce
  # via aria-describedby (use caller's ID if given, otherwise generate one)
  sr_desc_div <- NULL
  desc_id <- NULL
  if (is_nonblank_string(describedby_text)) {
    desc_id <- if (is_nonblank_string(describedby)) {
      describedby
    } else {
      paste0(inputId, "-desc")
    }
    sr_desc_div <- htmltools::tags$div(
      id    = desc_id,
      class = "a11y-sr-only",
      describedby_text
    )
  } else if (is_nonblank_string(describedby)) {
    desc_id <- describedby
  }

  # Set aria-describedby on the outer container as a fallback
  if (is_nonblank_string(desc_id)) {
    ti <- add_aria(ti, describedby = desc_id)
  }

  # Target the actual <input> element (Shiny's wrapper DIV is not interactive)
  input_sel <- paste0("#", inputId)

  # Also set aria-describedby directly on the <input> so the description
  # is announced when the control receives focus (not just on the wrapper)
  if (is_nonblank_string(desc_id)) {
    ti <- add_aria_inside(ti, input_sel, describedby = desc_id)
  }

  # Promote the label to a heading so it appears in the document outline
  # (useful when the text input starts a new form section)
  if (!is.null(heading_level)) {
    if (!is.numeric(heading_level) || !(heading_level %in% 1:6)) {
      stop("a11y_textInput: heading_level must be a number 1-6", call. = FALSE)
    }
    if (label_visible) {
      ti <- add_aria_inside(
        ti, "label.control-label",
        role = "heading",
        "aria-level" = as.integer(heading_level)
      )
    }
  }

  # Combine the text input with the optional hidden description
  out <- if (!is.null(sr_desc_div)) htmltools::tagList(ti, sr_desc_div) else ti

  # Link this input to the element it controls (e.g. a search results panel)
  if (!is.null(aria_controls)) {
    out <- add_aria(out, controls = aria_controls)
  }
  # Ensure the a11y stylesheet/JS is loaded
  htmltools::attachDependencies(out, list(use_a11y()))
}

#' Accessible radio buttons
#'
#' A wrapper for [shiny::radioButtons()] with ARIA attributes according to
#' BITV 2.0, enforced visible label, optional heading annotation, custom CSS
#' class, and sr-only description support.
#'
#' @param inputId Input ID
#' @param label Visible label (required)
#' @param choices Choices (as in [shiny::radioButtons()])
#' @param selected Preselected value (optional)
#' @param inline Display inline (logical, default: `FALSE`)
#' @param describedby ID of an element for `aria-describedby` (optional)
#' @param describedby_text Creates an sr-only `<div>` that serves as a
#'   description and is linked via `aria-describedby`. If `describedby` is set,
#'   its ID is used, otherwise an ID is generated (`<inputId>-desc`). (optional)
#' @param heading_level 1--6, marks the visible `<label>` as a heading via
#'   `role="heading"` and `aria-level` (optional)
#' @param aria_controls (optional) ARIA controls attribute
#' @param ... Additional arguments for [shiny::radioButtons()]
#'
#' @return HTML tag of the input component (possibly with sr-only description)
#'
#' @examples
#' # Basic radio buttons
#' a11y_radioButtons("format", "Output format",
#'   choices = c("CSV", "Excel", "JSON")
#' )
#'
#' # Inline layout with heading annotation
#' a11y_radioButtons("yesno", "Agree?",
#'   choices = c("Yes", "No"),
#'   inline = TRUE,
#'   heading_level = 4
#' )
#'
#' # With named choices and a screen-reader description
#' a11y_radioButtons("radio_choice", "Pick one",
#'   choices = list(
#'     "Option 1" = 1,
#'     "Option 2" = 2,
#'     "Option 3" = 3
#'   ),
#'   selected = 1,
#'   describedby_text = "Select one of the three options"
#' )
#'
#' @export
a11y_radioButtons <- function(inputId,
                              label,
                              choices,
                              selected = NULL,
                              inline = FALSE,
                              ...,
                              describedby = NULL,
                              describedby_text = NULL,
                              heading_level = NULL,
                              aria_controls = NULL) {
  # BITV 2.0 requires a visible label for every form control
  label_visible <- !missing(label) && is_nonblank_string(label)
  if (!label_visible) {
    id_msg <- if (!is.null(inputId)) paste0(" (inputId: ", inputId, ")") else ""
    stop(paste0("a11y_radioButtons: A visible `label` is required", id_msg), call. = FALSE)
  }

  # Create the standard Shiny radio buttons as a starting point
  rb <- shiny::radioButtons(
    inputId  = inputId,
    label    = label,
    choices  = choices,
    selected = selected,
    inline   = inline,
    ...
  )

  # Add a11y class for consistent focus ring and contrast styling
  rb <- htmltools::tagAppendAttributes(rb, class = "a11y-radio")

  # Build a visually hidden description that screen readers announce
  # via aria-describedby (use caller's ID if given, otherwise generate one)
  sr_desc_div <- NULL
  desc_id <- NULL
  if (is_nonblank_string(describedby_text)) {
    desc_id <- if (is_nonblank_string(describedby)) {
      describedby
    } else {
      paste0(inputId, "-desc")
    }
    sr_desc_div <- htmltools::tags$div(
      id    = desc_id,
      class = "a11y-sr-only",
      describedby_text
    )
  } else if (is_nonblank_string(describedby)) {
    desc_id <- describedby
  }

  # Set aria-describedby on the outer container as a fallback
  if (is_nonblank_string(desc_id)) {
    rb <- add_aria(rb, describedby = desc_id)
  }

  # Target the inner DIV that Shiny uses to wrap the radio options;
  # set aria-describedby directly on the radiogroup so the description
  # is announced when focus enters the group
  group_sel <- paste0("#", inputId)
  if (is_nonblank_string(desc_id)) {
    rb <- add_aria_inside(rb, group_sel, describedby = desc_id)
  }

  # Promote the label to a heading so it appears in the document outline
  # (useful when the radio group starts a new form section)
  if (!is.null(heading_level)) {
    if (!is.numeric(heading_level) || !(heading_level %in% 1:6)) {
      stop("a11y_radioButtons: heading_level must be a number 1-6", call. = FALSE)
    }
    if (label_visible) {
      rb <- add_aria_inside(
        rb, "label.control-label",
        role = "heading",
        "aria-level" = as.integer(heading_level)
      )
    }
  }

  # Combine the radio buttons with the optional hidden description
  out <- if (!is.null(sr_desc_div)) htmltools::tagList(rb, sr_desc_div) else rb

  # Link this input to the element it controls (e.g. a filtered output)
  if (!is.null(aria_controls)) {
    out <- add_aria(out, controls = aria_controls)
  }
  # Ensure the a11y stylesheet/JS is loaded
  htmltools::attachDependencies(out, list(use_a11y()))
}

#' Accessible date input
#'
#' A wrapper for [shiny::dateInput()] with ARIA attributes according to
#' BITV 2.0, enforced visible label, optional heading annotation, custom CSS
#' class, and sr-only description support.
#'
#' @param inputId Input ID
#' @param label Visible label (required)
#' @param value Initial date value (Date or string, optional)
#' @param min Minimum date (optional)
#' @param max Maximum date (optional)
#' @param format Date format (as in [shiny::dateInput()], default: `"yyyy-mm-dd"`)
#' @param startview Initial view (`"month"`, `"year"`, `"decade"`;
#'   default: `"month"`)
#' @param weekstart First day of the week (1 = Monday, default: `1`)
#' @param language Language for the datepicker (default: `"en"`)
#' @param width Control width (optional)
#' @param describedby ID of an element for `aria-describedby` (optional)
#' @param describedby_text Creates an sr-only `<div>` that serves as a
#'   description and is linked via `aria-describedby`. If `describedby` is set,
#'   its ID is used, otherwise an ID is generated (`<inputId>-desc`). (optional)
#' @param heading_level 1--6, marks the visible `<label>` as a heading via
#'   `role="heading"` and `aria-level` (optional)
#' @param aria_controls (optional) ARIA controls attribute
#' @param ... Additional arguments for [shiny::dateInput()]
#'
#' @return HTML tag of the input component (possibly with sr-only description)
#'
#' @examples
#' # Basic date input
#' a11y_dateInput("start", "Start date")
#'
#' # With German datepicker, custom format and description
#' a11y_dateInput("birthday", "Date of birth",
#'   format = "dd.mm.yyyy",
#'   language = "de",
#'   describedby_text = "Enter your date of birth"
#' )
#'
#' # Date input with heading-level annotation
#' a11y_dateInput("mydate", "Select date:",
#'   language = "de",
#'   heading_level = 2
#' )
#'
#' @export
a11y_dateInput <- function(inputId,
                           label,
                           value = NULL,
                           min = NULL,
                           max = NULL,
                           format = "yyyy-mm-dd",
                           startview = "month",
                           weekstart = 1,
                           language = "en",
                           width = NULL,
                           ...,
                           describedby = NULL,
                           describedby_text = NULL,
                           heading_level = NULL,
                           aria_controls = NULL) {
  # BITV 2.0 requires a visible label for every form control
  label_visible <- !missing(label) && is_nonblank_string(label)
  if (!label_visible) {
    id_msg <- if (!is.null(inputId)) paste0(" (inputId: ", inputId, ")") else ""
    stop(paste0("a11y_dateInput: A visible `label` is required", id_msg), call. = FALSE)
  }

  # Create the standard Shiny date input as a starting point
  di <- shiny::dateInput(
    inputId   = inputId,
    label     = label,
    value     = value,
    min       = min,
    max       = max,
    format    = format,
    startview = startview,
    weekstart = weekstart,
    language  = language,
    width     = width,
    ...
  )

  # Add a11y class for consistent focus ring and contrast styling
  di <- htmltools::tagAppendAttributes(di, class = "a11y-date")

  # Build a visually hidden description that screen readers announce
  # via aria-describedby (use caller's ID if given, otherwise generate one)
  sr_desc_div <- NULL
  desc_id <- NULL
  if (is_nonblank_string(describedby_text)) {
    desc_id <- if (is_nonblank_string(describedby)) {
      describedby
    } else {
      paste0(inputId, "-desc")
    }
    sr_desc_div <- htmltools::tags$div(
      id    = desc_id,
      class = "a11y-sr-only",
      describedby_text
    )
  } else if (is_nonblank_string(describedby)) {
    desc_id <- describedby
  }

  # Set aria-describedby on the outer container as a fallback
  if (is_nonblank_string(desc_id)) {
    di <- add_aria(di, describedby = desc_id)
  }

  # Target the actual <input> element (Shiny's wrapper DIV is not interactive)
  input_sel <- paste0("#", inputId)

  # Also set aria-describedby directly on the <input> so the description
  # is announced when the control receives focus (not just on the wrapper)
  if (is_nonblank_string(desc_id)) {
    di <- add_aria_inside(di, input_sel, describedby = desc_id)
  }

  # Promote the label to a heading so it appears in the document outline
  # (useful when the date input starts a new form section)
  if (!is.null(heading_level)) {
    if (!is.numeric(heading_level) || !(heading_level %in% 1:6)) {
      stop("a11y_dateInput: heading_level must be a number 1-6", call. = FALSE)
    }
    if (label_visible) {
      di <- add_aria_inside(
        di, "label.control-label",
        role = "heading",
        "aria-level" = as.integer(heading_level)
      )
    }
  }

  # Combine the date input with the optional hidden description
  out <- if (!is.null(sr_desc_div)) htmltools::tagList(di, sr_desc_div) else di

  # Link this input to the element it controls (e.g. a filtered output)
  if (!is.null(aria_controls)) {
    out <- add_aria(out, controls = aria_controls)
  }
  # Ensure the a11y stylesheet/JS is loaded
  htmltools::attachDependencies(out, list(use_a11y()))
}