From f8fb5b7173074a8fc6599e7be6f55fc7cecdcfea Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Fri, 21 Aug 2026 17:04:15 +0100 Subject: [PATCH 1/8] Add module that generates lockfile --- DESCRIPTION | 1 + R/lockfile_module.R | 82 +++++++++++++++++++++++++++ man/lockfile_module.Rd | 72 +++++++++++++++++++++++ tests/testthat/test-lockfile_module.R | 21 +++++++ 4 files changed, 176 insertions(+) create mode 100644 R/lockfile_module.R create mode 100644 man/lockfile_module.Rd create mode 100644 tests/testthat/test-lockfile_module.R diff --git a/DESCRIPTION b/DESCRIPTION index aeee72b..d22cd25 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -49,5 +49,6 @@ Collate: 'chunk_call.R' 'chunk_generic.R' 'chunk_reactive.R' + 'lockfile_module.R' 'package.R' 'reprex_reactive.R' diff --git a/R/lockfile_module.R b/R/lockfile_module.R new file mode 100644 index 0000000..b03374f --- /dev/null +++ b/R/lockfile_module.R @@ -0,0 +1,82 @@ +#' Lockfile Download Module +#' +#' @description +#' A Shiny module offering a single download control that writes an `renv` +#' lockfile reproducing one or more reactives (see [reprex_lockfile()]). +#' +#' `lockfileUI()` returns a plain [shiny::downloadButton()], so it can be +#' dropped wherever a control fits - inside a `bslib::nav_menu()`, a sidebar, or +#' a toolbar - without pulling in any layout of its own. +#' +#' To build a bespoke interface instead, skip the module and call +#' [reprex_packages()] to populate your own package picker, feeding the choice +#' back through the `packages` argument of [reprex_lockfile()]. +#' +#' @param id Module id, shared between `lockfileUI()` and `lockfileServer()`. +#' @param label Button label. +#' @param ... One or more `shiny::reactive` objects to reproduce. +#' @param packages Packages to snapshot, passed to [reprex_lockfile()]. May be a +#' reactive (for example one fed by a user's own package picker), in which case +#' it is resolved when the download is requested. `NULL` snapshots every +#' detected package. +#' @param filename Name of the downloaded lockfile. +#' +#' @returns +#' `lockfileUI()` returns a Shiny UI tag. `lockfileServer()` is called for its +#' side effect and returns the module's return value invisibly. +#' +#' @examplesIf interactive() && rlang::is_installed(c("shiny", "renv", "bslib")) +#' library(shiny) +#' +#' ui <- bslib::page_navbar( +#' title = "Demo", +#' bslib::nav_panel( +#' "Table", +#' sliderInput("w", "Minimum petal width", 0, 2.5, 0.5, step = 0.1), +#' tableOutput("table") +#' ), +#' bslib::nav_spacer(), +#' bslib::nav_item(lockfileUI("lock", "Download renv.lock")) +#' ) +#' +#' server <- function(input, output, session) { +#' filtered <- reactive(purrr::keep(iris, is.numeric)[iris$Petal.Width > input$w, ]) +#' +#' output$table <- renderTable(head(filtered())) +#' lockfileServer("lock", filtered) +#' } +#' +#' shinyApp(ui, server) +#' +#' @seealso +#' A fuller worked example, covering both this module and a custom package +#' picker, ships with the package: +#' `shiny::runApp(system.file("examples-shiny/lockfile", package = "shinyreprex"))` +#' +#' @name lockfile_module +NULL + +#' @rdname lockfile_module +#' @export +lockfileUI <- function(id, label = "Download lockfile") { + shiny::downloadButton(shiny::NS(id, "download"), label) +} + +#' @rdname lockfile_module +#' @export +lockfileServer <- function(id, ..., packages = NULL, filename = "renv.lock") { + reactives <- list(...) + + shiny::moduleServer(id, function(input, output, session) { + output$download <- shiny::downloadHandler( + filename = function() filename, + content = function(file) { + pkgs <- if (shiny::is.reactive(packages)) packages() else packages + do.call( + reprex_lockfile, + c(reactives, list(packages = pkgs, lockfile = file)) + ) + } + ) + }) +} diff --git a/man/lockfile_module.Rd b/man/lockfile_module.Rd new file mode 100644 index 0000000..d4e8528 --- /dev/null +++ b/man/lockfile_module.Rd @@ -0,0 +1,72 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lockfile_module.R +\name{lockfile_module} +\alias{lockfile_module} +\alias{lockfileUI} +\alias{lockfileServer} +\title{Lockfile Download Module} +\usage{ +lockfileUI(id, label = "Download lockfile") + +lockfileServer(id, ..., packages = NULL, filename = "renv.lock") +} +\arguments{ +\item{id}{Module id, shared between \code{lockfileUI()} and \code{lockfileServer()}.} + +\item{label}{Button label.} + +\item{...}{One or more \code{shiny::reactive} objects to reproduce.} + +\item{packages}{Packages to snapshot, passed to \code{\link[=reprex_lockfile]{reprex_lockfile()}}. May be a +reactive (for example one fed by a user's own package picker), in which case +it is resolved when the download is requested. \code{NULL} snapshots every +detected package.} + +\item{filename}{Name of the downloaded lockfile.} +} +\value{ +\code{lockfileUI()} returns a Shiny UI tag. \code{lockfileServer()} is called for its +side effect and returns the module's return value invisibly. +} +\description{ +A Shiny module offering a single download control that writes an \code{renv} +lockfile reproducing one or more reactives (see \code{\link[=reprex_lockfile]{reprex_lockfile()}}). + +\code{lockfileUI()} returns a plain \code{\link[shiny:downloadButton]{shiny::downloadButton()}}, so it can be +dropped wherever a control fits - inside a \code{bslib::nav_menu()}, a sidebar, or +a toolbar - without pulling in any layout of its own. + +To build a bespoke interface instead, skip the module and call +\code{\link[=reprex_packages]{reprex_packages()}} to populate your own package picker, feeding the choice +back through the \code{packages} argument of \code{\link[=reprex_lockfile]{reprex_lockfile()}}. +} +\examples{ +\dontshow{if (interactive() && rlang::is_installed(c("shiny", "renv", "bslib"))) withAutoprint(\{ # examplesIf} +library(shiny) + +ui <- bslib::page_navbar( + title = "Demo", + bslib::nav_panel( + "Table", + sliderInput("w", "Minimum petal width", 0, 2.5, 0.5, step = 0.1), + tableOutput("table") + ), + bslib::nav_spacer(), + bslib::nav_item(lockfileUI("lock", "Download renv.lock")) +) + +server <- function(input, output, session) { + filtered <- reactive(purrr::keep(iris, is.numeric)[iris$Petal.Width > input$w, ]) + + output$table <- renderTable(head(filtered())) + lockfileServer("lock", filtered) +} + +shinyApp(ui, server) +\dontshow{\}) # examplesIf} +} +\seealso{ +A fuller worked example, covering both this module and a custom package +picker, ships with the package: +\code{shiny::runApp(system.file("examples-shiny/lockfile", package = "shinyreprex"))} +} diff --git a/tests/testthat/test-lockfile_module.R b/tests/testthat/test-lockfile_module.R new file mode 100644 index 0000000..20a8f1e --- /dev/null +++ b/tests/testthat/test-lockfile_module.R @@ -0,0 +1,21 @@ +test_that("lockfileUI returns a download control namespaced to the module id", { + ui <- lockfileUI("lock", "Grab it") + expect_s3_class(ui, "shiny.tag") + expect_match(as.character(ui), "lock-download", fixed = TRUE) + expect_match(as.character(ui), "Grab it", fixed = TRUE) +}) + +test_that("lockfileServer wires into an app without error", { + server <- function(input, output, session) { + r <- reactive(iris[iris$Petal.Width > input$w, ]) + lockfileServer("lock", r) + } + + # Constructing the module inside testServer runs its setup; a broken wiring + # would throw here. The download content itself is exercised via + # reprex_lockfile()'s own tests rather than a live renv snapshot. + shiny::testServer(server, { + session$setInputs(w = 1) + succeed() + }) +}) From 69c84ca110d87911ce8c215a23be28317cf5162b Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Fri, 21 Aug 2026 17:05:45 +0100 Subject: [PATCH 2/8] Adding example app --- inst/examples-shiny/lockfile/app.R | 105 +++++++++++++++++++++++++++ tests/testthat/test-examples-shiny.R | 50 +++++++++++++ 2 files changed, 155 insertions(+) create mode 100644 inst/examples-shiny/lockfile/app.R create mode 100644 tests/testthat/test-examples-shiny.R diff --git a/inst/examples-shiny/lockfile/app.R b/inst/examples-shiny/lockfile/app.R new file mode 100644 index 0000000..e2716f2 --- /dev/null +++ b/inst/examples-shiny/lockfile/app.R @@ -0,0 +1,105 @@ +library(shiny) +library(shinyreprex) + +# Demonstrates the two ways to offer a lockfile alongside a reprex: +# 1. `lockfileUI`/`lockfileServer` - a single control, dropped in the navbar. +# 2. `reprex_packages` - feeding a custom picker, wired up by hand. + +ui <- bslib::page_navbar( + title = "shinyreprex", + + bslib::nav_panel( + "Reproduce", + bslib::layout_sidebar( + sidebar = bslib::sidebar( + sliderInput( + "min_width", + "Minimum petal width", + min(iris$Petal.Width), + max(iris$Petal.Width), + min(iris$Petal.Width), + step = 0.1 + ), + selectInput( + "summary_fn", + "Summary function", + c(Mean = "mean", Median = "median", `Std. dev` = "sd") + ), + checkboxGroupInput( + "columns", + "Columns to summarise", + c("Sepal.Length", "Sepal.Width", "Petal.Length"), + selected = "Sepal.Width" + ), + actionButton("update", "Update", class = "btn-primary") + ), + bslib::layout_columns( + bslib::card(bslib::card_header("Output"), tableOutput("table")), + bslib::card(bslib::card_header("Reproducible script"), verbatimTextOutput("code")) + ) + ) + ), + + bslib::nav_panel( + "Environment", + bslib::card( + bslib::card_header("Choose what to pin"), + p( + "The packages below were detected in the reactive by ", code("reprex_packages()"), + ". Narrow the selection, or add a package the detector could not see, then ", + "download a lockfile scoped to that choice." + ), + uiOutput("package_picker"), + downloadButton("custom_lock", "Download selected", class = "btn-secondary") + ) + ), + + bslib::nav_spacer(), + bslib::nav_item(lockfileUI("lock", "Download renv.lock")) +) + +server <- function(input, output, session) { + iris_filt <- reactive({ + iris[iris$Petal.Width >= input$min_width, ] + }) |> + bindEvent(input$update, ignoreNULL = FALSE) + + summary_tbl <- reactive({ + purrr::map( + input$columns, + dat = iris_filt(), + 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) + + output$table <- renderTable(summary_tbl()) + + # Bound to the reactive so the script only refreshes when the output does. + output$code <- renderText(reprex_reactive(summary_tbl)) |> + bindEvent(summary_tbl()) + + # 1. The drop-in: one control in the navbar, pinning everything detected. + lockfileServer("lock", summary_tbl) + + # 2. The custom path: same engine, user-selected packages. + detected <- reactive(reprex_packages(summary_tbl)) |> + bindEvent(summary_tbl()) + + output$package_picker <- renderUI({ + checkboxGroupInput("packages", NULL, choices = detected(), selected = detected()) + }) + + output$custom_lock <- downloadHandler( + filename = function() "renv.lock", + content = function(file) { + reprex_lockfile(summary_tbl, 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..ca9a61e --- /dev/null +++ b/tests/testthat/test-examples-shiny.R @@ -0,0 +1,50 @@ +app_dir <- function(name) { + path <- system.file("examples-shiny", name, package = "shinyreprex") + if (!nzchar(path)) skip(paste0("Example app '", name, "' is not installed")) + path +} + +test_that("The lockfile example app generates a script that reproduces its own output", { + skip_if_not_installed("shiny") + + shiny::testServer(app_dir("lockfile"), { + session$setInputs( + min_width = 0.5, + summary_fn = "median", + columns = c("Sepal.Width", "Petal.Length"), + update = 1 + ) + + expect_identical(reprex_packages(summary_tbl), "purrr") + expect_identical( + eval(parse(text = output$code), envir = new.env()), + summary_tbl() + ) + }) +}) + +test_that("The lockfile example app offers a restorable lockfile from both the module and the custom picker", { + skip_on_cran() + skip_if_not_installed("shiny") + skip_if_not_installed("renv") + + shiny::testServer(app_dir("lockfile"), { + session$setInputs( + min_width = 0.5, + summary_fn = "median", + columns = "Sepal.Width", + update = 1, + packages = "purrr" + ) + + # Reading a download output runs its content function and returns the path. + for (lock in c(output$`lock-download`, output$custom_lock)) { + parsed <- renv::lockfile_read(lock) + expect_identical(parsed$R$Version, as.character(getRversion())) + expect_identical( + parsed$Packages$purrr$Version, + as.character(utils::packageVersion("purrr")) + ) + } + }) +}) From 57f96e06c74d44792393a7d3e61fe2b6280d5c9e Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Fri, 28 Aug 2026 16:50:10 +0100 Subject: [PATCH 3/8] Remove unused lockfile module --- R/lockfile_module.R | 82 --------------------------- man/lockfile_module.Rd | 72 ----------------------- tests/testthat/test-lockfile_module.R | 21 ------- 3 files changed, 175 deletions(-) delete mode 100644 R/lockfile_module.R delete mode 100644 man/lockfile_module.Rd delete mode 100644 tests/testthat/test-lockfile_module.R diff --git a/R/lockfile_module.R b/R/lockfile_module.R deleted file mode 100644 index b03374f..0000000 --- a/R/lockfile_module.R +++ /dev/null @@ -1,82 +0,0 @@ -#' Lockfile Download Module -#' -#' @description -#' A Shiny module offering a single download control that writes an `renv` -#' lockfile reproducing one or more reactives (see [reprex_lockfile()]). -#' -#' `lockfileUI()` returns a plain [shiny::downloadButton()], so it can be -#' dropped wherever a control fits - inside a `bslib::nav_menu()`, a sidebar, or -#' a toolbar - without pulling in any layout of its own. -#' -#' To build a bespoke interface instead, skip the module and call -#' [reprex_packages()] to populate your own package picker, feeding the choice -#' back through the `packages` argument of [reprex_lockfile()]. -#' -#' @param id Module id, shared between `lockfileUI()` and `lockfileServer()`. -#' @param label Button label. -#' @param ... One or more `shiny::reactive` objects to reproduce. -#' @param packages Packages to snapshot, passed to [reprex_lockfile()]. May be a -#' reactive (for example one fed by a user's own package picker), in which case -#' it is resolved when the download is requested. `NULL` snapshots every -#' detected package. -#' @param filename Name of the downloaded lockfile. -#' -#' @returns -#' `lockfileUI()` returns a Shiny UI tag. `lockfileServer()` is called for its -#' side effect and returns the module's return value invisibly. -#' -#' @examplesIf interactive() && rlang::is_installed(c("shiny", "renv", "bslib")) -#' library(shiny) -#' -#' ui <- bslib::page_navbar( -#' title = "Demo", -#' bslib::nav_panel( -#' "Table", -#' sliderInput("w", "Minimum petal width", 0, 2.5, 0.5, step = 0.1), -#' tableOutput("table") -#' ), -#' bslib::nav_spacer(), -#' bslib::nav_item(lockfileUI("lock", "Download renv.lock")) -#' ) -#' -#' server <- function(input, output, session) { -#' filtered <- reactive(purrr::keep(iris, is.numeric)[iris$Petal.Width > input$w, ]) -#' -#' output$table <- renderTable(head(filtered())) -#' lockfileServer("lock", filtered) -#' } -#' -#' shinyApp(ui, server) -#' -#' @seealso -#' A fuller worked example, covering both this module and a custom package -#' picker, ships with the package: -#' `shiny::runApp(system.file("examples-shiny/lockfile", package = "shinyreprex"))` -#' -#' @name lockfile_module -NULL - -#' @rdname lockfile_module -#' @export -lockfileUI <- function(id, label = "Download lockfile") { - shiny::downloadButton(shiny::NS(id, "download"), label) -} - -#' @rdname lockfile_module -#' @export -lockfileServer <- function(id, ..., packages = NULL, filename = "renv.lock") { - reactives <- list(...) - - shiny::moduleServer(id, function(input, output, session) { - output$download <- shiny::downloadHandler( - filename = function() filename, - content = function(file) { - pkgs <- if (shiny::is.reactive(packages)) packages() else packages - do.call( - reprex_lockfile, - c(reactives, list(packages = pkgs, lockfile = file)) - ) - } - ) - }) -} diff --git a/man/lockfile_module.Rd b/man/lockfile_module.Rd deleted file mode 100644 index d4e8528..0000000 --- a/man/lockfile_module.Rd +++ /dev/null @@ -1,72 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lockfile_module.R -\name{lockfile_module} -\alias{lockfile_module} -\alias{lockfileUI} -\alias{lockfileServer} -\title{Lockfile Download Module} -\usage{ -lockfileUI(id, label = "Download lockfile") - -lockfileServer(id, ..., packages = NULL, filename = "renv.lock") -} -\arguments{ -\item{id}{Module id, shared between \code{lockfileUI()} and \code{lockfileServer()}.} - -\item{label}{Button label.} - -\item{...}{One or more \code{shiny::reactive} objects to reproduce.} - -\item{packages}{Packages to snapshot, passed to \code{\link[=reprex_lockfile]{reprex_lockfile()}}. May be a -reactive (for example one fed by a user's own package picker), in which case -it is resolved when the download is requested. \code{NULL} snapshots every -detected package.} - -\item{filename}{Name of the downloaded lockfile.} -} -\value{ -\code{lockfileUI()} returns a Shiny UI tag. \code{lockfileServer()} is called for its -side effect and returns the module's return value invisibly. -} -\description{ -A Shiny module offering a single download control that writes an \code{renv} -lockfile reproducing one or more reactives (see \code{\link[=reprex_lockfile]{reprex_lockfile()}}). - -\code{lockfileUI()} returns a plain \code{\link[shiny:downloadButton]{shiny::downloadButton()}}, so it can be -dropped wherever a control fits - inside a \code{bslib::nav_menu()}, a sidebar, or -a toolbar - without pulling in any layout of its own. - -To build a bespoke interface instead, skip the module and call -\code{\link[=reprex_packages]{reprex_packages()}} to populate your own package picker, feeding the choice -back through the \code{packages} argument of \code{\link[=reprex_lockfile]{reprex_lockfile()}}. -} -\examples{ -\dontshow{if (interactive() && rlang::is_installed(c("shiny", "renv", "bslib"))) withAutoprint(\{ # examplesIf} -library(shiny) - -ui <- bslib::page_navbar( - title = "Demo", - bslib::nav_panel( - "Table", - sliderInput("w", "Minimum petal width", 0, 2.5, 0.5, step = 0.1), - tableOutput("table") - ), - bslib::nav_spacer(), - bslib::nav_item(lockfileUI("lock", "Download renv.lock")) -) - -server <- function(input, output, session) { - filtered <- reactive(purrr::keep(iris, is.numeric)[iris$Petal.Width > input$w, ]) - - output$table <- renderTable(head(filtered())) - lockfileServer("lock", filtered) -} - -shinyApp(ui, server) -\dontshow{\}) # examplesIf} -} -\seealso{ -A fuller worked example, covering both this module and a custom package -picker, ships with the package: -\code{shiny::runApp(system.file("examples-shiny/lockfile", package = "shinyreprex"))} -} diff --git a/tests/testthat/test-lockfile_module.R b/tests/testthat/test-lockfile_module.R deleted file mode 100644 index 20a8f1e..0000000 --- a/tests/testthat/test-lockfile_module.R +++ /dev/null @@ -1,21 +0,0 @@ -test_that("lockfileUI returns a download control namespaced to the module id", { - ui <- lockfileUI("lock", "Grab it") - expect_s3_class(ui, "shiny.tag") - expect_match(as.character(ui), "lock-download", fixed = TRUE) - expect_match(as.character(ui), "Grab it", fixed = TRUE) -}) - -test_that("lockfileServer wires into an app without error", { - server <- function(input, output, session) { - r <- reactive(iris[iris$Petal.Width > input$w, ]) - lockfileServer("lock", r) - } - - # Constructing the module inside testServer runs its setup; a broken wiring - # would throw here. The download content itself is exercised via - # reprex_lockfile()'s own tests rather than a live renv snapshot. - shiny::testServer(server, { - session$setInputs(w = 1) - succeed() - }) -}) From 1074699f11cc721438c0bab281457fefa78959fb Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Fri, 28 Aug 2026 16:52:51 +0100 Subject: [PATCH 4/8] (fix): Ensure missing arguments can be walked when evaluating package dependencies --- DESCRIPTION | 1 - R/walk_packages.R | 8 +++++--- tests/testthat/test-walk_packages.R | 11 +++++++++++ 3 files changed, 16 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f8b721b..b6ee3db 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -51,7 +51,6 @@ Collate: 'chunk_call.R' 'chunk_generic.R' 'chunk_reactive.R' - 'lockfile_module.R' 'package.R' 'reactive_expression.R' 'register_reactives.R' 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/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)) From 476aeaf040d56be1de8f6d4604fe39244bf55419 Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Mon, 31 Aug 2026 12:51:30 +0100 Subject: [PATCH 5/8] (app): Update to have lock file in options dropdown --- DESCRIPTION | 1 + inst/examples-shiny/lockfile/app.R | 217 ++++++++++++++++----------- tests/testthat/test-examples-shiny.R | 69 ++++++--- 3 files changed, 178 insertions(+), 109 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b6ee3db..e597929 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -21,6 +21,7 @@ Imports: renv, styler Suggests: + dplyr, knitr, rmarkdown, shiny, diff --git a/inst/examples-shiny/lockfile/app.R b/inst/examples-shiny/lockfile/app.R index e2716f2..392df61 100644 --- a/inst/examples-shiny/lockfile/app.R +++ b/inst/examples-shiny/lockfile/app.R @@ -1,103 +1,152 @@ library(shiny) library(shinyreprex) -# Demonstrates the two ways to offer a lockfile alongside a reprex: -# 1. `lockfileUI`/`lockfileServer` - a single control, dropped in the navbar. -# 2. `reprex_packages` - feeding a custom picker, wired up by hand. +# 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", - bslib::nav_panel( - "Reproduce", - bslib::layout_sidebar( - sidebar = bslib::sidebar( - sliderInput( - "min_width", - "Minimum petal width", - min(iris$Petal.Width), - max(iris$Petal.Width), - min(iris$Petal.Width), - step = 0.1 - ), - selectInput( - "summary_fn", - "Summary function", - c(Mean = "mean", Median = "median", `Std. dev` = "sd") - ), - checkboxGroupInput( - "columns", - "Columns to summarise", - c("Sepal.Length", "Sepal.Width", "Petal.Length"), - selected = "Sepal.Width" - ), - actionButton("update", "Update", class = "btn-primary") - ), - bslib::layout_columns( - bslib::card(bslib::card_header("Output"), tableOutput("table")), - bslib::card(bslib::card_header("Reproducible script"), verbatimTextOutput("code")) - ) - ) - ), - - bslib::nav_panel( - "Environment", - bslib::card( - bslib::card_header("Choose what to pin"), - p( - "The packages below were detected in the reactive by ", code("reprex_packages()"), - ". Narrow the selection, or add a package the detector could not see, then ", - "download a lockfile scoped to that choice." - ), - uiOutput("package_picker"), - downloadButton("custom_lock", "Download selected", class = "btn-secondary") - ) - ), + bslib::nav_panel("Summary (purrr)", summaryUI("summary")), + bslib::nav_panel("Counts (dplyr)", countsUI("counts")), bslib::nav_spacer(), - bslib::nav_item(lockfileUI("lock", "Download renv.lock")) + bslib::nav_menu( + "Options", + icon = shiny::icon("cog"), + align = "right", + bslib::nav_item( + checkboxGroupInput("packages", "Select Packages", choices = NULL, selected = NULL) + ), + bslib::nav_item( + downloadLink("lockfile", "Download renv.lock", class = "dropdown-item") + ) + ) ) +#### Server #### server <- function(input, output, session) { - iris_filt <- reactive({ - iris[iris$Petal.Width >= input$min_width, ] - }) |> - bindEvent(input$update, ignoreNULL = FALSE) - - summary_tbl <- reactive({ - purrr::map( - input$columns, - dat = iris_filt(), - 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) - - output$table <- renderTable(summary_tbl()) - - # Bound to the reactive so the script only refreshes when the output does. - output$code <- renderText(reprex_reactive(summary_tbl)) |> - bindEvent(summary_tbl()) - - # 1. The drop-in: one control in the navbar, pinning everything detected. - lockfileServer("lock", summary_tbl) - - # 2. The custom path: same engine, user-selected packages. - detected <- reactive(reprex_packages(summary_tbl)) |> - bindEvent(summary_tbl()) - - output$package_picker <- renderUI({ - checkboxGroupInput("packages", NULL, choices = detected(), selected = detected()) + 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() + ) }) - output$custom_lock <- downloadHandler( + output$lockfile <- downloadHandler( filename = function() "renv.lock", content = function(file) { - reprex_lockfile(summary_tbl, packages = input$packages, lockfile = file) + withProgress(message = "Resolving package versions", { + reprex_lockfile(packages = input$packages, lockfile = file) + }) } ) } diff --git a/tests/testthat/test-examples-shiny.R b/tests/testthat/test-examples-shiny.R index ca9a61e..9424120 100644 --- a/tests/testthat/test-examples-shiny.R +++ b/tests/testthat/test-examples-shiny.R @@ -4,47 +4,66 @@ app_dir <- function(name) { path } -test_that("The lockfile example app generates a script that reproduces its own output", { +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"), { - session$setInputs( - min_width = 0.5, - summary_fn = "median", - columns = c("Sepal.Width", "Petal.Length"), - update = 1 + 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( - eval(parse(text = output$code), envir = new.env()), - summary_tbl() + 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 lockfile example app offers a restorable lockfile from both the module and the custom picker", { +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"), { - session$setInputs( - min_width = 0.5, - summary_fn = "median", - columns = "Sepal.Width", - update = 1, - packages = "purrr" - ) + set_module_inputs(session) # Reading a download output runs its content function and returns the path. - for (lock in c(output$`lock-download`, output$custom_lock)) { - parsed <- renv::lockfile_read(lock) - expect_identical(parsed$R$Version, as.character(getRversion())) - expect_identical( - parsed$Packages$purrr$Version, - as.character(utils::packageVersion("purrr")) - ) - } + parsed <- renv::lockfile_read(output$lockfile) + + expect_identical(parsed$R$Version, as.character(getRversion())) + expect_true(all(c("purrr", "dplyr") %in% names(parsed$Packages))) }) }) From ecb00c7d7a6437139652df7194936bcb395538e2 Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Mon, 31 Aug 2026 14:20:14 +0100 Subject: [PATCH 6/8] Updating layout of lockfile example app --- R/reprex_lockfile.R | 5 +++- inst/examples-shiny/lockfile/app.R | 43 +++++++++++++++++---------- tests/testthat/test-reprex_lockfile.R | 29 ++++++++++++++++++ 3 files changed, 60 insertions(+), 17 deletions(-) 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/inst/examples-shiny/lockfile/app.R b/inst/examples-shiny/lockfile/app.R index 392df61..95ccfa2 100644 --- a/inst/examples-shiny/lockfile/app.R +++ b/inst/examples-shiny/lockfile/app.R @@ -107,22 +107,31 @@ countsServer <- function(id) { #### UI #### ui <- bslib::page_navbar( title = "shinyreprex", - - bslib::nav_panel("Summary (purrr)", summaryUI("summary")), - bslib::nav_panel("Counts (dplyr)", countsUI("counts")), - - bslib::nav_spacer(), - bslib::nav_menu( - "Options", - icon = shiny::icon("cog"), - align = "right", - bslib::nav_item( - checkboxGroupInput("packages", "Select Packages", choices = NULL, selected = NULL) + 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." ), - bslib::nav_item( - downloadLink("lockfile", "Download renv.lock", class = "dropdown-item") + 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 #### @@ -137,9 +146,11 @@ server <- function(input, output, session) { session = session, inputId = "packages", choices = detected(), - selected = detected() + selected = detected(), + inline = TRUE ) - }) + }) |> + bindEvent(detected(), once = TRUE) output$lockfile <- downloadHandler( filename = function() "renv.lock", 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() From e6dac7db282cc3091412654712394fb11864f216 Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Mon, 31 Aug 2026 14:34:02 +0100 Subject: [PATCH 7/8] (doc): add additional functionality to README and vignette --- README.md | 47 ++++++++++++ vignettes/shinyreprex.Rmd | 152 ++++++++++++++++++++++++++++++++++++-- 2 files changed, 194 insertions(+), 5 deletions(-) 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/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. From 7046c3833171dc4d47d830607022adbca6e6520e Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Mon, 31 Aug 2026 14:34:36 +0100 Subject: [PATCH 8/8] (fix): reorder packages in DESCRIPTION --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e597929..b8e6ce3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,8 +17,8 @@ Imports: cli, constructive, purrr, - rlang, renv, + rlang, styler Suggests: dplyr,