automatically select inner module

closes #15

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))
+}

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,13 +105,16 @@ 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) {
   checkmate::assert_flag(strict)
   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)

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()

tests/testthat/_snaps/module2app.md

@@ -14,8 +14,10 @@
         <h3>Evaluated</h3>
         <pre class="shiny-text-output noplaceholder" id="inputs-eval"></pre>
         <h2>Module UI</h2>
-        <div class="bg-info">
-          <em>No ui function provided.</em>
+        <div id="niffler-module2app-module-ui">
+          <div class="bg-info">
+            <em>No ui function provided.</em>
+          </div>
         </div>
         <h2>Server Return Values</h2>
         <h3>Unevaluated</h3>
@@ -40,8 +42,10 @@
         <h3>Evaluated</h3>
         <pre class="shiny-text-output noplaceholder" id="inputs-eval"></pre>
         <h2>Module UI</h2>
-        <button id="test_object-button" type="button" class="btn btn-default action-button">Counter</button>
-        <pre class="shiny-text-output noplaceholder" id="test_object-out"></pre>
+        <div id="niffler-module2app-module-ui">
+          <button id="test_object-button" type="button" class="btn btn-default action-button">Counter</button>
+          <pre class="shiny-text-output noplaceholder" id="test_object-out"></pre>
+        </div>
         <h2>Server Return Values</h2>
         <h3>Unevaluated</h3>
         <pre class="shiny-text-output noplaceholder" id="returns-unev"></pre>
@@ -73,8 +77,10 @@
       <h3>Evaluated</h3>
       <pre class="shiny-text-output noplaceholder" id="inputs-eval"></pre>
       <h2>Module UI</h2>
-      <button id="test_object-button" type="button" class="btn btn-default action-button">Counter</button>
-      <pre class="shiny-text-output noplaceholder" id="test_object-out"></pre>
+      <div id="niffler-module2app-module-ui">
+        <button id="test_object-button" type="button" class="btn btn-default action-button">Counter</button>
+        <pre class="shiny-text-output noplaceholder" id="test_object-out"></pre>
+      </div>
       <h2>Server Return Values</h2>
       <h3>Unevaluated</h3>
       <pre class="shiny-text-output noplaceholder" id="returns-unev"></pre>

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()
       }
       } 
 

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()))
+})