Add new function scenarios to code chunks

.Rbuildignore

@@ -7,3 +7,5 @@
 ^\.covrignore$
 ^CRAN-SUBMISSION$
 ^cran-comments\.md$
+^\.positai$
+^\.claude$

.gitignore

@@ -7,3 +7,5 @@ inst/doc
 docs
 
 CRAN-SUBMISSION
+.Rproj.user
+.positai

DESCRIPTION

@@ -43,6 +43,7 @@ Collate:
     'call_chunk_reactval.R'
     'call_chunk_shiny.R'
     'call_chunk_subset.R'
+    'call_chunk_switch.R'
     'call_chunk_utils.R'
     'repro_chunk.R'
     'chunk_call.R'

R/S7_utils.R

@@ -29,13 +29,18 @@
 #' \item{class_call_reactval}{
 #' The class capturing evaluated [shiny::reactiveValues()] objects
 #' }
+#' \item{class_call_reactval_setter}{
+#' The class capturing [shiny::reactiveVal()] setter calls, which are skipped
+#' with a warning as they cannot be reproduced outside of Shiny
+#' }
 #' \item{class_call_if}{The class capturing `if` calls}
+#' \item{class_call_switch}{The class capturing `switch` calls}
 #' \item{class_call_null}{The class capturing undefined calls, such as `pkg::fn`}
 #' \item{class_call_shiny}{
 #' The class capturing ignorable shiny function calls such as
 #' [shiny::req()] and [shiny::validate()]
 #' }
-#' \item{class_call_subset}{The class capturing a subset (`$`) call}
+#' \item{class_call_subset}{The class capturing a subset (`$`) or a double-bracket subset (`[[`) call}
 #' }
 #'
 #' @usage NULL
@@ -52,7 +57,9 @@ class_bind_reactive <- S7::new_union(class_event_reactive, class_event_cache)
 class_call_function <- S7::new_S3_class("function")
 class_call_reactive <- S7::new_S3_class(".__reactive")
 class_call_reactval <- S7::new_S3_class(".__reactval")
+class_call_reactval_setter <- S7::new_S3_class(".__reactval_setter")
 class_call_if <- S7::new_S3_class("if")
+class_call_switch <- S7::new_S3_class("switch")
 class_call_null <- S7::new_S3_class("NULL")
 class_call_shiny <- S7::new_union(S7::new_S3_class("req"), S7::new_S3_class("validate"))
-class_call_subset <- S7::new_S3_class("$")
+class_call_subset <- S7::new_union(S7::new_S3_class("$"), S7::new_S3_class("[["))

R/call_chunk_reactval.R

@@ -2,6 +2,17 @@
 #' Extracting the contents of the `reactiveVal` in a human-readable way
 #'
 #' @noRd
+S7::method(repro_call_chunk, class_call_reactval_setter) <- function(x,
+                                                                     repro_code = Repro(),
+                                                                     env = rlang::caller_env()) {
+  warning(
+    "`", rlang::call_name(x), "()` is a reactiveVal setter and has been omitted from the ",
+    "reproduced script - setting reactive values cannot be reproduced outside of Shiny",
+    call. = FALSE
+  )
+  repro_code
+}
+
 S7::method(repro_call_chunk, class_call_reactval) <- function(x, repro_code = Repro(), env = rlang::caller_env()) {
   reactive_val <- construct_reactive(x, env = env)
   eval_call <- str2lang(paste(rlang::call_name(x), "<-", reactive_val))

R/call_chunk_switch.R

@@ -0,0 +1,48 @@
+#' @description
+#' When reproducing a `switch` call, only the branch matching the current value of
+#' the switch expression should be included in the output, rather than all branches.
+#'
+#' Fall-through alternatives (empty values, e.g. `"a" =,`) are resolved by walking
+#' forward to the next non-empty branch. If no named alternative matches, the unnamed
+#' default (last unnamed argument) is used. When there is no match and no default,
+#' an empty `Repro` object is returned.
+#'
+#' @include repro_call_chunk.R
+#' @noRd
+S7::method(repro_call_chunk, class_call_switch) <- function(x, repro_code = Repro(), env = rlang::caller_env()) {
+  switch_args <- rlang::call_args(x)
+  check <- eval(switch_args[[1L]], envir = env)
+  alternatives <- switch_args[-1L]
+  alt_names <- names(alternatives)
+
+  matched_idx <- match(check, alt_names)
+
+  # Walk forward through fall-through (empty/missing) alternatives
+  if (!is.na(matched_idx)) {
+    while (matched_idx <= length(alternatives) && rlang::is_missing(alternatives[[matched_idx]])) {
+      matched_idx <- matched_idx + 1L
+    }
+  }
+
+  # Fall back to unnamed default if no named match
+  if (is.na(matched_idx) || matched_idx > length(alternatives)) {
+    default_positions <- which(alt_names == "")
+    matched_idx <- if (length(default_positions) > 0L) tail(default_positions, 1L) else NA_integer_
+  }
+
+  # No matching branch and no default
+  if (is.na(matched_idx)) return(repro_code)
+
+  branch <- alternatives[[matched_idx]]
+  branch_exprs <- if (rlang::is_call(branch, "{")) as.list(branch)[-1L] else list(branch)
+
+  check_calls <- purrr::map(branch_exprs, repro_chunk, env = env)
+  repro_code@packages <- purrr::map(check_calls, "packages") |> unlist()
+  repro_code@prerequisites <- purrr::map(check_calls, "prerequisites") |>
+    purrr::discard(identical, list()) |>
+    unlist(recursive = FALSE)
+
+  repro_code@packages <- get_pkg_name(x)
+  repro_code@code <- purrr::map(check_calls, "code") |> unlist(recursive = FALSE)
+  repro_code
+}

R/call_chunk_utils.R

@@ -33,13 +33,25 @@ is_reactive_val_call <- function(x, env = rlang::caller_env()) {
     inherits(env[[rlang::call_name(x)]], "reactiveVal")
 }
 
+#' @description
+#' `is_reactive_val_setter_call` checks whether or not the call is setting the value
+#' of a `shiny::reactiveVal` variable.
+#'
+#' @rdname call_chunk_checks
+is_reactive_val_setter_call <- function(x, env = rlang::caller_env()) {
+  rlang::is_call(x) &&
+    length(rlang::call_args(x)) == 1L &&
+    rlang::call_name(x) %in% names(env) &&
+    inherits(env[[rlang::call_name(x)]], "reactiveVal")
+}
+
 #' @description
 #' `is_reactive_values_call` checks whether or not the call is evaluating an item
 #' within a `shiny::reactiveValues` variable.
 #'
 #' @rdname call_chunk_checks
 is_reactive_values_call <- function(x, env = rlang::caller_env()) {
-  rlang::is_call(x, "$") &&
+  (rlang::is_call(x, "$") || rlang::is_call(x, "[[")) &&
     tryCatch(inherits(get(rlang::call_args(x)[[1]], envir = env), "reactivevalues"), error = \(e) FALSE) &&
     as.character(rlang::call_args(x)[[1]]) != "input"
 }
@@ -71,7 +83,7 @@ is_variable_call <- function(x, existing_vars = NULL, env = rlang::caller_env())
 #'
 #' @rdname call_chunk_checks
 is_input_call <- function(x) {
-  rlang::is_call(x, "$") &&
+  (rlang::is_call(x, "$") || rlang::is_call(x, "[[")) &&
     startsWith(as.character(x)[[2]], "input")
 }
 
@@ -81,7 +93,7 @@ is_input_call <- function(x) {
 #'
 #' @rdname call_chunk_checks
 is_session_user_data <- function(x) {
-  rlang::is_call(x, "$") &&
+  (rlang::is_call(x, "$") || rlang::is_call(x, "[[")) &&
     startsWith(as.character(x)[[2]], "session$userData")
 }
 

R/chunk_call.R

@@ -9,13 +9,18 @@ S7::method(repro_chunk, S7::class_call) <- function(x, repro_code = Repro(), env
   call_env <- env
   call_name <- rlang::call_name(x) %||% "NULL"
 
-  if (is_reactive_val_call(x, env)) {
+
+  if (is_reactive_val_setter_call(x, env)) {
+    # reactiveVal setter: warn and skip
+    call_name <- ".__reactval_setter"
+  } else if (is_reactive_val_call(x, env)) {
+    # reactiveVal getter: evaluate and include
     call_name <- ".__reactval"
-    # Reactive object created within the module
   } else if (is_reactive_call(x, env)) {
+    # Reactive object created within the module
     call_name <- ".__reactive"
-    # Reactive object sent to the module
   } else if (is_reactive_call(x, parent.env(env))) {
+    # Reactive object sent to the module
     call_name <- ".__reactive"
     call_env <- parent.env(env)
   }

tests/testthat/test-call_chunk_reactval.R

@@ -29,3 +29,57 @@ test_that("Able to extract a data.frame from a reactiveVal", {
   expect_match(deparse1(repro_react_val@code[[1]]), "my_react_val <- data.frame(", fixed = TRUE)
   expect_match(repro_react_val@calls[1], "my_react_val <- data.frame(", fixed = TRUE)
 })
+
+test_that("reactiveVal setter call raises a warning and returns empty Repro", {
+  my_react_val <- shiny::reactiveVal(1L)
+  setter_call <- str2lang("my_react_val(42L)")
+  class(setter_call) <- c(".__reactval_setter", class(setter_call))
+
+  expect_warning(
+    repro_setter <- shiny::isolate(repro_call_chunk(setter_call)),
+    "`my_react_val()` is a reactiveVal setter",
+    fixed = TRUE
+  )
+  expect_s7_class(repro_setter, Repro)
+  expect_identical(repro_setter@code, list())
+})
+
+test_that("reactiveVal setter is omitted but getter still produces output in a full reactive", {
+  test_server <- function(input, output, session) {
+    my_val <- shiny::reactiveVal(0)
+
+    test_reactive <- reactive({
+      my_val(input$new_value)
+      my_val()
+    })
+
+    output$my_val <- renderText({
+      req(input$set_new_value)
+      test_reactive()
+    })
+  }
+
+  shiny::testServer(
+    test_server,
+    expr = {
+      session$setInputs(new_value = 42L)
+
+      expect_warning(
+        repro_code <- reprex_reactive(test_reactive),
+        "`my_val()` is a reactiveVal setter",
+        fixed = TRUE
+      )
+      # Setter is skipped; getter reflects the current (pre-update) value
+      expect_no_match(repro_code, "my_val(42", fixed = TRUE)
+      expect_match(repro_code, "my_val <- 0")
+
+      session$setInputs(set_new_value = TRUE)
+      expect_warning(
+        repro_code <- reprex_reactive(test_reactive),
+        "`my_val()` is a reactiveVal setter",
+        fixed = TRUE
+      )
+      expect_match(repro_code, "my_val <- 42")
+    }
+  )
+})

tests/testthat/test-call_chunk_subset.R

@@ -31,3 +31,37 @@ test_that("Subset chunk evaluates an reactiveValue and stores assignment in Repr
   expect_identical(repro_subset@code, list(str2lang("width_range <- c(4, 6.5)")))
   expect_identical(repro_subset@calls, "width_range <- c(4, 6.5)")
 })
+
+test_that("Double bracket subset chunk maintains the same for a static R object", {
+  subset_call <- str2lang('iris[["Sepal.Width"]]')
+  class(subset_call) <- c("[[", class(subset_call))
+
+  repro_subset <- repro_call_chunk(subset_call)
+  expect_s7_class(repro_subset, Repro)
+  expect_identical(repro_subset@code, list(str2lang('iris[["Sepal.Width"]]')))
+  expect_identical(repro_subset@calls, 'iris[["Sepal.Width"]]')
+})
+
+test_that("Double bracket subset chunk evaluates an input call and stores in Repro object", {
+  subset_call <- str2lang('input[["width_range"]]')
+  class(subset_call) <- c("[[", class(subset_call))
+
+  session <- shiny::MockShinySession$new()
+  session$setInputs(width_range = c(4, 6.5))
+
+  repro_subset <- shiny::isolate(repro_call_chunk(subset_call, env = session))
+  expect_s7_class(repro_subset, Repro)
+  expect_identical(repro_subset@code, list(str2lang("c(4, 6.5)")))
+  expect_identical(repro_subset@calls, "c(4, 6.5)")
+})
+
+test_that("Double bracket subset chunk evaluates a reactiveValues item and stores assignment in Repro object", {
+  subset_call <- str2lang('rv[["width_range"]]')
+  class(subset_call) <- c("[[", class(subset_call))
+  rv <- shiny::reactiveValues(width_range = c(4, 6.5))
+
+  repro_subset <- shiny::isolate(repro_call_chunk(subset_call))
+  expect_s7_class(repro_subset, Repro)
+  expect_identical(repro_subset@code, list(str2lang("width_range <- c(4, 6.5)")))
+  expect_identical(repro_subset@calls, "width_range <- c(4, 6.5)")
+})