Add external link function and bad link text examples (#46)

* WIP with todo markers

* more todo's before I forget

* finish off external link function

* add no whitespace after option

* Increment version number to 0.4.0

* cracked the links issue in documentation

* add full stop error, whitespace trimming, short text warning and extra examples

.Rbuildignore

@@ -7,3 +7,4 @@
 ^docs$
 ^pkgdown$
 ^.lintr$
+^data-raw$

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: dfeshiny
 Title: DfE R-Shiny Standards
-Version: 0.3.0
+Version: 0.4.0
 Authors@R: c(
     person("Rich", "Bielby", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-9070-9969")),
@@ -35,3 +35,6 @@ RoxygenNote: 7.3.2
 URL: https://dfe-analytical-services.github.io/dfeshiny/
      https://www.github.com/dfe-analytical-services/dfeshiny/
 VignetteBuilder: knitr
+Depends: 
+    R (>= 2.10)
+LazyData: true

NAMESPACE

@@ -6,6 +6,7 @@ export(cookies_panel_server)
 export(cookies_panel_ui)
 export(custom_disconnect_message)
 export(dfe_cookies_script)
+export(external_link)
 export(init_analytics)
 export(init_cookies)
 export(support_panel)

NEWS.md

@@ -1,3 +1,7 @@
+# dfeshiny 0.4.0
+
+* Add new `external_link()` function and look up data for `bad_link_text`.
+
 # dfeshiny 0.3.0
 
 ## New features

R/data-bad_link_text.R

@@ -0,0 +1,17 @@
+#' Lookup for bad link text
+#'
+#' A single column data frame, listing out known examples of bad link text that
+#' check for in the `external_link()` function.
+#'
+#' We've started curating this list so we can create automated checks to help
+#' all link text to be as descriptive as possible in line with
+#' [WCAG 2.2 success criteria 2.4.4: Link Purpose (In Context)](
+#' https://www.w3.org/WAI/WCAG22/Understanding/link-purpose-in-context).
+#'
+#' @format ## `bad_link_text`
+#' A data frame with 52 rows and 1 columns:
+#' \describe{
+#'   \item{bad_link_text}{Lower cased examples of non-descriptive link text}
+#' }
+#' @source Curated by explore.statistics@@education.gov.uk
+"bad_link_text"

R/external_link.R

@@ -0,0 +1,129 @@
+#' External link
+#'
+#' Intentionally basic wrapper for html anchor elements making it easier to
+#' create safe external links with standard and accessible behaviour. For more
+#' information on how the tag is generated, see \code{\link[htmltools]{tags}}.
+#'
+#' @description
+#' It is commonplace for external links to open in a new tab, and when we do
+#' this we should be careful...
+#'
+#' This function automatically adds the following to your link:
+#' * `target="_blank"` to open in new tab
+#' * `rel="noopener noreferrer"` to prevent [reverse tabnabbing](
+#' https://owasp.org/www-community/attacks/Reverse_Tabnabbing)
+#'
+#' By default this function also adds "(opens in new tab)" to your link text
+#' to warn users of the behaviour.
+#'
+#' This also adds "This link opens in a new tab" as a visually hidden span
+#' element within the html outputted to warn non-visual users of the behaviour.
+#'
+#' The function will error if you end with a full stop, give a warning for
+#' particularly short link text and will automatically trim any leading or
+#' trailing white space inputted into link_text.
+#'
+#' Related links and guidance:
+#'
+#' * [Government digital services guidelines on the use of links](
+#' https://design-system.service.gov.uk/styles/links/)
+#'
+#' * [Anchor tag html element and its properties](
+#' https://developer.mozilla.org/en-US/docs/Web/HTML/Element/a)
+#'
+#' * [WCAG 2.2 success criteria 2.4.4: Link Purpose (In Context)](
+#' https://www.w3.org/WAI/WCAG22/Understanding/link-purpose-in-context)
+#'
+#' * [Web Accessibility standards link text behaviour](
+#' https://www.w3.org/TR/WCAG20-TECHS/G200.html)
+#'
+#' @param href URL that you want the link to point to
+#' @param link_text Text that will appear describing your link, must be
+#' descriptive of the page you are linking to. Vague text like 'click here' or
+#' 'here' will cause an error, as will ending in a full stop. Leading and
+#' trailing white space will be automatically trimmed. If the string is shorter
+#' than 7 characters a console warning will be thrown. There is no way to hush
+#' this other than providing more detail.
+#' @param add_warning Boolean for adding "(opens in new tab)" at the end of the
+#' link text to warn users of the behaviour. Be careful and consider
+#' accessibility before removing the visual warning.
+#' @return shiny.tag object
+#' @export
+#'
+#' @examples
+#' external_link("https://shiny.posit.co/", "R Shiny")
+#'
+#' external_link(
+#'   "https://shiny.posit.co/",
+#'   "R Shiny",
+#'   add_warning = FALSE
+#' )
+external_link <- function(href, link_text, add_warning = TRUE) {
+  if (!is.logical(add_warning)) {
+    stop("add_warning must be a TRUE or FALSE value")
+  }
+
+  # Trim whitespace as I don't trust humans not to accidentally include
+  link_text <- stringr::str_trim(link_text)
+
+  # Create a basic check for raw URLs
+  is_url <- function(text) {
+    url_pattern <- "^(https://|http://|www\\.)"
+    grepl(url_pattern, text)
+  }
+
+  # Check for vague link text on our list
+  if (is_url(link_text)) {
+    stop(paste0(
+      link_text,
+      " has been recognised as a raw URL, please change the link_text value",
+      "to a description of the page being linked to instead"
+    ))
+  }
+
+  # Check against curated data set for link text we should banish into room 101
+  if (tolower(link_text) %in% dfeshiny::bad_link_text$bad_link_text) {
+    stop(
+      paste0(
+        link_text,
+        " is not descriptive enough and has has been recognised as bad link",
+        " text, please replace the link_text argument with more descriptive",
+        " text."
+      )
+    )
+  }
+
+  # Check if link text ends in a full stop
+  if (grepl("\\.$", link_text)) {
+    stop("link_text should not end with a full stop")
+  }
+
+  # Give a console warning if link text is under 7 characters
+  # Arbritary number that allows for R Shiny to be link text without a warning
+  if (nchar(link_text) < 7) {
+    warning(paste0(
+      "the link_text: ", link_text, ", is shorter than 7 characters, this is",
+      " unlikely to be descriptive for users, consider having more detailed",
+      " link text"
+    ))
+  }
+
+  # Assuming all else has passed, make the link text a nice accessible link
+  if (add_warning) {
+    link_text <- paste(link_text, "(opens in new tab)")
+    hidden_span <- NULL # don't have extra hidden text if clear in main text
+  } else {
+    hidden_span <-
+      htmltools::span(class = "visually-hidden", "This link opens in a new tab")
+  }
+
+  # Create link using htmltools::tags$a
+  htmltools::tags$a(
+    hidden_span,
+    href = href,
+    link_text,
+    target = "_blank",
+    rel = "noopener noreferrer",
+    .noWS = "after"
+  )
+}

_pkgdown.yml

@@ -6,19 +6,23 @@ template:
     pkgdown-nav-height: 81.4468px
 
 reference:
-- title: Maintenance
-  contents:
-  - tidy_code
 - title: Cookies
   contents:
   - has_concept("cookies")
-- title: Standard panels
-  contents:
-  - support_panel
 - title: Connectivity
   contents:
   - custom_disconnect_message
 - title: Initialisation functions
   desc: One time functions used to set up or update standardised scripts and workflows needed for your dashboard
   contents:
   - starts_with("init")
+- title: Links
+  contents:
+  - external_link
+  - bad_link_text
+- title: Maintenance
+  contents:
+  - tidy_code
+- title: Standard panels
+  contents:
+  - support_panel

data-raw/bad_link_text.R

@@ -0,0 +1,17 @@
+bad_link_text <- data.frame(
+  bad_link_text = c(
+    # one word examples
+    "click", "csv", "continue", "dashboard", "document", "download", "file",
+    "form", "guidance", "here", "info", "information", "jpeg", "jpg", "learn",
+    "link", "more", "next", "page", "pdf", "previous", "read", "site", "svg",
+    "this", "web", "webpage", "website", "word", "xslx",
+    # two word examples
+    "click here", "click this link", "download csv", "download document",
+    "download file", "download here", "download jpg", "download jpeg",
+    "download pdf", "download png", "download svg", "download word",
+    "download xslx", "further information", "go here", "learn more",
+    "link to", "read more", "this page", "visit this", "web page", "web site"
+  )
+)
+
+usethis::use_data(bad_link_text, overwrite = TRUE)

tests/testthat/test-data-bad_link_text.R

@@ -0,0 +1,24 @@
+test_that("Returns data frame", {
+  expect_true(is.data.frame(dfeshiny::bad_link_text))
+})
+
+test_that("Matches description", {
+  # If this test fails, update the notes in R/data-bad_link_text.R
+  expect_equal(nrow(dfeshiny::bad_link_text), 52)
+  expect_equal(names(dfeshiny::bad_link_text), "bad_link_text")
+})
+
+test_that("All are string values", {
+  expect_true(all(sapply(dfeshiny::bad_link_text$bad_link_text, is.character)))
+})
+
+test_that("Is all lower case", {
+  expect_true(all(
+    dfeshiny::bad_link_text$bad_link_text ==
+      tolower(dfeshiny::bad_link_text$bad_link_text)
+  ))
+})
+
+test_that("There are no duplicates", {
+  expect_true(!anyDuplicated(dfeshiny::bad_link_text))
+})