Issue 625 unit tests golem utils UI

NAMESPACE

@@ -72,6 +72,7 @@ export(use_module_test)
 export(use_recommended_deps)
 export(use_recommended_tests)
 export(use_utils_server)
+export(use_utils_test_ui)
 export(use_utils_ui)
 export(warning_dev)
 export(with_golem_options)

R/use_utils.R

@@ -1,5 +1,5 @@
 #' Use the utils files
-#' 
+#'
 #' \describe{
 #'   \item{use_utils_ui}{Copies the golem_utils_ui.R to the R folder.}
 #'   \item{use_utils_server}{Copies the golem_utils_server.R to the R folder.}
@@ -9,58 +9,89 @@
 #'
 #' @export
 #' @rdname utils_files
-#' 
+#'
 #' @importFrom cli cat_bullet
 #' @importFrom utils capture.output
-#' 
+#' @importFrom usethis use_testthat
+#'
 #' @return Used for side-effects.
-use_utils_ui <- function(
-  pkg = get_golem_wd()
-){
+use_utils_ui <- function(pkg = get_golem_wd(),
+                         with_test = FALSE) {
   added <- use_utils(
-    file_name = "golem_utils_ui.R", 
+    file_name = "golem_utils_ui.R",
+    folder_name = "R",
     pkg = pkg
   )
-  
-  if (added){
+
+  if (added) {
     cat_green_tick("Utils UI added")
+
+    if (with_test) {
+      if (!isTRUE(dir.exists("tests"))) {
+        use_testthat()
+      }
+      pth <- path(
+        pkg, "tests", "testthat", "test-golem_utils_ui.R"
+      )
+      if (
+        file.exists(pth)
+      ) {
+        file_already_there_dance(
+          where = pth,
+          open = FALSE
+        )
+      } else {
+        use_utils_test_ui()
+      }
+    }
   }
 }
+
 #' @export
 #' @rdname utils_files
-use_utils_server <- function(
-  pkg = get_golem_wd()
-){
+use_utils_test_ui <- function(pkg = get_golem_wd()) {
   added <- use_utils(
-    file_name = "golem_utils_server.R", 
+    file_name = "test-golem_utils_ui.R",
+    folder_name = "tests/testthat",
     pkg = pkg
   )
-  if (added){
+
+  if (added) {
+    cat_green_tick("Tests on utils UI added")
+  }
+}
+
+#' @export
+#' @rdname utils_files
+use_utils_server <- function(pkg = get_golem_wd()) {
+  added <- use_utils(
+    file_name = "golem_utils_server.R",
+    folder_name = "R",
+    pkg = pkg
+  )
+  if (added) {
     cat_green_tick("Utils server added")
   }
-} 
+}
 
 #' @importFrom fs file_copy path_abs path_file
-use_utils <- function(
-  file_name, 
-  pkg = get_golem_wd()
-){
+use_utils <- function(file_name,
+                      folder_name,
+                      pkg = get_golem_wd()) {
   old <- setwd(
     path_abs(pkg)
   )
-  on.exit( setwd(old) )
-  where <- path(path_abs(pkg), "R", file_name)
-  if (file_exists(where)){
+  on.exit(setwd(old))
+  where <- path(path_abs(pkg), folder_name, file_name)
+  if (file_exists(where)) {
     cat_exists(where)
     return(FALSE)
   } else {
     file_copy(
-      path = golem_sys("utils", file_name), 
+      path = golem_sys("utils", file_name),
       new_path = where
     )
     cat_created(where)
     return(TRUE)
   }
-
-} 
-
+}

inst/mantests/build.R

@@ -291,10 +291,23 @@ expect_true(
 
 golem::use_recommended_deps()
 
+golem::use_utils_ui(with_test = TRUE)
+expect_true(
+  file.exists("R/golem_utils_ui.R")
+)
+expect_true(
+  file.exists("tests/testthat/test-golem_utils_ui.R")
+)
+
+golem::use_utils_server()
+expect_true(
+  file.exists("R/golem_utils_server.R")
+)
+
 cat_ok()
 
 # Going through 02_dev ----
-cli::cat_rule("Going through 01_start.R")
+cli::cat_rule("Going through 02_dev.R")
 
 cli::cat_rule("Testing usepackage")
 if (!requireNamespace("cranlogs")) {

inst/manualtests/script.R

@@ -25,7 +25,7 @@ golem::set_golem_options()
 
 golem::use_recommended_tests()
 golem::use_recommended_deps()
-golem::use_utils_ui()
+golem::use_utils_ui(with_test = TRUE)
 golem::use_utils_server()
 
 golem::add_module(

inst/shinyexample/dev/01_start.R

@@ -55,7 +55,7 @@ golem::use_favicon() # path = "path/to/ico". Can be an online file.
 golem::remove_favicon()
 
 ## Add helper functions ----
-golem::use_utils_ui()
+golem::use_utils_ui(with_test = TRUE)
 golem::use_utils_server()
 
 # You're now set! ----

inst/utils/test-golem_utils_ui.R

@@ -0,0 +1,174 @@
+test_that("Test with_red_star works", {
+    expect_s3_class(with_red_star("golem"), "shiny.tag")
+    expect_equal(
+        as.character(with_red_star("Enter your name here")),
+        '<span>Enter your name here<span style="color:red">*</span></span>'
+    )
+})
+
+test_that("Test list_to_li works", {
+    expect_s3_class(list_to_li(c("a", "b")), "shiny.tag.list")
+    expect_equal(
+        as.character(list_to_li(c("a", "b"))),
+        "<li>a</li>\n<li>b</li>"
+    )
+    expect_equal(
+        as.character(list_to_li(c("a", "b"), class = "my_li")),
+        '<li class="my_li">a</li>\n<li class="my_li">b</li>'
+    )
+})
+
+test_that("Test list_to_p works", {
+    expect_s3_class(
+        list_to_p(c(
+            "This is the first paragraph",
+            "this is the second paragraph"
+        )),
+        "shiny.tag.list"
+    )
+    expect_equal(
+        as.character(
+            list_to_p(c(
+                "This is the first paragraph",
+                "this is the second paragraph"
+            ))
+        ),
+        "<p>This is the first paragraph</p>\n<p>this is the second paragraph</p>"
+    )
+    expect_equal(
+        as.character(
+            list_to_p(c(
+                "This is the first paragraph",
+                "this is the second paragraph"
+            ), class = "my_li")
+        ),
+        '<p class="my_li">This is the first paragraph</p>\n<p class="my_li">this is the second paragraph</p>'
+    )
+})
+
+test_that("Test named_to_li works", {
+    expect_s3_class(named_to_li(list(a = "a", b = "b")), "shiny.tag.list")
+    expect_equal(
+        as.character(named_to_li(list(a = "a", b = "b"))),
+        "<li><b>a:</b> a</li>\n<li><b>b:</b> b</li>"
+    )
+    expect_equal(
+        as.character(named_to_li(list(a = "a", b = "b"), class = "mylist")),
+        '<li class="mylist"><b>a:</b> a</li>\n<li class="mylist"><b>b:</b> b</li>'
+    )
+})
+
+test_that("Test tagRemoveAttributes works", {
+    a_with_tag <- shiny::tags$p(src = "plop", "pouet")
+    expect_s3_class(a_with_tag, "shiny.tag")
+    expect_equal(
+        as.character(a_with_tag),
+        '<p src="plop">pouet</p>'
+    )
+
+    a_without_tag <- tagRemoveAttributes(a_with_tag, "src")
+    expect_s3_class(a_without_tag, "shiny.tag")
+    expect_equal(
+        as.character(a_without_tag),
+        "<p>pouet</p>"
+    )
+})
+
+test_that("Test undisplay works", {
+    a <- shiny::tags$p(src = "plop", "pouet")
+    expect_s3_class(a, "shiny.tag")
+    expect_equal(
+        as.character(a),
+        '<p src="plop">pouet</p>'
+    )
+    a_undisplay <- undisplay(a)
+    expect_s3_class(a_undisplay, "shiny.tag")
+    expect_equal(
+        as.character(a_undisplay),
+        '<p src="plop" style="display: none;">pouet</p>'
+    )
+
+    b <- shiny::actionButton("go_filter", "go")
+    expect_s3_class(b, "shiny.tag")
+    expect_equal(
+        as.character(b),
+        '<button id="go_filter" type="button" class="btn btn-default action-button">go</button>'
+    )
+    b_undisplay <- undisplay(b)
+    expect_s3_class(b, "shiny.tag")
+    expect_equal(
+        as.character(b_undisplay),
+        '<button id="go_filter" type="button" class="btn btn-default action-button" style="display: none;">go</button>'
+    )
+})
+
+test_that("Test display works", {
+    a_undisplay <- shiny::tags$p(src = "plop", "pouet", style = "display: none;")
+    expect_s3_class(a_undisplay, "shiny.tag")
+    expect_equal(
+        as.character(a_undisplay),
+        '<p src="plop" style="display: none;">pouet</p>'
+    )
+    a_display <- display(a_undisplay)
+    expect_s3_class(a_display, "shiny.tag")
+    expect_equal(
+        as.character(a_display),
+        '<p src="plop" style="">pouet</p>'
+    )
+})
+
+test_that("Test jq_hide works", {
+    expect_s3_class(jq_hide("golem"), "shiny.tag")
+    expect_equal(
+        as.character(jq_hide("golem")),
+        "<script>$('#golem').hide()</script>"
+    )
+})
+
+test_that("Test rep_br works", {
+    expect_s3_class(rep_br(5), "html")
+    expect_equal(
+        as.character(rep_br(5)),
+        "<br/> <br/> <br/> <br/> <br/>"
+    )
+})
+
+test_that("Test enurl works", {
+    expect_s3_class(enurl("https://www.thinkr.fr", "ThinkR"), "shiny.tag")
+    expect_equal(
+        as.character(enurl("https://www.thinkr.fr", "ThinkR")),
+        '<a href="https://www.thinkr.fr">ThinkR</a>'
+    )
+})
+
+test_that("Test columns wrappers works", {
+    expect_s3_class(col_12(), "shiny.tag")
+    expect_s3_class(col_10(), "shiny.tag")
+    expect_s3_class(col_8(), "shiny.tag")
+    expect_s3_class(col_6(), "shiny.tag")
+    expect_s3_class(col_4(), "shiny.tag")
+    expect_s3_class(col_3(), "shiny.tag")
+    expect_s3_class(col_2(), "shiny.tag")
+    expect_s3_class(col_1(), "shiny.tag")
+
+    expect_equal(as.character(col_12()), '<div class="col-sm-12"></div>')
+    expect_equal(as.character(col_10()), '<div class="col-sm-10"></div>')
+    expect_equal(as.character(col_8()), '<div class="col-sm-8"></div>')
+    expect_equal(as.character(col_6()), '<div class="col-sm-6"></div>')
+    expect_equal(as.character(col_4()), '<div class="col-sm-4"></div>')
+    expect_equal(as.character(col_3()), '<div class="col-sm-3"></div>')
+    expect_equal(as.character(col_2()), '<div class="col-sm-2"></div>')
+    expect_equal(as.character(col_1()), '<div class="col-sm-1"></div>')
+})
+
+test_that("Test make_action_button works", {
+    button <- make_action_button(
+        a(href = "#", "My super link", style = "color: lightblue;"),
+        inputId = "mylink"
+    )
+    expect_s3_class(button, "shiny.tag")
+    expect_equal(
+        as.character(button),
+        '<a href="#" style="color: lightblue;" id="mylink" class="action-button">My super link</a>'
+    )
+})