extend messaging to account for >2 classes

Author: timcadman

NAMESPACE

@@ -26,6 +26,7 @@ export(checkNegValueDS)
 export(checkPermissivePrivacyControlLevel)
 export(classDS)
 export(colnamesDS)
+export(colnamesDS2)
 export(completeCasesDS)
 export(corDS)
 export(corTestDS)

R/utils.R

@@ -8,7 +8,7 @@
 #' @noRd
 .loadServersideObject <- function(x) {
   tryCatch(
-    get(x, envir = parent.frame(2)), 
+    get(x, envir = parent.frame(2)),
     error = function(e) {
       stop("The server-side object", " '", x, "' ", "does not exist")
     }
@@ -28,15 +28,15 @@
 #' @noRd
 .checkClass <- function(obj, obj_name, permitted_classes) {
   typ <- class(obj)
-  
+
   if (!any(permitted_classes %in% typ)) {
     msg <- glue(
-      "The server-side object must be of type {glue_collapse(permitted_classes, sep = ' or ')}. ",
-      "'{obj_name}' is type {typ}."
+      "The server-side object must be of type {glue_collapse(permitted_classes, sep = ', ', last = ' or ')}. ",
+      "'{obj_name}' is type {glue_collapse(typ, sep = ', ', last = ' and ')}."
     )
-    
+
     stop(msg, call. = FALSE)
   }
-  
+
   invisible(TRUE)
 }

tests/testthat/test-smk-utils.R

@@ -41,11 +41,27 @@ test_that(".checkClass() passes for correct class", {
   )
 })
 
-test_that(".checkClass() throws informative error for wrong class", {
+test_that(".checkClass() throws informative error for wrong class with one target class", {
   x <- list(a = 1)
   expect_error(
-    .checkClass(x, "x", c("data.frame", "matrix")),
-    regexp = "must be of type data.frame or matrix"
+    .checkClass(x, "x", "data.frame"),
+    regexp = "The server-side object must be of type data.frame. 'x' is type list."
+  )
+})
+
+test_that(".checkClass() throws informative error for wrong class with three target classes", {
+  x <- list(a = 1)
+  expect_error(
+    .checkClass(x, "x", c("data.frame", "matrix", "unicorn")),
+    regexp = "The server-side object must be of type data.frame, matrix or unicorn. 'x' is type list."
+  )
+})
+
+test_that(".checkClass() throws informative error for three target classes and three actual classes", {
+  x <- tibble(a = 1)
+  expect_error(
+    .checkClass(x, "x", c("Boolean", "unicorn", "donkey")),
+    regexp = "The server-side object must be of type Boolean, unicorn or donkey. 'x' is type tbl_df, tbl and data.frame."
   )
 })