Centralise value handling in one place

R/eval.R

@@ -217,7 +217,6 @@ evaluate_top_level_expression <- function(exprs,
   } else {
     handle <- force
   }
-  value_handler <- output_handler$value
   if (include_timing) {
     timing_fn <- function(x) system.time(x)[1:3]
   } else {
@@ -235,7 +234,6 @@ evaluate_top_level_expression <- function(exprs,
 
   user_handlers <- output_handler$calling_handlers
 
-  multi_args <- length(formals(value_handler)) > 1
   for (expr in exprs) {
     srcindex <- length(output)
     time <- timing_fn(handle(
@@ -250,14 +248,10 @@ evaluate_top_level_expression <- function(exprs,
     if (!is.null(time))
       attr(output[[srcindex]]$src, 'timing') <- time
 
-    # If visible or the value handler has multi args, process and capture output
-    if (ev$visible || multi_args) {
+    if (show_value(output_handler, ev$visible)) {
       pv <- list(value = NULL, visible = FALSE)
-      value_fun <- if (multi_args) value_handler else {
-        function(x, visible) value_handler(x)
-      }
       handle(pv <- withCallingHandlers(withVisible(
-        value_fun(ev$value, ev$visible)
+        handle_value(output_handler, ev$value, ev$visible)
       ), warning = wHandler, error = eHandler, message = mHandler))
       handle_output(TRUE)
       # If the return value is visible, save the value to the output

R/output.R

@@ -43,6 +43,23 @@
   }
 }
 
+# If the output handler has two arguments, then the user has opted into
+# handling the value regardless of whether it's not visible.
+show_value <- function(handler, visible) {
+  visible || length(formals(handler$value)) > 1
+}
+
+handle_value <- function(handler, value, visible) {
+  n_args <- length(formals(handler$value))
+  if (n_args == 1) {
+    handler$value(value)
+  } else if (n_args == 2) {
+    handler$value(value, visible)
+  } else {
+    stop("Value output handler must have one or two arguments")
+  }
+}
+
 classes <- function(x) vapply(x, function(x) class(x)[1], character(1))
 
 render <- function(x) if (isS4(x)) methods::show(x) else print(x)
@@ -78,9 +95,10 @@
 #' @param message Function to handle [message()] output.
 #' @param warning Function to handle [warning()] output.
 #' @param error Function to handle [stop()] output.
-#' @param value Function to handle the values returned from evaluation. If it
-#'   only has one argument, only visible values are handled; if it has more
-#'   arguments, the second argument indicates whether the value is visible.
+#' @param value Function to handle the values returned from evaluation. 
+#'   * If it has one argument, it called on visible values.
+#'   * If it has two arguments, it handles all values, with the second
+#'     argument indicating whether or not the value is visible.
 #' @param calling_handlers List of [calling handlers][withCallingHandlers].
 #'   These handlers have precedence over the exiting handler installed
 #'   by [evaluate()] when `stop_on_error` is set to 0.

tests/testthat/test-evaluate.R

@@ -114,6 +114,8 @@ test_that("invisible values can also be saved if value handler has two arguments
   handler <- new_output_handler(value = function(x, visible) {
     x  # always returns a visible value
   })
+  expect_true(show_value(handler, FALSE))
+
   ev <- evaluate("x<-1:10", output_handler = handler)
   expect_equal(classes(ev), c("source", "integer"))
 })