Function which takes function as input and makes its expressions visible when called

Building on this SO question here I want to write a function that manipulates other functions by (1) setting each line visible () and by (2) wrapping withAutoprint({}) around the body of the function. First, I though some call to trace() would yield my desired result, but somehow I can't figure it out.

Here is a simple example:

# Input function foo
foo <- function(x)
{
  line1 <- x
  line2 <- 0
  line3 <- line1 + line2
  return(line3)
}

# some function which alters foo (here called make_visible() )
foo2 <- make_visible(foo)

# so that foo2 looks like this after being altered
foo2 <- function(x)
{
 withAutoprint({
  (line1 <- x)
  (line2 <- 0)
  (line3 <- line1 + line2)

  (return(line3))
 })
}

# example of calling foo2 and desired output/result
> foo2(2)
> (line1 <- x)
[1] 2
> (line2 <- 0)
[1] 0
> (line3 <- line1 + line2)
[1] 2
> (return(line3))
[1] 2

background / motivation

Turning functions visible line by line is helpful with longer custom functions when no real error is thrown, but the functions takes a wrong turn and returns and unwanted output. The alternative is using the debugger clicking next and checking each variable step by step. A function like make_visible might save some time here.

Use case

I see an actual use case for this kind of function, when debugging map or lapply functions which do not through an error, but produce an undesired result somewhere in the function that is being looped over.

Solution

Here's a solution that creates exactly the body of the solution you proposed in your question, with the addition of the 2 tests you used in your answer :

make_visible <- function(f) {
  if (typeof(f) %in% c("special", "builtin")) {
    stop("make_visible cannot be applied to primitive functions")
  }

  if (! typeof(f) %in% "closure") {
    stop("make_visible only takes functions of type closures as argument")
  }
  f2 <- f
  bod <- body(f)
  if(!is.call(bod) || !identical(bod[[1]], quote(`{`)))
    bod <- call("(",body(f))
  else
    bod[-1] <- lapply(as.list(bod[-1]), function(expr) call("(", expr))
  body(f2) <- call("[[",call("withAutoprint", bod),"value")
  f2
}

# solve foo issue with standard adverb way
foo <- function(x)
{
  line1 <- x
  line2 <- 0
  line3 <- line1 + line2
  return(line3)
}

foo2 <- make_visible(foo)

foo2
#> function (x) 
#> withAutoprint({
#>     (line1 <- x)
#>     (line2 <- 0)
#>     (line3 <- line1 + line2)
#>     (return(line3))
#> })[["value"]]

foo2(2)
#> > (line1 <- x)
#> [1] 2
#> > (line2 <- 0)
#> [1] 0
#> > (line3 <- line1 + line2)
#> [1] 2
#> > (return(line3))
#> [1] 2
#> [1] 2

Here's another take, printing nicer as your own second proposal :

make_visible2 <- function(f) {
  if (typeof(f) %in% c("special", "builtin")) {
    stop("make_visible cannot be applied to primitive functions")
  }

  if (! typeof(f) %in% "closure") {
    stop("make_visible only takes functions of type closures as argument")
  }
  f2 <- f
  bod <- body(f)
  if(!is.call(bod) || !identical(bod[[1]], quote(`{`))) {
    bod <- bquote({
      message(deparse(quote(.(bod))))
      print(.(bod))
    })
  }  else {
    bod[-1] <- lapply(as.list(bod[-1]), function(expr) {
      bquote({
        message(deparse(quote(.(expr))))
        print(.(expr))
      })
    })
  }
  body(f2) <- bod
  f2
}

foo3 <- make_visible2(foo)
foo3
#> function (x) 
#> {
#>     {
#>         message(deparse(quote(line1 <- x)))
#>         print(line1 <- x)
#>     }
#>     {
#>         message(deparse(quote(line2 <- 0)))
#>         print(line2 <- 0)
#>     }
#>     {
#>         message(deparse(quote(line3 <- line1 + line2)))
#>         print(line3 <- line1 + line2)
#>     }
#>     {
#>         message(deparse(quote(return(line3))))
#>         print(return(line3))
#>     }
#> }

foo3(2)
#> line1 <- x
#> [1] 2
#> line2 <- 0
#> [1] 0
#> line3 <- line1 + line2
#> [1] 2
#> return(line3)
#> [1] 2