diff --git a/.Rbuildignore b/.Rbuildignore index 5163d0b..2a2cb83 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1 +1,2 @@ ^LICENSE\.md$ +^README\.Rmd$ diff --git a/DESCRIPTION b/DESCRIPTION index 2a10ae7..b3a3116 100644 --- a/DESCRIPTION +++ b/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 - elements including adding/removing attributes or child tags, tweaking - default behaviour and accessibility styling. +Description: Collection of utility functions for modifying HTML markup of + Shiny, ShinyDashboard, etc HTML elements including adding/removing + 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 diff --git a/NAMESPACE b/NAMESPACE index 6ae9268..66198a5 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/htmlBoxManipulation.R b/R/htmlBoxManipulation.R new file mode 100644 index 0000000..792dea2 --- /dev/null +++ b/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() +} diff --git a/R/htmlDisableAutocomplete.R b/R/htmlDisableAutocomplete.R new file mode 100644 index 0000000..28c4dd1 --- /dev/null +++ b/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() +} diff --git a/R/htmlMarkOptional.R b/R/htmlMarkOptional.R new file mode 100644 index 0000000..246c09b --- /dev/null +++ b/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() +} diff --git a/R/htmlMarkRequired.R b/R/htmlMarkRequired.R new file mode 100644 index 0000000..387991b --- /dev/null +++ b/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() +} diff --git a/R/htmlRemoveAttributes.R b/R/htmlRemoveAttributes.R new file mode 100644 index 0000000..ab5f039 --- /dev/null +++ b/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() +} diff --git a/R/htmlSetXLength.R b/R/htmlSetXLength.R new file mode 100644 index 0000000..eba362e --- /dev/null +++ b/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() +} diff --git a/README.Rmd b/README.Rmd new file mode 100644 index 0000000..454e687 --- /dev/null +++ b/README.Rmd @@ -0,0 +1,35 @@ +--- +output: github_document +--- + + + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + fig.path = "man/figures/README-", + out.width = "100%" +) +``` + +# AVSDevR.HTMLUtils + + + + +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") +``` \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..5e364f4 --- /dev/null +++ b/README.md @@ -0,0 +1,26 @@ + + + +# AVSDevR.HTMLUtils + + + + +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") +``` diff --git a/man/htmlAddBoxAttributes.Rd b/man/htmlAddBoxAttributes.Rd new file mode 100644 index 0000000..713c26e --- /dev/null +++ b/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") +} diff --git a/man/htmlAddBoxRegionFromTitle.Rd b/man/htmlAddBoxRegionFromTitle.Rd new file mode 100644 index 0000000..7c6c45f --- /dev/null +++ b/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) +} diff --git a/man/htmlDisableAutocomplete.Rd b/man/htmlDisableAutocomplete.Rd new file mode 100644 index 0000000..0226bf7 --- /dev/null +++ b/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) +} diff --git a/man/htmlFixBoxCollapseButtonAria.Rd b/man/htmlFixBoxCollapseButtonAria.Rd new file mode 100644 index 0000000..6ce5355 --- /dev/null +++ b/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) +} diff --git a/man/htmlMarkOptional.Rd b/man/htmlMarkOptional.Rd new file mode 100644 index 0000000..a770ce5 --- /dev/null +++ b/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) +} diff --git a/man/htmlMarkRequired.Rd b/man/htmlMarkRequired.Rd new file mode 100644 index 0000000..181a17c --- /dev/null +++ b/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) +} diff --git a/man/htmlRemoveAttributes.Rd b/man/htmlRemoveAttributes.Rd new file mode 100644 index 0000000..f4210e4 --- /dev/null +++ b/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") +} diff --git a/man/htmlReplaceBoxTitleLevel.Rd b/man/htmlReplaceBoxTitleLevel.Rd new file mode 100644 index 0000000..92cca1b --- /dev/null +++ b/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) +} diff --git a/man/htmlSetMaxLength.Rd b/man/htmlSetMaxLength.Rd new file mode 100644 index 0000000..f60119a --- /dev/null +++ b/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) +} diff --git a/man/htmlSetMinLength.Rd b/man/htmlSetMinLength.Rd new file mode 100644 index 0000000..16a66d0 --- /dev/null +++ b/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) +} diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..07b1ab0 --- /dev/null +++ b/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") diff --git a/tests/testthat/test-htmlMarkRequired.R b/tests/testthat/test-htmlMarkRequired.R new file mode 100644 index 0000000..c4e2971 --- /dev/null +++ b/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 <- "
\n
\n \n
\n
" + 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 <- "
\n \n
\n
\n \n
\n
\n \n
\n
\n
" + expect_equal(as.character(htmlMarkRequired(x)), y) +}) + +test_that("required date input", { + x <- shiny::dateInput("input_id", "Some date input") + y <- "
\n \n \n
" + expect_equal(as.character(htmlMarkRequired(x)), y) +}) + +test_that("required date range input", { + x <- shiny::dateRangeInput("input_id", "Some date range input") + y <- "
\n \n
\n \n \n to \n \n \n
\n
" + expect_equal(as.character(htmlMarkRequired(x)), y) +}) + +test_that("required file input", { + x <- shiny::fileInput("input_id", "Some file input") + y <- "
\n \n
\n \n \n
\n
\n
\n
\n
" + expect_equal(as.character(htmlMarkRequired(x)), y) +}) + +test_that("required numeric input", { + x <- shiny::numericInput("input_id", "Some numeric input", 0) + y <- "
\n \n \n
" + 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 <- "
\n \n
\n
\n \n
\n
\n \n
\n
\n
" + expect_equal(as.character(htmlMarkRequired(x)), y) +}) + +test_that("required text input", { + x <- shiny::textInput("input_id", "Some text input") + y <- "
\n \n \n
" + expect_equal(as.character(htmlMarkRequired(x)), y) +}) diff --git a/tests/testthat/test-htmlRemoveAttributes.R b/tests/testthat/test-htmlRemoveAttributes.R new file mode 100644 index 0000000..d7e1f85 --- /dev/null +++ b/tests/testthat/test-htmlRemoveAttributes.R @@ -0,0 +1,13 @@ +test_that("remove existing attribute", { + x <- shiny::icon("wrench") + y <- "" + 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) + ) +}) diff --git a/tests/testthat/test-htmlSetXLength.R b/tests/testthat/test-htmlSetXLength.R new file mode 100644 index 0000000..ce87604 --- /dev/null +++ b/tests/testthat/test-htmlSetXLength.R @@ -0,0 +1,47 @@ +test_that("maximum length password input", { + x <- shiny::passwordInput("input_id", "Some password input") + y <- "
\n \n \n
" + expect_equal(as.character(htmlSetMaxLength(x, 50)), y) +}) +test_that("minimum length password input", { + x <- shiny::passwordInput("input_id", "Some password input") + y <- "
\n \n \n
" + expect_equal(as.character(htmlSetMinLength(x, 3)), y) +}) +test_that("min/max length password input", { + x <- shiny::passwordInput("input_id", "Some password input") + y <- "
\n \n \n
" + 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 <- "
\n \n \n
" + expect_equal(as.character(htmlSetMaxLength(x, 50)), y) +}) +test_that("minimum length text input", { + x <- shiny::textInput("input_id", "Some text input") + y <- "
\n \n \n
" + expect_equal(as.character(htmlSetMinLength(x, 3)), y) +}) +test_that("min/max length text input", { + x <- shiny::textInput("input_id", "Some text input") + y <- "
\n \n \n
" + 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 <- "
\n \n \n
" + expect_equal(as.character(htmlSetMaxLength(x, 500)), y) +}) +test_that("minimum length textarea input", { + x <- shiny::textAreaInput("input_id", "Some textarea input") + y <- "
\n \n \n
" + expect_equal(as.character(htmlSetMinLength(x, 50)), y) +}) +test_that("min/max length textarea input", { + x <- shiny::textAreaInput("input_id", "Some textarea input") + y <- "
\n \n \n
" + expect_equal(as.character(htmlSetMaxLength(htmlSetMinLength(x, 50), 500)), y) +})