Package with an initial set of functions added

NOTE: Not all tests have been written yet!

.Rbuildignore

@@ -1 +1,2 @@
 ^LICENSE\.md$
+^README\.Rmd$

DESCRIPTION

@@ -1,12 +1,22 @@
 Package: AVSDevR.HTMLUtils
-Title: Utility Functions For Modifying R Shiny HTML Elements
+Title: Utility Functions For Modifying R HTML Elements
 Version: 0.0.0.9000
 Authors@R: 
     person("Craig", "Williams", , "craig@avsdev.uk", role = c("aut", "cre"))
-Description: Collection of utility functions for modifying HTML markup of Shiny
+Description: Collection of utility functions for modifying HTML markup of
-    elements including adding/removing attributes or child tags, tweaking
+    Shiny, ShinyDashboard, etc HTML elements including adding/removing 
-    default behaviour and accessibility styling.
+    attributes or child tags, tweaking default behaviour and accessibility
+    styling.
+URL: https://git.avsdev.uk/R/AVSDevR.HTMLUtils
+BugReports: https://git.avsdev.uk/R/AVSDevR.HTMLUtils/issues
 License: GPL (>= 3)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.3
+Imports: 
+    htmltools
+Suggests: 
+    shiny,
+    shinydashboard,
+    testthat (>= 3.0.0)
+Config/testthat/edition: 3

NAMESPACE

@@ -1,2 +1,12 @@
 # Generated by roxygen2: do not edit by hand
 
+export(htmlAddBoxAttributes)
+export(htmlAddBoxRegionFromTitle)
+export(htmlDisableAutocomplete)
+export(htmlFixBoxCollapseButtonAria)
+export(htmlMarkOptional)
+export(htmlMarkRequired)
+export(htmlRemoveAttributes)
+export(htmlReplaceBoxTitleLevel)
+export(htmlSetMaxLength)
+export(htmlSetMinLength)

R/htmlBoxManipulation.R

@@ -0,0 +1,89 @@
+getBoxTitle <- function(box) {
+  header_tags <- htmltools::tagQuery(box)$find(".box-header")$selectedTags()
+  if (length(header_tags) == 0) {
+    return(NULL)
+  }
+  title_tags <- htmltools::tagQuery(box)$find(".box-title")$selectedTags()
+  if (length(title_tags) == 0) {
+    return(NULL)
+  }
+  title_tags[[1]]$children
+}
+
+#' Add attributes to .box elements (`shinydashboard::box`)
+#'
+#' @param box The box to set the attributes on
+#' @param ... The attributes to set on the box
+#'
+#' @return The modified box
+#' @export
+#'
+#' @examples
+#' x <- shinydashboard::box()
+#' htmlAddBoxAttributes(x, role = "region", `aria-label` = "This is a special box")
+htmlAddBoxAttributes <- function(box, ...) {
+  htmltools::tagQuery(box)$
+    find(".box")$
+    addAttr(...)$
+    allTags()
+}
+
+#' Creates an aria landmark for a `shinydashboard::box` from the box title
+#'
+#' @param box The box to set the aria landmark on
+#'
+#' @return The modified box
+#' @export
+#'
+#' @examples
+#' x <- shinydashboard::box(title = "This is a powerful box")
+#' htmlAddBoxRegionFromTitle(x)
+htmlAddBoxRegionFromTitle <- function(box) {
+  title <- getBoxTitle(box)
+  if (is.null(title)) {
+    return(box)
+  }
+  htmlAddBoxAttributes(box, role = "region", `aria-label` = title)
+}
+
+#' Replaces the default `shinydashboard::box` title level (h3)
+#'
+#' @param box The box to set the title level on
+#' @param newLevel The new title level (default = 2)
+#'
+#' @return The modified box
+#' @export
+#'
+#' @examples
+#' x <- shinydashboard::box(title = "This is a box")
+#' htmlReplaceBoxTitleLevel(x, 2)
+htmlReplaceBoxTitleLevel <- function(box, newLevel = 2) {
+  box_titles <- htmltools::tagQuery(box)$find(".box-title")$selectedTags()
+  box_titles <- lapply(box_titles, function(bt) {
+    bt$name <- paste0("h", newLevel)
+    bt
+  })
+  htmltools::tagQuery(box)$find(".box-title")$replaceWith(box_titles)$allTags()
+}
+
+#' Adds "aria-label" attribute to the box collapse/expand button
+#'
+#' @param box The box to set the attributes on
+#' @param context The context for the aria label. Defaults to the box title if
+#'     not set
+#'
+#' @return The modified box
+#' @export
+#'
+#' @examples
+#' x <- shinydashboard::box(title = "This is a box")
+#' htmlFixBoxCollapseButtonAria(x)
+htmlFixBoxCollapseButtonAria <- function(box, context = NULL) {
+  if (is.null(context)) {
+    context <- getBoxTitle(box)
+  }
+  htmltools::tagQuery(box)$
+    find(".box-tools button.btn-box-tool")$
+    addAttrs(`aria-label` = paste0("Expand/Collapse ", context))$
+    allTags()
+}

R/htmlDisableAutocomplete.R

@@ -0,0 +1,16 @@
+#' Mark an HTML input as autocomplete = off
+#'
+#' @param input The Shiny input to set the autocomplete attribute on
+#'
+#' @return The modified input
+#' @export
+#'
+#' @examples
+#' x <- shiny::textInput("input_id", "Some text input")
+#' htmlDisableAutocomplete(x)
+htmlDisableAutocomplete <- function(input) {
+  htmltools::tagQuery(input)$
+    find("input")$
+    addAttr(autocomplete = "off")$
+    allTags()
+}

R/htmlMarkOptional.R

@@ -0,0 +1,35 @@
+#' Explicitly mark a Shiny input as optional
+#'
+#' @param input The Shiny input to mark as optional
+#' @param optClass The classes to add to the indicator text
+#'
+#' @return The modified input
+#' @export
+#'
+#' @examples
+#' x <- shiny::textInput("input_id", "Some text input")
+#' htmlMarkOptional(x)
+htmlMarkOptional <- function(input, optClass = "text-muted font-italic") {
+  opt_span <- htmltools::tags$span(class = optClass, " (optional)")
+  tq <- htmltools::tagQuery(input)
+  if (tq$hasClass("shiny-input-checkboxgroup")) {
+    tq <- tq$
+      children("label")$append(opt_span)$
+      reset()
+  } else if (tq$find(".shiny-options-group")$length() > 0) {
+    tq <- tq$
+      children("label")$append(opt_span)$
+      reset()
+  } else if (tq$find(".btn-file")$length() > 0) {
+    tq <- tq$
+      children("label")$append(opt_span)$
+      reset()
+  } else {
+    tq <- tq$
+      children(".checkbox")$find("label span")$append(opt_span)$
+      reset()$
+      find("label.control-label")$append(opt_span)$
+      reset()
+  }
+  tq$allTags()
+}

R/htmlMarkRequired.R

@@ -0,0 +1,54 @@
+#' Mark a Shiny input as required
+#'
+#' @param input The Shiny input to mark as required
+#' @param reqClass The classes to add to the indicator asterisk
+#'
+#' @return The modified input
+#' @export
+#'
+#' @examples
+#' x <- shiny::textInput("input_id", "Some text input")
+#' htmlMarkRequired(x)
+htmlMarkRequired <- function(input, reqClass = "text-danger required") {
+  req_span <- htmltools::tags$span(class = reqClass, "*")
+  tq <- htmltools::tagQuery(input)
+  if (tq$hasClass("shiny-input-checkboxgroup")) {
+    tq <- tq$
+      addAttr(`aria-required` = "true")$
+      reset()$
+      children("label")$append(req_span)$
+      reset()
+  } else if (tq$find(".shiny-options-group")$length() > 0) {
+    tq <- tq$
+      children("label")$append(req_span)$
+      reset()$
+      addAttr(`aria-required` = "true")$
+      reset()$
+      find("input")$addAttr(required = "true", `aria-required` = "true")$
+      reset()
+  } else if (tq$find(".btn-file")$length() > 0) {
+    tq <- tq$
+      children("label")$append(req_span)$
+      reset()$
+      addAttr(`aria-required` = "true")$
+      reset()$
+      find(".shiny-input-file")$
+      addAttr(required = "true", `aria-required` = "true")$
+      reset()
+  } else {
+    tq <- tq$
+    # Update the label
+      children(".checkbox")$find("label span")$append(req_span)$
+      reset()$
+      find("label.control-label")$append(req_span)$
+      reset()$
+    # Update the inputs
+      find("input")$addAttr(required = "true", `aria-required` = "true")$
+      reset()$
+      find("textarea")$addAttr(required = "true", `aria-required` = "true")$
+      reset()$
+      find("select")$addAttr(required = "true", `aria-required` = "true")$
+      reset()
+  }
+  tq$allTags()
+}

R/htmlRemoveAttributes.R

@@ -0,0 +1,16 @@
+#' Remove attributes from an HTML element
+#'
+#' @param el The element to remove the attributes from
+#' @param ... The attribute names to be removed
+#'
+#' @return The modified element
+#' @export
+#'
+#' @examples
+#' x <- shiny::icon("wrench")
+#' htmlRemoveAttributes(x, "aria-label")
+htmlRemoveAttributes <- function(el, ...) {
+  htmltools::tagQuery(el)$
+    removeAttrs(list(...))$
+    allTags()
+}

R/htmlSetXLength.R

@@ -0,0 +1,47 @@
+#' Set the maximum length on a text or textarea input
+#'
+#' @param input The Shiny input to set the length attribute on
+#' @param length The maximum length allowed on the input
+#'
+#' @return The modified input
+#' @export
+#'
+#' @examples
+#' x <- shiny::textInput("input_id", "Some text input")
+#' htmlSetMaxLength(x, 50)
+htmlSetMaxLength <- function(input, length) {
+  htmltools::tagQuery(input)$
+    find(".shiny-input-password")$
+    addAttr(maxlength = length)$
+    reset()$
+    find(".shiny-input-text")$
+    addAttr(maxlength = length)$
+    reset()$
+    find("textarea")$
+    addAttr(maxlength = length)$
+    allTags()
+}
+
+#' Set the minimum length on a text or textarea input
+#'
+#' @param input The Shiny input to set the length attribute on
+#' @param length The minimum length allowed on the input
+#'
+#' @return The modified input
+#' @export
+#'
+#' @examples
+#' x <- shiny::textInput("input_id", "Some text input")
+#' htmlSetMinLength(x, 3)
+htmlSetMinLength <- function(input, length) {
+  htmltools::tagQuery(input)$
+    find(".shiny-input-password")$
+    addAttr(minlength = length)$
+    reset()$
+    find(".shiny-input-text")$
+    addAttr(minlength = length)$
+    reset()$
+    find("textarea")$
+    addAttr(minlength = length)$
+    allTags()
+}

README.Rmd

@@ -0,0 +1,35 @@
+---
+output: github_document
+---
+
+<!-- README.md is generated from README.Rmd. Please edit that file -->
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>",
+  fig.path = "man/figures/README-",
+  out.width = "100%"
+)
+```
+
+# AVSDevR.HTMLUtils
+
+<!-- badges: start -->
+<!-- badges: end -->
+
+The goal of AVSDevR.HTMLUtils is to provide utility functions to modify Shiny/ShinyDashboards/HTML elements (inputs, outputs and general structures) to add/remove attributes and children, tweak default behaviour and/or make its more WCAG accessibly friendly.
+
+## Installation
+
+You can install the development version of AVSDevR.HTMLUtils like so:
+
+``` r
+remotes::install_git("https://git.avsdev.uk/R/AVSDevR.HTMLUtils")
+```
+
+You can install the release version of AVSDevR.HTMLUtils like so:
+
+``` r
+remotes::install_git("https://git.avsdev.uk/R/AVSDevR.HTMLUtils", branch = "release")
+```

README.md

@@ -0,0 +1,26 @@
+
+<!-- README.md is generated from README.Rmd. Please edit that file -->
+
+# AVSDevR.HTMLUtils
+
+<!-- badges: start -->
+<!-- badges: end -->
+
+The goal of AVSDevR.HTMLUtils is to provide utility functions to modify
+Shiny/ShinyDashboards/HTML elements (inputs, outputs and general
+structures) to add/remove attributes and children, tweak default
+behaviour and/or make its more WCAG accessibly friendly.
+
+## Installation
+
+You can install the development version of AVSDevR.HTMLUtils like so:
+
+``` r
+remotes::install_git("https://git.avsdev.uk/R/AVSDevR.HTMLUtils")
+```
+
+You can install the release version of AVSDevR.HTMLUtils like so:
+
+``` r
+remotes::install_git("https://git.avsdev.uk/R/AVSDevR.HTMLUtils", branch = "release")
+```

man/htmlAddBoxAttributes.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/htmlBoxManipulation.R
+\name{htmlAddBoxAttributes}
+\alias{htmlAddBoxAttributes}
+\title{Add attributes to .box elements (\code{shinydashboard::box})}
+\usage{
+htmlAddBoxAttributes(box, ...)
+}
+\arguments{
+\item{box}{The box to set the attributes on}
+
+\item{...}{The attributes to set on the box}
+}
+\value{
+The modified box
+}
+\description{
+Add attributes to .box elements (\code{shinydashboard::box})
+}
+\examples{
+x <- shinydashboard::box()
+htmlAddBoxAttributes(x, role = "region", `aria-label` = "This is a special box")
+}

man/htmlAddBoxRegionFromTitle.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/htmlBoxManipulation.R
+\name{htmlAddBoxRegionFromTitle}
+\alias{htmlAddBoxRegionFromTitle}
+\title{Creates an aria landmark for a \code{shinydashboard::box} from the box title}
+\usage{
+htmlAddBoxRegionFromTitle(box)
+}
+\arguments{
+\item{box}{The box to set the aria landmark on}
+}
+\value{
+The modified box
+}
+\description{
+Creates an aria landmark for a \code{shinydashboard::box} from the box title
+}
+\examples{
+x <- shinydashboard::box(title = "This is a powerful box")
+htmlAddBoxRegionFromTitle(x)
+}

man/htmlDisableAutocomplete.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/htmlDisableAutocomplete.R
+\name{htmlDisableAutocomplete}
+\alias{htmlDisableAutocomplete}
+\title{Mark an HTML input as autocomplete = off}
+\usage{
+htmlDisableAutocomplete(input)
+}
+\arguments{
+\item{input}{The Shiny input to set the autocomplete attribute on}
+}
+\value{
+The modified input
+}
+\description{
+Mark an HTML input as autocomplete = off
+}
+\examples{
+x <- shiny::textInput("input_id", "Some text input")
+htmlDisableAutocomplete(x)
+}

man/htmlFixBoxCollapseButtonAria.Rd

@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/htmlBoxManipulation.R
+\name{htmlFixBoxCollapseButtonAria}
+\alias{htmlFixBoxCollapseButtonAria}
+\title{Adds "aria-label" attribute to the box collapse/expand button}
+\usage{
+htmlFixBoxCollapseButtonAria(box, context = NULL)
+}
+\arguments{
+\item{box}{The box to set the attributes on}
+
+\item{context}{The context for the aria label. Defaults to the box title if
+not set}
+}
+\value{
+The modified box
+}
+\description{
+Adds "aria-label" attribute to the box collapse/expand button
+}
+\examples{
+x <- shinydashboard::box(title = "This is a box")
+htmlFixBoxCollapseButtonAria(x)
+}

man/htmlMarkOptional.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/htmlMarkOptional.R
+\name{htmlMarkOptional}
+\alias{htmlMarkOptional}
+\title{Explicitly mark a Shiny input as optional}
+\usage{
+htmlMarkOptional(input, optClass = "text-muted font-italic")
+}
+\arguments{
+\item{input}{The Shiny input to mark as optional}
+
+\item{optClass}{The classes to add to the indicator text}
+}
+\value{
+The modified input
+}
+\description{
+Explicitly mark a Shiny input as optional
+}
+\examples{
+x <- shiny::textInput("input_id", "Some text input")
+htmlMarkOptional(x)
+}

man/htmlMarkRequired.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/htmlMarkRequired.R
+\name{htmlMarkRequired}
+\alias{htmlMarkRequired}
+\title{Mark a Shiny input as required}
+\usage{
+htmlMarkRequired(input, reqClass = "text-danger required")
+}
+\arguments{
+\item{input}{The Shiny input to mark as required}
+
+\item{reqClass}{The classes to add to the indicator asterisk}
+}
+\value{
+The modified input
+}
+\description{
+Mark a Shiny input as required
+}
+\examples{
+x <- shiny::textInput("input_id", "Some text input")
+htmlMarkRequired(x)
+}

man/htmlRemoveAttributes.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/htmlRemoveAttributes.R
+\name{htmlRemoveAttributes}
+\alias{htmlRemoveAttributes}
+\title{Remove attributes from an HTML element}
+\usage{
+htmlRemoveAttributes(el, ...)
+}
+\arguments{
+\item{el}{The element to remove the attributes from}
+
+\item{...}{The attribute names to be removed}
+}
+\value{
+The modified element
+}
+\description{
+Remove attributes from an HTML element
+}
+\examples{
+x <- shiny::icon("wrench")
+htmlRemoveAttributes(x, "aria-label")
+}

man/htmlReplaceBoxTitleLevel.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/htmlBoxManipulation.R
+\name{htmlReplaceBoxTitleLevel}
+\alias{htmlReplaceBoxTitleLevel}
+\title{Replaces the default \code{shinydashboard::box} title level (h3)}
+\usage{
+htmlReplaceBoxTitleLevel(box, newLevel = 2)
+}
+\arguments{
+\item{box}{The box to set the title level on}
+
+\item{newLevel}{The new title level (default = 2)}
+}
+\value{
+The modified box
+}
+\description{
+Replaces the default \code{shinydashboard::box} title level (h3)
+}
+\examples{
+x <- shinydashboard::box(title = "This is a box")
+htmlReplaceBoxTitleLevel(x, 2)
+}

man/htmlSetMaxLength.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/htmlSetXLength.R
+\name{htmlSetMaxLength}
+\alias{htmlSetMaxLength}
+\title{Set the maximum length on a text or textarea input}
+\usage{
+htmlSetMaxLength(input, length)
+}
+\arguments{
+\item{input}{The Shiny input to set the length attribute on}
+
+\item{length}{The maximum length allowed on the input}
+}
+\value{
+The modified input
+}
+\description{
+Set the maximum length on a text or textarea input
+}
+\examples{
+x <- shiny::textInput("input_id", "Some text input")
+htmlSetMaxLength(x, 50)
+}

man/htmlSetMinLength.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/htmlSetXLength.R
+\name{htmlSetMinLength}
+\alias{htmlSetMinLength}
+\title{Set the minimum length on a text or textarea input}
+\usage{
+htmlSetMinLength(input, length)
+}
+\arguments{
+\item{input}{The Shiny input to set the length attribute on}
+
+\item{length}{The minimum length allowed on the input}
+}
+\value{
+The modified input
+}
+\description{
+Set the minimum length on a text or textarea input
+}
+\examples{
+x <- shiny::textInput("input_id", "Some text input")
+htmlSetMinLength(x, 3)
+}

tests/testthat.R

@@ -0,0 +1,12 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
+library(testthat)
+library(AVSDevR.HTMLUtils)
+
+test_check("AVSDevR.HTMLUtils")

tests/testthat/test-htmlMarkRequired.R

@@ -0,0 +1,69 @@
+## Tests for all inputs:
+# shiny::checkboxInput
+# shiny::checkboxGroupInput
+# shiny::dateInput
+# shiny::dateRangeInput
+# shiny::fileInput
+# shiny::numericInput
+# X shiny::passwordInput
+# shiny::radioButtons
+# X shiny::selectInput
+# X shiny::selectizeInput
+# X shiny::sliderInput
+# X shiny::snapshotPreprocessInput
+# shiny::textInput
+# X shiny::textAreaInput
+# X shiny::varSelectizeInput
+# X shiny::varSelectInput
+
+test_that("required checkbox input", {
+  x <- shiny::checkboxInput("input_id", "Some checkbox input")
+  y <- "<div class=\"form-group shiny-input-container\">\n  <div class=\"checkbox\">\n    <label>\n      <input id=\"input_id\" type=\"checkbox\" class=\"shiny-input-checkbox\" required=\"true\" aria-required=\"true\"/>\n      <span>\n        Some checkbox input\n        <span class=\"text-danger required\">*</span>\n      </span>\n    </label>\n  </div>\n</div>"
+  expect_equal(as.character(htmlMarkRequired(x)), y)
+})
+
+test_that("required checkbox group input", {
+  x <- shiny::checkboxGroupInput(
+    "input_id", "Some checkbox group", choices = c(`Choice 1` = 1, `Choice 2` = 2)
+  )
+  y <- "<div id=\"input_id\" class=\"form-group shiny-input-checkboxgroup shiny-input-container\" role=\"group\" aria-labelledby=\"input_id-label\" aria-required=\"true\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">\n    Some checkbox group\n    <span class=\"text-danger required\">*</span>\n  </label>\n  <div class=\"shiny-options-group\">\n    <div class=\"checkbox\">\n      <label>\n        <input type=\"checkbox\" name=\"input_id\" value=\"1\"/>\n        <span>Choice 1</span>\n      </label>\n    </div>\n    <div class=\"checkbox\">\n      <label>\n        <input type=\"checkbox\" name=\"input_id\" value=\"2\"/>\n        <span>Choice 2</span>\n      </label>\n    </div>\n  </div>\n</div>"
+  expect_equal(as.character(htmlMarkRequired(x)), y)
+})
+
+test_that("required date input", {
+  x <- shiny::dateInput("input_id", "Some date input")
+  y <- "<div id=\"input_id\" class=\"shiny-date-input form-group shiny-input-container\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">\n    Some date input\n    <span class=\"text-danger required\">*</span>\n  </label>\n  <input type=\"text\" class=\"form-control\" aria-labelledby=\"input_id-label\" title=\"Date format: yyyy-mm-dd\" data-date-language=\"en\" data-date-week-start=\"0\" data-date-format=\"yyyy-mm-dd\" data-date-start-view=\"month\" data-date-autoclose=\"true\" data-date-dates-disabled=\"null\" data-date-days-of-week-disabled=\"null\" required=\"true\" aria-required=\"true\"/>\n</div>"
+  expect_equal(as.character(htmlMarkRequired(x)), y)
+})
+
+test_that("required date range input", {
+  x <- shiny::dateRangeInput("input_id", "Some date range input")
+  y <- "<div id=\"input_id\" class=\"shiny-date-range-input form-group shiny-input-container\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">\n    Some date range input\n    <span class=\"text-danger required\">*</span>\n  </label>\n  <div class=\"input-daterange input-group input-group-sm\">\n    <input class=\"form-control\" type=\"text\" aria-labelledby=\"input_id-label\" title=\"Date format: yyyy-mm-dd\" data-date-language=\"en\" data-date-week-start=\"0\" data-date-format=\"yyyy-mm-dd\" data-date-start-view=\"month\" data-date-autoclose=\"true\" required=\"true\" aria-required=\"true\"/>\n    <span class=\"input-group-addon input-group-prepend input-group-append\">\n      <span class=\"input-group-text\"> to </span>\n    </span>\n    <input class=\"form-control\" type=\"text\" aria-labelledby=\"input_id-label\" title=\"Date format: yyyy-mm-dd\" data-date-language=\"en\" data-date-week-start=\"0\" data-date-format=\"yyyy-mm-dd\" data-date-start-view=\"month\" data-date-autoclose=\"true\" required=\"true\" aria-required=\"true\"/>\n  </div>\n</div>"
+  expect_equal(as.character(htmlMarkRequired(x)), y)
+})
+
+test_that("required file input", {
+  x <- shiny::fileInput("input_id", "Some file input")
+  y <- "<div class=\"form-group shiny-input-container\" aria-required=\"true\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">\n    Some file input\n    <span class=\"text-danger required\">*</span>\n  </label>\n  <div class=\"input-group\">\n    <label class=\"input-group-btn input-group-prepend\">\n      <span class=\"btn btn-default btn-file\">\n        Browse...\n        <input id=\"input_id\" class=\"shiny-input-file\" name=\"input_id\" type=\"file\" style=\"position: absolute !important; top: -99999px !important; left: -99999px !important;\" required=\"true\" aria-required=\"true\"/>\n      </span>\n    </label>\n    <input type=\"text\" class=\"form-control\" placeholder=\"No file selected\" readonly=\"readonly\"/>\n  </div>\n  <div id=\"input_id_progress\" class=\"progress active shiny-file-input-progress\">\n    <div class=\"progress-bar\"></div>\n  </div>\n</div>"
+  expect_equal(as.character(htmlMarkRequired(x)), y)
+})
+
+test_that("required numeric input", {
+  x <- shiny::numericInput("input_id", "Some numeric input", 0)
+  y <- "<div class=\"form-group shiny-input-container\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">\n    Some numeric input\n    <span class=\"text-danger required\">*</span>\n  </label>\n  <input id=\"input_id\" type=\"number\" class=\"shiny-input-number form-control\" value=\"0\" data-update-on=\"change\" required=\"true\" aria-required=\"true\"/>\n</div>"
+  expect_equal(as.character(htmlMarkRequired(x)), y)
+})
+
+test_that("required radio buttons", {
+  x <- shiny::radioButtons(
+    "input_id", "Some radio buttons", choices = c(`Choice 1` = 1, `Choice 2` = 2)
+  )
+  y <- "<div id=\"input_id\" class=\"form-group shiny-input-radiogroup shiny-input-container\" role=\"radiogroup\" aria-labelledby=\"input_id-label\" aria-required=\"true\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">\n    Some radio buttons\n    <span class=\"text-danger required\">*</span>\n  </label>\n  <div class=\"shiny-options-group\">\n    <div class=\"radio\">\n      <label>\n        <input type=\"radio\" name=\"input_id\" value=\"1\" checked=\"checked\" required=\"true\" aria-required=\"true\"/>\n        <span>Choice 1</span>\n      </label>\n    </div>\n    <div class=\"radio\">\n      <label>\n        <input type=\"radio\" name=\"input_id\" value=\"2\" required=\"true\" aria-required=\"true\"/>\n        <span>Choice 2</span>\n      </label>\n    </div>\n  </div>\n</div>"
+  expect_equal(as.character(htmlMarkRequired(x)), y)
+})
+
+test_that("required text input", {
+  x <- shiny::textInput("input_id", "Some text input")
+  y <- "<div class=\"form-group shiny-input-container\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">\n    Some text input\n    <span class=\"text-danger required\">*</span>\n  </label>\n  <input id=\"input_id\" type=\"text\" class=\"shiny-input-text form-control\" value=\"\" data-update-on=\"change\" required=\"true\" aria-required=\"true\"/>\n</div>"
+  expect_equal(as.character(htmlMarkRequired(x)), y)
+})

tests/testthat/test-htmlRemoveAttributes.R

@@ -0,0 +1,13 @@
+test_that("remove existing attribute", {
+  x <- shiny::icon("wrench")
+  y <- "<i class=\"fas fa-wrench\" role=\"presentation\"></i>"
+  expect_equal(as.character(htmlRemoveAttributes(x, "aria-label")), y)
+})
+
+test_that("remove non-existing attribute does not fail", {
+  x <- shiny::icon("wrench")
+  expect_equal(
+    as.character(htmlRemoveAttributes(x, "aria-title")),
+    as.character(x)
+  )
+})

tests/testthat/test-htmlSetXLength.R

@@ -0,0 +1,47 @@
+test_that("maximum length password input", {
+  x <- shiny::passwordInput("input_id", "Some password input")
+  y <- "<div class=\"form-group shiny-input-container\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">Some password input</label>\n  <input id=\"input_id\" type=\"password\" class=\"shiny-input-password form-control\" value=\"\" data-update-on=\"change\" maxlength=\"50\"/>\n</div>"
+  expect_equal(as.character(htmlSetMaxLength(x, 50)), y)
+})
+test_that("minimum length password input", {
+  x <- shiny::passwordInput("input_id", "Some password input")
+  y <- "<div class=\"form-group shiny-input-container\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">Some password input</label>\n  <input id=\"input_id\" type=\"password\" class=\"shiny-input-password form-control\" value=\"\" data-update-on=\"change\" minlength=\"3\"/>\n</div>"
+  expect_equal(as.character(htmlSetMinLength(x, 3)), y)
+})
+test_that("min/max length password input", {
+  x <- shiny::passwordInput("input_id", "Some password input")
+  y <- "<div class=\"form-group shiny-input-container\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">Some password input</label>\n  <input id=\"input_id\" type=\"password\" class=\"shiny-input-password form-control\" value=\"\" data-update-on=\"change\" minlength=\"3\" maxlength=\"50\"/>\n</div>"
+  expect_equal(as.character(htmlSetMaxLength(htmlSetMinLength(x, 3), 50)), y)
+})
+
+test_that("maximum length text input", {
+  x <- shiny::textInput("input_id", "Some text input")
+  y <- "<div class=\"form-group shiny-input-container\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">Some text input</label>\n  <input id=\"input_id\" type=\"text\" class=\"shiny-input-text form-control\" value=\"\" data-update-on=\"change\" maxlength=\"50\"/>\n</div>"
+  expect_equal(as.character(htmlSetMaxLength(x, 50)), y)
+})
+test_that("minimum length text input", {
+  x <- shiny::textInput("input_id", "Some text input")
+  y <- "<div class=\"form-group shiny-input-container\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">Some text input</label>\n  <input id=\"input_id\" type=\"text\" class=\"shiny-input-text form-control\" value=\"\" data-update-on=\"change\" minlength=\"3\"/>\n</div>"
+  expect_equal(as.character(htmlSetMinLength(x, 3)), y)
+})
+test_that("min/max length text input", {
+  x <- shiny::textInput("input_id", "Some text input")
+  y <- "<div class=\"form-group shiny-input-container\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">Some text input</label>\n  <input id=\"input_id\" type=\"text\" class=\"shiny-input-text form-control\" value=\"\" data-update-on=\"change\" minlength=\"3\" maxlength=\"50\"/>\n</div>"
+  expect_equal(as.character(htmlSetMaxLength(htmlSetMinLength(x, 3), 50)), y)
+})
+
+test_that("maximum length textarea input", {
+  x <- shiny::textAreaInput("input_id", "Some textarea input")
+  y <- "<div class=\"shiny-input-textarea form-group shiny-input-container\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">Some textarea input</label>\n  <textarea id=\"input_id\" class=\"form-control\" data-update-on=\"change\" maxlength=\"500\"></textarea>\n</div>"
+  expect_equal(as.character(htmlSetMaxLength(x, 500)), y)
+})
+test_that("minimum length textarea input", {
+  x <- shiny::textAreaInput("input_id", "Some textarea input")
+  y <- "<div class=\"shiny-input-textarea form-group shiny-input-container\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">Some textarea input</label>\n  <textarea id=\"input_id\" class=\"form-control\" data-update-on=\"change\" minlength=\"50\"></textarea>\n</div>"
+  expect_equal(as.character(htmlSetMinLength(x, 50)), y)
+})
+test_that("min/max length textarea input", {
+  x <- shiny::textAreaInput("input_id", "Some textarea input")
+  y <- "<div class=\"shiny-input-textarea form-group shiny-input-container\">\n  <label class=\"control-label\" id=\"input_id-label\" for=\"input_id\">Some textarea input</label>\n  <textarea id=\"input_id\" class=\"form-control\" data-update-on=\"change\" minlength=\"50\" maxlength=\"500\"></textarea>\n</div>"
+  expect_equal(as.character(htmlSetMaxLength(htmlSetMinLength(x, 50), 500)), y)
+})