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 @@