diff --git a/DESCRIPTION b/DESCRIPTION index b6ee3db..b8e6ce3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,10 +17,11 @@ Imports: cli, constructive, purrr, - rlang, renv, + rlang, styler Suggests: + dplyr, knitr, rmarkdown, shiny, diff --git a/R/reprex_lockfile.R b/R/reprex_lockfile.R index ca5941a..d69c811 100644 --- a/R/reprex_lockfile.R +++ b/R/reprex_lockfile.R @@ -123,10 +123,13 @@ reprex_lockfile <- function(..., session = shiny::getDefaultReactiveDomain()) { if (is.null(packages)) { packages <- reprex_packages(..., session = session) + detect_term <- "detected" + } else { + detect_term <- "selected" } if (length(packages) == 0L) { - cli::cli_warn("No non-base packages detected; the lockfile will record only the R version") + cli::cli_warn("No non-base packages {detect_term}; the lockfile will record only the R version") } # Snapshot against a throwaway project so renv never writes infrastructure diff --git a/R/walk_packages.R b/R/walk_packages.R index 64a6785..796a41b 100644 --- a/R/walk_packages.R +++ b/R/walk_packages.R @@ -43,8 +43,7 @@ walk_packages <- function(expr, env, seen = character(), packages = character()) call_name <- rlang::call_name(expr) - # Shiny calls that are stripped when reproducing code contribute nothing, as - # the script is intended to run outside of Shiny. Mirrors `class_call_shiny`. + # Shiny calls that are stripped when reproducing code contribute nothing if (!is.null(call_name) && call_name %in% IGNORED_SHINY_CALLS) { return(packages) } @@ -64,7 +63,10 @@ walk_packages <- function(expr, env, seen = character(), packages = character()) packages <- union(packages, get_pkg_name(expr)) - for (arg in as.list(expr)[-1L]) { + # Omitted arguments, such as the empty index in `iris[cond, ]` cannot be walked + arguments <- purrr::discard(as.list(expr)[-1L], rlang::is_missing) + + for (arg in arguments) { packages <- walk_packages(arg, env, seen, packages) } diff --git a/README.md b/README.md index a838eff..2ca2008 100644 --- a/README.md +++ b/README.md @@ -15,6 +15,9 @@ Due to the interactiveness of Shiny, this isn't as easy to include out of the bo inputs set by the user, and need to be replaced in the reactive expressions to be able to run in an environment outside of Shiny. +The script alone reproduces the code, but not the environment it ran in. The packages it depends on +can also be captured as an `renv` lockfile, so the environment can be rebuilt rather than guessed at. + ## Installation ``` r @@ -92,3 +95,47 @@ server <- function(input, output, session) { shinyApp(ui, server) ``` + +## Pinning Package Versions + +`reprex_reactive` emits the `library()` calls a script needs, but not the versions those packages +were at. `reprex_lockfile` records them, along with the R version and the full recursive dependency +tree, as an [`renv`](https://rstudio.github.io/renv/) lockfile: + +```r +output$lockfile <- downloadHandler( + filename = function() "renv.lock", + content = function(file) reprex_lockfile(summary_tbl, lockfile = file) +) +``` + +Whoever receives the lockfile rebuilds the environment with: + +```r +renv::restore(lockfile = "renv.lock") +``` + +In a modular application each module can register the reactives it owns, so a whole-application +lockfile needs no reactives passed up to the top level: + +```r +moduleServer(id, function(input, output, session) { + summary_tbl <- reactive(...) + + register_reactives(summary_tbl) +}) + +# Elsewhere, covering every registered reactive +reprex_lockfile(lockfile = file) +``` + +`reprex_packages` reports the detected packages, either to display them or to let the user narrow +the set before pinning it via the `packages` argument. + +## Example Application + +An example covering all of the above ships with the package: + +```r +shiny::runExample("lockfile", package = "shinyreprex") +``` diff --git a/inst/examples-shiny/lockfile/app.R b/inst/examples-shiny/lockfile/app.R new file mode 100644 index 0000000..95ccfa2 --- /dev/null +++ b/inst/examples-shiny/lockfile/app.R @@ -0,0 +1,165 @@ +library(shiny) +library(shinyreprex) + +# Two modules doing different work with different packages. Each registers the +# reactive behind its own table, so their scripts carry different `library()` +# calls while the single download in the navbar pins the union of both. + +result_cards <- function(ns) { + bslib::layout_columns( + bslib::card(bslib::card_header("Output"), tableOutput(ns("table"))), + bslib::card(bslib::card_header("Reproducible script"), verbatimTextOutput(ns("code"))) + ) +} + +width_slider <- function(ns) { + sliderInput( + ns("min_width"), + "Minimum petal width", + min(iris$Petal.Width), + max(iris$Petal.Width), + min(iris$Petal.Width), + step = 0.1 + ) +} + +#### Summarise with {purrr} #### +summaryUI <- function(id) { + ns <- NS(id) + + bslib::layout_sidebar( + sidebar = bslib::sidebar( + width_slider(ns), + selectInput( + ns("summary_fn"), + "Summary function", + c(Mean = "mean", Median = "median", `Std. dev` = "sd") + ), + actionButton(ns("update"), "Update", class = "btn-primary") + ), + result_cards(ns) + ) +} + +summaryServer <- function(id, columns) { + moduleServer(id, function(input, output, session) { + filtered <- reactive({ + iris[iris$Petal.Width >= input$min_width, ] + }) |> + bindEvent(input$update, ignoreNULL = FALSE) + + summary_tbl <- reactive({ + purrr::map( + columns, + dat = filtered(), + fn = input$summary_fn, + \(col, dat, fn) { + aggregate(as.formula(paste(col, "~ Species")), data = dat, FUN = get(fn)) + } + ) |> + purrr::reduce(merge, by = "Species") + }) |> + bindEvent(input$update, ignoreNULL = FALSE) + + register_reactives(summary_tbl) + + output$table <- renderTable(summary_tbl()) + output$code <- renderText(reprex_reactive(summary_tbl)) |> + bindEvent(summary_tbl()) + + summary_tbl + }) +} + +#### Count with {dplyr} #### +countsUI <- function(id) { + ns <- NS(id) + + bslib::layout_sidebar( + sidebar = bslib::sidebar( + width_slider(ns), + actionButton(ns("update"), "Update", class = "btn-primary") + ), + result_cards(ns) + ) +} + +countsServer <- function(id) { + moduleServer(id, function(input, output, session) { + counts_tbl <- reactive({ + iris |> + dplyr::filter(Petal.Width >= input$min_width) |> + dplyr::group_by(Species) |> + dplyr::summarise(flowers = dplyr::n(), mean_sepal_width = mean(Sepal.Width)) + }) |> + bindEvent(input$update, ignoreNULL = FALSE) + + register_reactives(counts_tbl) + + output$table <- renderTable(counts_tbl()) + output$code <- renderText(reprex_reactive(counts_tbl)) |> + bindEvent(counts_tbl()) + + counts_tbl + }) +} + +#### UI #### +ui <- bslib::page_navbar( + title = "shinyreprex", + header = bslib::card( + fill = FALSE, + class = "mx-4 my-2", + bslib::card_header("About"), + p( + class = "mb-0 text-body-secondary", + "Each tab is a module that registers its own reactive with ", + code("register_reactives()"), ", so their scripts carry different ", + code("library()"), " calls. One lockfile pins the union of both." + ), + div( + class = "d-flex align-items-center", + div( + class = "mx-3", + checkboxGroupInput("packages", "Include in lockfile", inline = TRUE) + ), + div( + class = "mx-3", + downloadButton("lockfile", "Download renv.lock", class = "btn-primary") + ) + ) + ), + + bslib::nav_panel("Summary (purrr)", summaryUI("summary")), + bslib::nav_panel("Counts (dplyr)", countsUI("counts")) +) + +#### Server #### +server <- function(input, output, session) { + summary_tbl <- summaryServer("summary", c("Sepal.Length", "Sepal.Width")) + counts_tbl <- countsServer("counts") + + detected <- reactive(reprex_packages()) + + observe({ + updateCheckboxGroupInput( + session = session, + inputId = "packages", + choices = detected(), + selected = detected(), + inline = TRUE + ) + }) |> + bindEvent(detected(), once = TRUE) + + output$lockfile <- downloadHandler( + filename = function() "renv.lock", + content = function(file) { + withProgress(message = "Resolving package versions", { + reprex_lockfile(packages = input$packages, lockfile = file) + }) + } + ) +} + +shinyApp(ui, server) diff --git a/tests/testthat/test-examples-shiny.R b/tests/testthat/test-examples-shiny.R new file mode 100644 index 0000000..9424120 --- /dev/null +++ b/tests/testthat/test-examples-shiny.R @@ -0,0 +1,69 @@ +app_dir <- function(name) { + path <- system.file("examples-shiny", name, package = "shinyreprex") + if (!nzchar(path)) skip(paste0("Example app '", name, "' is not installed")) + path +} + +set_module_inputs <- function(session) { + session$setInputs( + `summary-min_width` = 0.5, + `summary-summary_fn` = "median", + `summary-update` = 1, + `counts-min_width` = 1, + `counts-update` = 1 + ) +} + +test_that("Each module in the example app generates a script that reproduces its own table", { + skip_if_not_installed("shiny") + skip_if_not_installed("dplyr") + + shiny::testServer(app_dir("lockfile"), { + set_module_inputs(session) + + expect_equal( + eval(parse(text = output$`summary-code`), envir = new.env()), + summary_tbl() + ) + expect_equal( + eval(parse(text = output$`counts-code`), envir = new.env()), + counts_tbl() + ) + }) +}) + +test_that("Each module reports only the packages its own reactive uses", { + skip_if_not_installed("shiny") + skip_if_not_installed("dplyr") + + shiny::testServer(app_dir("lockfile"), { + set_module_inputs(session) + + expect_identical(reprex_packages(summary_tbl), "purrr") + expect_identical(reprex_packages(counts_tbl), "dplyr") + + # A no-argument call reads the registry, covering both modules at once. + expect_named( + registered_reactives(session), + c("summary-summary_tbl", "counts-counts_tbl") + ) + expect_setequal(reprex_packages(), c("purrr", "dplyr")) + }) +}) + +test_that("The example app offers a restorable lockfile covering both modules", { + skip_on_cran() + skip_if_not_installed("shiny") + skip_if_not_installed("dplyr") + skip_if_not_installed("renv") + + shiny::testServer(app_dir("lockfile"), { + set_module_inputs(session) + + # Reading a download output runs its content function and returns the path. + parsed <- renv::lockfile_read(output$lockfile) + + expect_identical(parsed$R$Version, as.character(getRversion())) + expect_true(all(c("purrr", "dplyr") %in% names(parsed$Packages))) + }) +}) diff --git a/tests/testthat/test-reprex_lockfile.R b/tests/testthat/test-reprex_lockfile.R index c7a5a35..7d07034 100644 --- a/tests/testthat/test-reprex_lockfile.R +++ b/tests/testthat/test-reprex_lockfile.R @@ -21,6 +21,35 @@ test_that("A non-reactive object passed to reprex_packages errors", { }) #### reprex_lockfile #### +test_that("An empty package set warns differently depending on whether it was detected or selected", { + skip_on_cran() + skip_if_not_installed("renv") + + test_server <- function(input, output, session) { + base_only <- reactive(nrow(iris)) + with_purrr <- reactive(purrr::keep(iris, is.numeric)) + } + + lock <- tempfile(fileext = ".lock") + on.exit(unlink(lock), add = TRUE) + + shiny::testServer(test_server, { + # Nothing found in the reactive itself. + expect_warning( + reprex_lockfile(base_only, lockfile = lock), + "No non-base packages detected", + fixed = TRUE + ) + + # Packages were available, but the caller narrowed them away. + expect_warning( + reprex_lockfile(with_purrr, packages = character(), lockfile = lock), + "No non-base packages selected", + fixed = TRUE + ) + }) +}) + test_that("A restorable lockfile is written covering the reactive's packages", { skip_on_cran() diff --git a/tests/testthat/test-walk_packages.R b/tests/testthat/test-walk_packages.R index 1595118..182f4c0 100644 --- a/tests/testthat/test-walk_packages.R +++ b/tests/testthat/test-walk_packages.R @@ -88,6 +88,17 @@ test_that("Shiny calls stripped when reproducing code do not pull in shiny", { }) }) +test_that("An omitted index, as in a row subset, does not stop the walk", { + test_server <- function(input, output, session) { + tbl <- reactive(purrr::keep(iris[iris$Petal.Width > input$w, ], is.numeric)) + } + + shiny::testServer(test_server, { + session$setInputs(w = 1) + expect_identical(reprex_packages(tbl), "purrr") + }) +}) + test_that("A reactive using only base functions reports no packages", { test_server <- function(input, output, session) { tbl <- reactive(nrow(iris)) diff --git a/vignettes/shinyreprex.Rmd b/vignettes/shinyreprex.Rmd index b81099c..6604908 100644 --- a/vignettes/shinyreprex.Rmd +++ b/vignettes/shinyreprex.Rmd @@ -18,10 +18,78 @@ library(shinyreprex) ## Using shinyreprex -There is a single exported function, `reprex_reactive`, that takes a reactive object and converts -it into a script that can be reused outside of the Shiny application to reproduce the result -of the reactive. This can be sent to a simple `verbatimTextOutput` or something more UX -friendly such as the `{highlighter}` package to display the script in the UI. +`reprex_reactive` takes a reactive object and converts it into a script that can be reused +outside of the Shiny application to reproduce the result of the reactive. This can be sent to a +simple `verbatimTextOutput` or something more UX friendly such as the `{highlighter}` package to +display the script in the UI. + +A script on its own reproduces the *code*, but not the environment it ran in. The remaining three +functions close that gap: + +| Function | Purpose | +|---|---| +| `reprex_reactive` | Turn a reactive into a stand-alone script | +| `reprex_packages` | List the packages needed to run that script | +| `reprex_lockfile` | Capture those packages, their versions and sources as an `renv` lockfile | +| `register_reactives` | Record reactives so the two functions above can be called with no arguments | + +A worked example covering all four ships with the package: + +```r +shiny::runExample("lockfile", package = "shinyreprex") +``` + +## Reproducing the Environment + +`reprex_reactive` emits the `library()` calls a script needs, but not the versions those packages +were at. `reprex_lockfile` records them, along with the R version and the full recursive dependency +tree, so the environment can be rebuilt rather than approximated. + +```r +output$lockfile <- downloadHandler( + filename = function() "renv.lock", + content = function(file) reprex_lockfile(summary_tbl, lockfile = file) +) +``` + +Whoever receives the lockfile restores it with `renv`: + +```r +renv::restore(lockfile = "renv.lock") +``` + +Use `reprex_packages` when you want to show the detected packages before pinning them, for example +to let the user narrow the set: + +```r +reprex_lockfile(summary_tbl, packages = input$packages, lockfile = file) +``` + +Supplying `packages` is also the escape hatch when the detector cannot see a package, such as one +attached only for an operator or an S3 method. + +### Registering Reactives Across Modules + +In a modular application the reactives worth reproducing live inside their own modules. Rather than +returning them all up to the top level, each module registers what it owns: + +```r +summaryServer <- function(id) { + moduleServer(id, function(input, output, session) { + summary_tbl <- reactive({ + aggregate(Sepal.Width ~ Species, data = iris, FUN = get(input$summary_fn)) + }) + + register_reactives(summary_tbl) + + summary_tbl + }) +} +``` + +`reprex_lockfile()` and `reprex_packages()` then cover the whole application when called with no +arguments. Registrations are namespaced by module, held on the session, and discarded when the +session ends, so they are never shared between concurrent users. ## Best Practices @@ -45,6 +113,30 @@ repro_range <- reactive(reprex_reactive(width_range)) |> repro_range <- reactive(reprex_reactive(width_range)) ``` +### Register Reactives at Module Setup + +`register_reactives` does not evaluate the reactive it is given, so it can be called as soon as the +reactive is defined, even when that reactive is still gated behind `shiny::req` or inputs that have +yet to be set. Registering at setup means a lockfile covers every module regardless of which parts +of the application the user happened to visit. + +```r +# Good +summary_tbl <- reactive({ + shiny::req(input$summary_fn) + aggregate(Sepal.Width ~ Species, data = iris, FUN = get(input$summary_fn)) +}) + +register_reactives(summary_tbl) + +# Bad - the reactive is only registered once the user has viewed the output, +# so a lockfile downloaded beforehand silently misses it +output$table <- renderTable({ + register_reactives(summary_tbl) + summary_tbl() +}) +``` + ### Put Side-Effects in Observers This is general best-practice when developing Shiny applications, but avoid putting code @@ -102,9 +194,59 @@ moduleServer(id, function(input, output, session) { # Bad moduleServer(id, function(input, output, session) { api_key <- Sys.getenv("MY_API_KEY") - + my_reactive <- reactive({ ... }) }) ``` + +## Limitations + +Reproducible code is generated by reading the expression held in a reactive, rather than by tracing +what it does when it runs. That keeps the process cheap and independent of the current inputs, but it +sets some boundaries worth knowing about. + +### Only the Reactive Expression is Read + +Calls made inside a function that is defined elsewhere are not visited, so anything used only in that +function is neither reproduced nor detected as a package. + +```r +summarise_widths <- function(dat) dplyr::summarise(dat, mean(Petal.Width)) + +my_reactive <- reactive(summarise_widths(iris)) +``` + +Here the script reproduces the call to `summarise_widths`, but `dplyr` is not reported. Keeping the +work inside the reactive, or moving it into a package that the recipient installs, avoids this. See +also *Create a Business Logic Package* above. + +### Non-Standard Evaluation is Best-Effort + +Data-masking functions such as `dplyr::filter` or `subset` refer to columns as if they were +variables. Since the column names are only distinguishable from real variables at run time, a +collision between the two can produce a misleading line in the script: + +```r +moduleServer(id, function(input, output, session) { + Species <- "versicolor" + + my_reactive <- reactive(subset(iris, Species == "setosa")) +}) +``` + +`Species` in the reactive is a column of `iris`, but a variable of the same name exists in the +module, so the script includes an unnecessary `Species <- "versicolor"` assignment. The reproduced +code still runs, because `subset` masks the variable with the column, but the extra line is +misleading. Avoiding names that clash with the columns being masked avoids this. + +Similarly, an input captured with `rlang::quo` and spliced back in later cannot be resolved to its +value, and appears in the script with the `!!` still in place. + +### Detected Packages Can Be a Superset + +`reprex_packages` walks every branch of an `if` or `switch` rather than evaluating the condition and +following only the branch that would be taken. A lockfile may therefore pin a package that the +script does not end up needing. This is deliberate: a lockfile holding a package that is not needed +is safer than one missing a package that is.