From 91f257694e23a6423a6ea555ed3e3b91f4fde334 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?=
 <211358+averissimo@users.noreply.github.com>
Date: Thu, 24 Oct 2024 17:41:20 +0100
Subject: [PATCH] fix: allow for vector inputs and integers

---
 R/utils.R                   | 25 ++++++++++++++---------
 tests/testthat/test-utils.R | 40 +++++++++++++++++++++++++++++--------
 2 files changed, 48 insertions(+), 17 deletions(-)

diff --git a/R/utils.R b/R/utils.R
index ad2209818..bed69aa6e 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -74,15 +74,22 @@ make_c_call <- function(choices) {
 #'
 #' @keywords internal
 sanitize_id <- function(id) {
-  id_converted <- make.names(id)
-  if (identical(make.names(id), id)) {
-    return(gsub("\\.", "_", id))
-  }
-  id_converted <- gsub("\\.", "_", id_converted)
-  if (!grepl("^X", id)) {
-    id_converted <- gsub("^X", "", id_converted)
-  }
-  paste0("h", substr(rlang::hash(as.character(id)), 1, 4), "_", id_converted)
+  escape_characters <- " !\"#$%&'()*+,./:;<=>?@[\\]^`{|}~"
+  pattern <- paste(
+    sep = "", collapse = "|", "\\", strsplit(escape_characters, "")[[1]]
+  )
+  pattern <- gsub("\\<", "<", pattern, fixed = TRUE)
+  pattern <- gsub("\\>", ">", pattern, fixed = TRUE)
+
+  id_new <- gsub(pattern, "_", id)
+  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
 }
 
 #' `NS` wrapper to sanitize ids for shiny
diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
index 8c67d60b9..63b83d65b 100644
--- a/tests/testthat/test-utils.R
+++ b/tests/testthat/test-utils.R
@@ -6,6 +6,38 @@ testthat::test_that("make_c_call", {
 
 # sanitize_id ----
 testthat::describe("sanitize_id", {
+  testthat::it("should replace dots with `_` when id is otherwise valid", {
+    id <- "a.b"
+    ns <- NS("app")
+    testthat::expect_identical(
+      ns(id),
+      paste0("app-h", substr(rlang::hash(id), 1, 4), "_a_b")
+    )
+  })
+
+  testthat::it("should take vector input", {
+    id <- c("a.b", "a", "b", " c")
+    ns <- NS("app")
+    testthat::expect_identical(
+      ns(id),
+      c(
+        paste0("app-h", substr(rlang::hash(id[1]), 1, 4), "_a_b"),
+        "app-a",
+        "app-b",
+        paste0("app-h", substr(rlang::hash(id[4]), 1, 4), "__c")
+      )
+    )
+  })
+
+  testthat::it("should allow for integer input", {
+    id <- c(1L, 2L, 3L)
+    ns <- NS("app")
+    testthat::expect_identical(
+      ns(id),
+      c("app-1", "app-2", "app-3")
+    )
+  })
+
   testthat::it("should replace non-ASCII characters in middle of id with `_`", {
     id <- "a$b"
     ns <- NS("app")
@@ -37,14 +69,6 @@ testthat::describe("sanitize_id", {
     )
   })
 
-  testthat::it("should replace UTF-8 special characters with `_`", {
-    id <- "a\U1F643"
-    testthat::expect_identical(
-      NS("app", id),
-      paste0("app-h", substr(rlang::hash(id), 1, 4), "_a_")
-    )
-  })
-
   testthat::it("should replace all escape characters from JQuery selectors", {
     forbidden <- " !\"#$%&'()*+,./:;<=>?@[\\]^`{|}~]"
     testthat::expect_identical(