fix: R CMD check and small improvements

R/utils.R

@@ -66,23 +66,20 @@ make_c_call <- function(choices) {
 #' JavaScript and Shiny.
 #'
 #' When the id has a character that is not allowed, it is replaced with `"_"`
-#' and a hash of the original id is added to the beginning of the id.
+#' and a 4 character hash of the original id is added to the start of the
+#' resulting id.
+#'
 #'
 #' @param id (`character(1)`) The id string.
 #'
 #' @return Sanitized string that removes special characters and spaces.
 #'
 #' @keywords internal
 sanitize_id <- function(id) {
-  # Left square bracket needs to be first in the pattern to avoid errors with pattern
-  pattern_escape <- "[] !\"#$%&'()*+,./:;<=>?@[\\^`{|}~]"
+  pattern_escape <- "[^0-9A-Za-z_]"
 
   id_new <- gsub(pattern_escape, "_", id)
-  hashes <- vapply(
-    id[id != id_new],
-    rlang::hash, character(1),
-    USE.NAMES = FALSE
-  )
+  hashes <- vapply(id[id != id_new], rlang::hash, character(1), USE.NAMES = FALSE)
 
   id[id != id_new] <- paste0("h", substr(hashes, 1, 4), "_", id_new[id != id_new])
   id

tests/testthat/test-utils.R

@@ -8,7 +8,7 @@ testthat::test_that("make_c_call", {
 testthat::describe("sanitize_id", {
   testthat::it("should replace dots with `_` when id is otherwise valid", {
     id <- "a.b"
-    ns <- NS("app")
+    ns <- teal.slice:::NS("app")
     testthat::expect_identical(
       ns(id),
       paste0("app-h", substr(rlang::hash(id), 1, 4), "_a_b")
@@ -17,7 +17,7 @@ testthat::describe("sanitize_id", {
 
   testthat::it("should take vector input", {
     id <- c("a.b", "a", "b", " c")
-    ns <- NS("app")
+    ns <- teal.slice:::NS("app")
     testthat::expect_identical(
       ns(id),
       c(
@@ -31,7 +31,7 @@ testthat::describe("sanitize_id", {
 
   testthat::it("should allow for integer input", {
     id <- c(1L, 2L, 3L)
-    ns <- NS("app")
+    ns <- teal.slice:::NS("app")
     testthat::expect_identical(
       ns(id),
       c("app-1", "app-2", "app-3")
@@ -40,19 +40,20 @@ testthat::describe("sanitize_id", {
 
   testthat::it("should replace non-ASCII characters in middle of id with `_`", {
     id <- "a$b"
-    ns <- NS("app")
+    ns <- teal.slice:::NS("app")
     testthat::expect_identical(
       ns(id),
       paste0("app-h", substr(rlang::hash(id), 1, 4), "_a_b")
     )
   })
 
+  # Test using moduleServer to access the sanitized id
   testthat::it("should replace non-ASCII characters in the start/end of id with `_`", {
     id <- "%a bad symbol$"
     id2 <- "a&b#"
     id_from_module <- shiny::withReactiveDomain(
       MockShinySession$new(),
-      moduleServer(id, function(input, output, session) session$ns("a_good_name"))
+      teal.slice:::moduleServer(id, function(input, output, session) session$ns("a_good_name"))
     )
 
     testthat::expect_identical(
@@ -64,20 +65,32 @@ testthat::describe("sanitize_id", {
   testthat::it("should replace all quotes characters with `_`", {
     id <- " a.b.c\"d`e'j"
     testthat::expect_identical(
-      NS("app", id),
+      teal.slice:::NS("app", id),
       paste0("app-h", substr(rlang::hash(id), 1, 4), "__a_b_c_d_e_j")
     )
   })
 
   testthat::it("should replace all escape characters from JQuery selectors", {
     forbidden <- " !\"#$%&'()*+,./:;<=>?@[\\]^`{|}~]"
     testthat::expect_identical(
-      NS("app", forbidden),
+      teal.slice:::NS("app", forbidden),
       paste0(
         "app-h",
         substr(rlang::hash(forbidden), 1, 4),
         paste(rep("_", nchar(forbidden) + 1), collapse = "")
       )
     )
   })
+
+  testthat::it("should replace UTF characters outside the allowed range", {
+    id <- "\U41\U05E\U30\U5F\U7A\U1F4AA" # "A:circumflex_accent:0_z:flexed_biceps:
+    testthat::expect_identical(
+      teal.slice:::NS("app", id),
+      paste0(
+        "app-h",
+        substr(rlang::hash(id), 1, 4),
+        "_A_0_z_"
+      )
+    )
+  })
 })