boomer.ignore.inside

R/boomer-package.R

@@ -27,9 +27,12 @@
 #'   and their values when they are evaluated. Defaults to `TRUE`.
 #' - `boomer.visible_only`: Whether to hide the output of functions which return
 #'   invisibly. Defaults to `FALSE`.
-#' - `boomer.ignore`: Vector of functions for which we don't want the result
+#' - `boomer.ignore`: Vector of function names for which we don't want the result
 #'   printed (usually because it's redundant). Defaults to
-#'   `c("~", "{", "(", "<-", "<<-", "=")`
+#'   `c("~", "{", "(", "<-", "<<-", "=")`.
+#' - `boomer.ignore.inside`: list of functions (values, not names) for which we
+#'   don't want the arguments boomed, this might be useful when calling a
+#'   function that loops too many times.
 #' - `boomer.safe_print`: Whether to replace emoticons by characters compatible
 #'   with all systems. This is useful for reprexes (see \pkg{reprex} package) and
 #'   for knitted report in case the output of those doesn't look good on your system.

R/wrap.R

@@ -63,7 +63,6 @@ wrap <- function(fun_val, clock, print_fun, rigged_nm = NULL, wrapped_nm = NA, m
     print_args <- getOption("boomer.print_args")
     safe_print <- getOption("boomer.safe_print")
 
-
     wrapped_fun_caller_env <- parent.frame()
     # fetch rigged function's execution env, it's the wrapped_fun_caller_env
     # only at the top level
@@ -85,15 +84,28 @@ wrap <- function(fun_val, clock, print_fun, rigged_nm = NULL, wrapped_nm = NA, m
     signal_rigged_function_and_args(rigged_nm, mask, ej, print_args, rigged_fun_exec_env)
 
     # build calls to be displayed on top and bottom of wrapped call
-    deparsed_calls <- build_deparsed_calls(sc, ej, globals$n_indent)
+
+    ignore.inside <-
+      !is.null(mask) &&
+      any(vapply(getOption("boomer.ignore.inside"), identical, logical(1), fun_val))
+    deparsed_calls <- build_deparsed_calls(sc, ej, globals$n_indent, force_single_line = ignore.inside)
 
     # display wrapped call at the top if relevant
     if (!is.null(deparsed_calls$open)) {
       cat(deparsed_calls$open, "\n")
     }
 
     # evaluate call with original wrapped function
-    res <- try(eval_wrapped_call(sc, fun_val, clock, wrapped_fun_caller_env), silent = TRUE)
+    if (ignore.inside) {
+      # remove the mask
+      parent.env(wrapped_fun_caller_env) <- parent.env(mask)
+      res <- try(eval_wrapped_call(sc, fun_val, clock, wrapped_fun_caller_env), silent = TRUE)
+      # put back the mask
+      parent.env(wrapped_fun_caller_env) <- mask
+    } else {
+      res <- try(eval_wrapped_call(sc, fun_val, clock, wrapped_fun_caller_env), silent = TRUE)
+    }
+
     success <- !inherits(res, "try-error")
 
     # if rigged fun args have been evaled, print them
@@ -180,7 +192,7 @@ signal_rigged_function_and_args <- function(rigged_nm, mask, ej, print_args, rig
   }
 }
 
-build_deparsed_calls <- function(sc, ej, n_indent) {
+build_deparsed_calls <- function(sc, ej, n_indent, force_single_line = FALSE) {
   # manipulate call to use original function
   sc <- sc
 
@@ -190,9 +202,9 @@ build_deparsed_calls <- function(sc, ej, n_indent) {
   call_chr <- styler::style_text(call_chr)
 
   # if all args are "atomic" (symbols or numbers) we can print open and close in one go
-  all_args_are_atomic <- all(lengths(as.list(sc[-1])) == 1)
+  all_args_are_atomic <- force_single_line || all(lengths(as.list(sc[-1])) == 1)
   # we need a workaround for magrittr here
-  no_dot_in_args <- !any(sapply(sc[-1], identical, quote(.)))
+  no_dot_in_args <- force_single_line || !any(sapply(sc[-1], identical, quote(.)))
   if (length(call_chr) == 1) {
     if (all_args_are_atomic && no_dot_in_args) {
       deparsed_calls$close <-

tests/testthat/_snaps/ignore.inside.md

@@ -0,0 +1,71 @@
+# boom.ignore.inside
+
+    Code
+      options(boomer.ignore.inside = NULL)
+      data.frame(a = 1:3) %>% transform(b = a + 1) %>% boom()
+    Output
+      <  data.frame(a = 1:3) %>% transform(b = a + 1) 
+      . <  transform(., b = a + 1) 
+      . . <  data.frame(a = 1:3) 
+      . . . <  >  1:3 
+      . . . [1] 1 2 3
+      . . . 
+      . . >  data.frame(a = 1:3) 
+      . .   a
+      . . 1 1
+      . . 2 2
+      . . 3 3
+      . . 
+      . . <  >  a + 1 
+      . . [1] 2 3 4
+      . . 
+      . >  transform(., b = a + 1) 
+      .   a b
+      . 1 1 2
+      . 2 2 3
+      . 3 3 4
+      . 
+      >  data.frame(a = 1:3) %>% transform(b = a + 1) 
+        a b
+      1 1 2
+      2 2 3
+      3 3 4
+
+        a b
+      1 1 2
+      2 2 3
+      3 3 4
+    Code
+      options(boomer.ignore.inside = list(transform))
+      data.frame(a = 1:3) %>% transform(b = a + 1) %>% boom()
+    Output
+      <  data.frame(a = 1:3) %>% transform(b = a + 1) 
+      . . <  data.frame(a = 1:3) 
+      . . . <  >  1:3 
+      . . . [1] 1 2 3
+      . . . 
+      . . >  data.frame(a = 1:3) 
+      . .   a
+      . . 1 1
+      . . 2 2
+      . . 3 3
+      . . 
+      . <  >  transform(., b = a + 1) 
+      .   a b
+      . 1 1 2
+      . 2 2 3
+      . 3 3 4
+      . 
+      >  data.frame(a = 1:3) %>% transform(b = a + 1) 
+        a b
+      1 1 2
+      2 2 3
+      3 3 4
+
+        a b
+      1 1 2
+      2 2 3
+      3 3 4
+    Code
+      options(boomer.ignore.inside = NULL)
+

tests/testthat/test-ignore.inside.R

@@ -0,0 +1,13 @@
+test_that("boom.ignore.inside", {
+  expect_snapshot({
+    options("boomer.ignore.inside" = NULL)
+    data.frame(a = 1:3) %>%
+      transform( b = a + 1) %>%
+      boom()
+    options("boomer.ignore.inside" = list(transform))
+    data.frame(a = 1:3) %>%
+      transform( b = a + 1) %>%
+      boom()
+    options("boomer.ignore.inside" = NULL)
+  })
+})