feat: Allow for dev packages to be dynamically loaded (#402)

Author: schloerke

.Rbuildignore

@@ -20,5 +20,6 @@ _\.new\.png$
 
 ^tests/testthat/migrate-apps$
 ^tests/testthat/apps$
+^tests/testthat/pkgs$
 ^CRAN-SUBMISSION$
 ^_dev$

.github/workflows/test-actions.yaml

@@ -35,8 +35,10 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages:
-            "local::."
+          needs: |
+            shinytest2-testing
+          extra-packages: |
+            local::.
 
       # ## Suggested usage
       # - name: Test app

.lintr

@@ -8,5 +8,8 @@ exclusions: list(
     "inst/gha/audit-app.R" = list(
       "object_usage_linter" = 81
     ),
-    "R/cpp11.R"
+    "R/cpp11.R",
+    "tests/testthat/pkgs/golem/R/run_app.R",
+    "vignettes/use-package.Rmd",
+    "tests/testthat/pkgs/"
   )

DESCRIPTION

@@ -33,18 +33,22 @@ Imports:
     jsonlite,
     lifecycle,
     pingr,
+    pkgload,
     R6 (>= 2.4.0),
     rlang (>= 1.0.0),
     rmarkdown,
     shiny,
     withr
 Suggests:
+    box,
     deSolve,
     diffobj,
     ggplot2,
+    golem,
     knitr,
     plotly,
     png,
+    rhino,
     rstudioapi,
     shinytest (>= 1.5.1),
     shinyvalidate (>= 0.1.2),
@@ -55,9 +59,10 @@ Suggests:
     vdiffr (>= 1.0.0)
 LinkingTo:
     cpp11
-VignetteBuilder: 
+VignetteBuilder:
     knitr
 Config/Needs/check: rstudio/shiny, bslib
+Config/Needs/shinytest2-testing: decor
 Config/Needs/website: pkgdown, tidyverse/tidytemplate
 Config/testthat/edition: 3
 Encoding: UTF-8

NEWS.md

@@ -1,5 +1,9 @@
 # shinytest2 (development version)
 
+* Added support for local package development for the background Shiny App process in `AppDriver$new(app_dir=)`. In the background test R process, any `library(<pkg>)` or `require(<pkg>)` call will automatically execute `pkgload::load_all()` to load the local R package's source code. Installing the package before testing is no longer required! (#402).
+
+* Added support for function execution for `AppDriver$new(app_dir=)`. You must run the App or document yourself. Similar to `{mirai}`, all packages must be `library()`'d or `require()`'d again as the function is being ran in the background R process (#402).
+
 * Fixed internal bug where `{testthat}` v3.3.0 changed expectation behavior for screenshot snapshots within `App$expect_values()` (#418).
 
 # shinytest2 0.4.1

R/app-driver-dir.R

@@ -1,10 +1,47 @@
-
 app_set_dir <- function(
-  self, private,
+  self,
+  private,
   app_dir
 ) {
   ckm8_assert_app_driver(self, private)
 
+  if (is.function(app_dir)) {
+    # package_path <- tryCatch(pkgload::pkg_path(), error = function(e) NULL)
+    package_name <- tryCatch(pkgload::pkg_name(), error = function(e) NULL)
+
+    if (
+      !is.null(package_name) &&
+        rlang::env_label(environment(app_dir)) ==
+          rlang::env_label(pkgload::pkg_ns())
+    ) {
+      # If the function is from the local package, ensure the package is loaded
+      # Make a new function that first loads the package, then runs the original function
+      message(
+        "Upgrading `app_dir` function to load dev package: ",
+        package_name
+      )
+
+      app_fn <- app_dir
+      app_dir <- function() {}
+      rlang::fn_body(app_dir) <- rlang::expr({
+        # Run app with dev package loaded
+        # `library()` shimmed in app driver start
+        library(!!package_name, character.only = TRUE)
+
+        .pkg_ns <- rlang::ns_env(!!package_name)
+        .dev_pkg_run_app <- !!app_fn
+        environment(.dev_pkg_run_app) <- .pkg_ns
+
+        .dev_pkg_run_app()
+      })
+      rlang::fn_env(app_dir) <- globalenv()
+    }
+
+    # Set app function
+    private$dir <- app_dir
+    return()
+  }
+
   app_dir <- app_dir_value(app_dir)
 
   if (!fs::dir_exists(app_dir)) {
@@ -16,7 +53,8 @@ app_set_dir <- function(
         paste0("\"", cur_dir, "\"")
       }
     app_abort(
-      self, private,
+      self,
+      private,
       c(
         "`app_dir` must be an existing directory",
         "i" = paste0("Received: ", cur_dir)
@@ -25,25 +63,33 @@ app_set_dir <- function(
   }
 
   shiny_app_and_rmd_abort <- function() {
-    app_abort(self, private, c(
-      "`app_dir` must be a directory containing:",
-      "",
-      "*" = "an `./app.R` Shiny application",
-      "",
-      " " = "or",
-      "",
-      "*" = "a Shiny R Markdown file",
-      "*" = "a `./server.R` Shiny server",
-      "",
-      "i" = "If a Shiny R Markdown document is found, it will be the prefered document.",
-      "i" = "`./app.R` is not compatible with Shiny R Markdown files."
-    ))
+    app_abort(
+      self,
+      private,
+      c(
+        "`app_dir` must be a directory containing:",
+        "",
+        "*" = "an `./app.R` Shiny application",
+        "",
+        " " = "or",
+        "",
+        "*" = "a Shiny R Markdown file",
+        "*" = "a `./server.R` Shiny server",
+        "",
+        "i" = "If a Shiny R Markdown document is found, it will be the prefered document.",
+        "i" = "`./app.R` is not compatible with Shiny R Markdown files."
+      )
+    )
   }
   shiny_app_and_server_abort <- function() {
-    app_abort(self, private, c(
-      "`app_dir` contains both `app.R` and `server.R`. Unintented behavior may occur.",
-      "!" = "Please either use `app.R` or `server.R`, but not both."
-    ))
+    app_abort(
+      self,
+      private,
+      c(
+        "`app_dir` contains both `app.R` and `server.R`. Unintented behavior may occur.",
+        "!" = "Please either use `app.R` or `server.R`, but not both."
+      )
+    )
   }
 
   if (!fs::dir_exists(app_dir)) {
@@ -74,6 +120,10 @@ app_set_dir <- function(
 
 app_get_dir <- function(self, private) {
   ckm8_assert_app_driver(self, private)
+  if (is.function(private$dir)) {
+    return(private$dir)
+  }
+
   as.character(private$dir)
 }
 
@@ -82,6 +132,9 @@ app_dir_has_rmd <- function(self, private, app_dir = missing_arg()) {
     ckm8_assert_app_driver(self, private)
     app_dir <- self$get_dir()
   }
+  if (is.function(app_dir)) {
+    return(FALSE)
+  }
   length(app_dir_rmd(app_dir = app_dir)) >= 1
 }
 app_dir_rmd <- function(self, private, app_dir = rlang::missing_arg()) {
@@ -90,7 +143,11 @@ app_dir_rmd <- function(self, private, app_dir = rlang::missing_arg()) {
     app_dir <- self$get_dir()
   }
   # Similar to https://github.com/rstudio/rmarkdown/issues/2236
-  docs <- fs::dir_ls(app_dir, regexp = "^[^_].*\\.[Rrq][Mm][Dd]$", type = "file")
+  docs <- fs::dir_ls(
+    app_dir,
+    regexp = "^[^_].*\\.[Rrq][Mm][Dd]$",
+    type = "file"
+  )
 
   if (length(docs) >= 1) {
     docs <- Filter(docs, f = function(doc_path) {

R/app-driver-expect-values.R

@@ -30,21 +30,32 @@ app_get_single_ioe <- function(
     )
   }
 
-  if (input_is_provided) ckm8_assert_single_string(input) else if (
-    output_is_provided
-  )
-    ckm8_assert_single_string(output) else if (export_is_provided)
-    ckm8_assert_single_string(export) else
+  if (input_is_provided) {
+    ckm8_assert_single_string(input)
+  } else if (output_is_provided) {
+    ckm8_assert_single_string(output)
+  } else if (export_is_provided) {
+    ckm8_assert_single_string(export)
+  } else {
     app_abort(self, private, "Missing ioe type", .internal = TRUE)
+  }
 
   type <-
-    if (input_is_provided) "input" else if (output_is_provided)
-      "output" else if (export_is_provided) "export"
+    if (input_is_provided) {
+      "input"
+    } else if (output_is_provided) {
+      "output"
+    } else if (export_is_provided) {
+      "export"
+    }
   name <-
-    if (input_is_provided) input else if (output_is_provided) output else if (
-      export_is_provided
-    )
+    if (input_is_provided) {
+      input
+    } else if (output_is_provided) {
+      output
+    } else if (export_is_provided) {
       export
+    }
 
   list(
     input = input,
@@ -307,8 +318,13 @@ app_get_shiny_test_url <- function(
   }
 
   q_string <- function(group, value) {
-    if (isTRUE(value)) paste0(group, "=1") else if (is.character(value))
-      paste0(group, "=", paste(value, collapse = ",")) else ""
+    if (isTRUE(value)) {
+      paste0(group, "=1")
+    } else if (is.character(value)) {
+      paste0(group, "=", paste(value, collapse = ","))
+    } else {
+      ""
+    }
   }
   paste(
     private$shiny_test_url,

R/app-driver-initialize.R

@@ -78,7 +78,18 @@ app_initialize_ <- function(
   } else {
     "!DEBUG starting shiny app from path"
     self$log_message("Starting Shiny app")
-    app_set_dir(self, private, app_dir)
+    if (is.function(app_dir)) {
+      if (length(shiny_args) != 0) {
+        app_abort(
+          self,
+          private,
+          "When `app_dir=` is a function, `shiny_args=` must be empty"
+        )
+      }
+      app_set_dir(self, private, app_dir)
+    } else {
+      app_set_dir(self, private, app_dir)
+    }
 
     app_start_shiny(
       self,
@@ -173,8 +184,9 @@ app_initialize_ <- function(
     self$get_chromote_session(),
     "Shiny.shinyapp.config.workerId"
   )$result$value
-  if (identical(private$shiny_worker_id, ""))
+  if (identical(private$shiny_worker_id, "")) {
     private$shiny_worker_id <- NA_character_
+  }
 
   private$shiny_test_url <- chromote_eval(
     self$get_chromote_session(),