setup_reprex

NAMESPACE

@@ -133,6 +133,7 @@ export(opts_tbl_df)
 export(opts_ts)
 export(opts_vctrs_list_of)
 export(opts_weakref)
+export(setup_reprex)
 import(rlang)
 importFrom(methods,getSlots)
 importFrom(roxygen2,roxy_tag_parse)

R/construct_reprex.R

@@ -2,9 +2,11 @@
 #'
 #' @description
 #'
-#' `construct_reprex()` constructs all objects of the local environment,
+#' * `construct_reprex()` constructs all objects of the local environment,
 #'   or a caller environment `n` steps above. If `n > 0` the function call
 #'   is also included in a comment.
+#' * `setup_reprex()` sets up a function `fun` so it will call `construct_reprex()`
+#'   with the same additional arguments next time `fun` is called.
 #'
 #' @details
 #'
@@ -26,10 +28,11 @@
 #' encounter these limitations please do open a ticket on our issue tracker
 #' at `https://github.com/cynkra/constructive/` and we might expand the feature.
 #'
+#' @param fun A function
 #' @param n The number of steps to go up on the call stack
 #' @param ... Forwarded to `construct_multi()`
 #'
-#' @return Returns return `NULL` invisibly, called for side-effects.
+#' @return Both functions are called for side-effects and return `NULL` invisibly.
 #' @export
 construct_reprex <- function(n = 0, ...) {
   stopifnot(n >= 0)
@@ -41,6 +44,14 @@ construct_reprex <- function(n = 0, ...) {
   call <- sys.call(-n)
   fun <- sys.function(-n)
 
+  on.exit({
+    if (!is.null(attr(fun, "constructive_modified_from"))) {
+      fun_chr <- sub("^.*?::(.*)$", "\\1", paste(deparse(call[[1]]), collapse = ""))
+      ns <- topenv(environment(fun))
+      assignInNamespace(fun_chr, attr(fun, "constructive_modified_from"), ns)
+    }
+  })
+
   # output ---------------------------------------------------------------------
   if (length(names(caller_env))) {
     constructed <- construct_multi(caller_env, ...)

R/s3-constructive_options.R

@@ -44,14 +44,15 @@ constructors$constructive_options$opts <- function(x, ...) {
   fun <- paste0("constructive::opts_", suffix)
   # don't name the constructor arg, and don't provide if it's the default
   constructor_pos <- which("constructor" == rlang::names2(x))
+  x_bkp <- x
   if (length(constructor_pos)) {
     names(x)[[constructor_pos]] <- ""
     if (x[[constructor_pos]] == as.list(eval(parse(text = fun)))$constructor[[2]]) {
       x[[constructor_pos]] <- NULL
     }
   }
   code <- .cstr_apply(x, fun, ...)
-  repair_attributes_constructive_options(x, code, ...)
+  repair_attributes_constructive_options(x_bkp, code, ...)
 }
 
 repair_attributes_constructive_options <- function(x, code, ..., pipe = NULL) {

R/setup_reprex.R

@@ -0,0 +1,39 @@
+#' @export
+#' @rdname construct_reprex
+setup_reprex <- function(fun, ...) {
+  fun_lng <- substitute(fun)
+  env <- environment(fun)
+  fun_is_namespaced <-
+    is.call(fun_lng) && (
+      identical(fun_lng[[1]], quote(`::`)) ||
+        identical(fun_lng[[1]], quote(`:::`))
+
+    )
+  if (fun_is_namespaced) {
+    fun_chr <- as.character(fun_lng[[3]])
+  } else {
+    fun_chr <- as.character(fun_lng)
+  }
+  ns <- topenv(environment(fun))
+  body_ <- as.list(body(fun))
+
+  if (identical(body_[[1]], quote(`{`))) {
+    body_ <- as.list(body_[-1])
+  }
+
+  fun_bkp <- fun
+  tracing_code <- .cstr_apply(list(...), "constructive::construct_reprex")
+  tracing_code[[1]] <- paste("constructive_reprex <- ", tracing_code[[1]])
+  tracing_code <- parse(text = tracing_code)[[1]]
+  body(fun) <- as.call(
+    c(quote(`{`),
+      tracing_code,
+      quote(print(constructive_reprex)),
+      body_
+    ))
+  attr(fun, "constructive_modified_from") <- fun_bkp
+  # for cran checks
+  a_i_n <- get("assignInNamespace")
+  a_i_n(fun_chr, fun, ns)
+  invisible(NULL)
+}

tests/testthat/_snaps/s3-constructive_options.md

@@ -17,4 +17,8 @@
       construct(opts_Date(origin = "2020-01-01"))
     Output
       constructive::opts_Date(origin = "2020-01-01")
+    Code
+      construct(opts_data.frame("read.table"))
+    Output
+      constructive::opts_data.frame("read.table")
 

tests/testthat/test-s3-constructive_options.R

@@ -4,5 +4,6 @@ test_that("constructive_options", {
     construct(opts_Date("as.Date"), opts_constructive_options("next"))
     construct(opts_Date("new_date"))
     construct(opts_Date(origin = "2020-01-01"))
+    construct(opts_data.frame("read.table"))
   })
 })