diff --git a/R/module2app.R b/R/module2app.R index 30f58c3..727bcec 100644 --- a/R/module2app.R +++ b/R/module2app.R @@ -18,6 +18,11 @@ #' #' See [mixed_react_tree()] for details on the shown input and return values. #' +#' If you are testing screenshots, +#' you are recommended to use [get_screenshot_args_attr()] +#' to screenshot only your actual module UI, +#' without the surrounding *niffler* boilerplate. +#' #' @param module_ui,module_server #' Module functions. #' @param ui_args,server_args @@ -35,12 +40,20 @@ module2app <- function(module_ui = NULL, ui_wrapper = shiny::basicPage, options = list(test.mode = TRUE), ...) { - shiny::shinyApp( + res <- shiny::shinyApp( ui = module2app_ui(module_ui, ui_args, ui_wrapper = ui_wrapper), server = module2app_server(module_server, server_args), options = options, ... ) + attributes(res) <- c( + attributes(res), + list( + niffler_screenshot_args = list( + selector = paste0("#", inner_module_id) + )) + ) + res } #' @describeIn module2app UI @@ -65,12 +78,17 @@ module2app_ui <- function(module_ui = NULL, shiny::h2("Server Input Arguments"), mixed_react_tree_ui("inputs"), shiny::h2("Module UI"), - module_ui(id = "test_object"), + shiny::div( + module_ui(id = "test_object"), + id = inner_module_id + ), shiny::h2("Server Return Values"), mixed_react_tree_ui("returns") ) } +inner_module_id <- "niffler-module2app-module-ui" + #' @describeIn module2app Server #' @export module2app_server <- function(module_server = NULL, server_args = list()) { @@ -348,3 +366,42 @@ x_counter_button_server <- function(id, set_to = 2L, deep = FALSE) { } ) } + +# ==== helpers + +#' Retrieve `niffler_screenshot_args` attribute with screenshot settings +#' +#' An app may require special settings for a good screenshot. +#' For example, you would usually only be interested in the Module UI +#' part of apps created by [module2app()]. +#' [module2app()] supports this by setting the correct DOM selector +#' and exposing it via the `niffler_screenshot_args`. +#' +#' @details +#' The `niffler_screenshot_args` attribute can be set on whatever +#' object you pass to `appDir`. +#' It should be a list passable to the `screenshot_args` argument of [`shinytest2::AppDriver`]'s `$new()` method. +#' You *can* set all sorts of screenshot behavior that way, +#' but same of these settings may break functionality in niffler. +#' It is known to work for DOM selection. +#' @return +#' A list for the `screenshot_args` argument +#' of [`shinytest2::AppDriver`]'s `$new()` method. +#' If no attribute is found, +#' returns [rlang::missing_arg()], to keep shinytest2 +#' defaults intact. +#' @inheritParams shiny::runApp +#' @keywords module helpers +#' @keywords screenshot helpers +get_screenshot_args_attr <- function(appDir) { + if (has_niffler_attrs(appDir)) { + res <- attr(appDir, which = "niffler_screenshot_args") + res <- checkmate::assert_list(res) + } else { + return(rlang::missing_arg()) + } +} + +has_niffler_attrs <- function(appDir) { + "niffler_screenshot_args" %in% names(attributes(appDir)) +} diff --git a/R/shiny2screenshot.R b/R/shiny2screenshot.R index e8c8ca4..c14ff5a 100644 --- a/R/shiny2screenshot.R +++ b/R/shiny2screenshot.R @@ -77,6 +77,8 @@ check_installed_shinytest2 <- function() { #' To show interactions with an app, use a different function. #' #' @inheritParams shiny::runApp +#' @param screenshot_args +#' Passed to [`shinytest2::AppDriver`]'s `$new()` method. #' @param name #' If the shiny app is developed inside a package (recommended), #' the name of that package. @@ -103,6 +105,8 @@ check_installed_shinytest2 <- function() { #' @keywords documentation tags #' @export get_screenshot_from_app <- function(appDir, + screenshot_args = + get_screenshot_args_attr(appDir), name = character(1L), file = NULL, strict = FALSE) { @@ -110,6 +114,7 @@ get_screenshot_from_app <- function(appDir, f_screenshot <- purrr::partial( get_screenshot_from_app_strictly, appDir, + screenshot_args = screenshot_args, name = name, file = file ) @@ -129,13 +134,17 @@ get_screenshot_from_app <- function(appDir, f_screenshot() } -get_screenshot_from_app_strictly <- function(appDir, name, file) { +get_screenshot_from_app_strictly <- function(appDir, + screenshot_args, + name, + file) { check_installed_shinytest2() if (name != character(1L)) { elf::assert_pkg_installed_but_not_via_loadall(x = name) } driver <- shinytest2::AppDriver$new( - app_dir = appDir + app_dir = appDir, + screenshot_args = screenshot_args ) withr::defer(driver$stop()) driver$get_screenshot(file = file) diff --git a/inst/examples/shiny2screenshot/example.R b/inst/examples/shiny2screenshot/example.R index 41aab9c..3c38dba 100644 --- a/inst/examples/shiny2screenshot/example.R +++ b/inst/examples/shiny2screenshot/example.R @@ -1,4 +1,4 @@ #' An example documentation for a shiny app #' @nifflerExamplesShiny -#' counter_button_app() +#' hello_app() hello_app <- function() counter_button_app() diff --git a/tests/testthat/_snaps/linux/shiny2screenshot/counter.png b/tests/testthat/_snaps/linux/shiny2screenshot/counter.png index 8b9ea38..3bfbc62 100644 Binary files a/tests/testthat/_snaps/linux/shiny2screenshot/counter.png and b/tests/testthat/_snaps/linux/shiny2screenshot/counter.png differ diff --git a/tests/testthat/_snaps/mac/shiny2screenshot/counter.png b/tests/testthat/_snaps/mac/shiny2screenshot/counter.png index fc3874a..fe79639 100644 Binary files a/tests/testthat/_snaps/mac/shiny2screenshot/counter.png and b/tests/testthat/_snaps/mac/shiny2screenshot/counter.png differ diff --git a/tests/testthat/_snaps/module2app.md b/tests/testthat/_snaps/module2app.md index 3539ba7..2fb2508 100644 --- a/tests/testthat/_snaps/module2app.md +++ b/tests/testthat/_snaps/module2app.md @@ -14,8 +14,10 @@

Evaluated


         

Module UI

-
- No ui function provided. +
+
+ No ui function provided. +

Server Return Values

Unevaluated

@@ -40,8 +42,10 @@

Evaluated


         

Module UI

- -

+        
+ +

+        

Server Return Values

Unevaluated


@@ -73,8 +77,10 @@
       

Evaluated


       

Module UI

- -

+      
+ +

+      

Server Return Values

Unevaluated


diff --git a/tests/testthat/_snaps/shiny2screenshot.md b/tests/testthat/_snaps/shiny2screenshot.md
index 4d4d9cb..6e302dc 100644
--- a/tests/testthat/_snaps/shiny2screenshot.md
+++ b/tests/testthat/_snaps/shiny2screenshot.md
@@ -28,12 +28,12 @@
       \dontshow{
       # automatically inserted screenshot
       get_screenshot_from_app(
-      counter_button_app()
+      hello_app()
       )
       }
       \dontrun{
       # launch the app
-      counter_button_app()
+      hello_app()
       }
       } 
 
diff --git a/tests/testthat/test-module2app.R b/tests/testthat/test-module2app.R
index ea1dd9d..88d0c1a 100644
--- a/tests/testthat/test-module2app.R
+++ b/tests/testthat/test-module2app.R
@@ -109,3 +109,23 @@ test_that("works with bs5", {
     )
   )
 })
+correct_attr <- list(selector = paste0("#", inner_module_id))
+test_that("returns attribute with dom selector", {
+  expect_equal(
+    attr(module2app(counter_button_ui), "niffler_screenshot_args"),
+    correct_attr
+  )
+})
+test_that("screenshot args attribute can be retrieved", {
+  expect_equal(
+    get_screenshot_args_attr(module2app(counter_button_ui)),
+    correct_attr
+  )
+})
+test_that("app without niffler args returns missing arg", {
+  expect_equal(get_screenshot_args_attr(examples_app()), rlang::missing_arg())
+})
+test_that("absence and presence of niffler attrs can be found", {
+  expect_true(has_niffler_attrs(counter_button_app()))
+  expect_false(has_niffler_attrs(examples_app()))
+})