debuggable.R

#' Turn a function into a new function that helps debugging upon exception
#' 
#' @param fn the function to transform
#' @param saveFile an optional path to save RDS to, if NULL output will be in global variable '.problem'
#' @return new function that behaves like fn(...) normally, but if fn(...) throws an exception saves to variable or saveFile RDS of list .problem such that do.call(.problem$fn_name,.problem$args) repeats the call to fn with args.
#'
#' @examples 
#' sum_of_log <- function(x, y){
#'   stopifnot(x>=0)
#'   stopifnot(y>=0)
#'   return(log(x)+log(y))
#' }
#' 
#' sum_of_log2 <- debuggable(sum_of_log, "problem.RDS")
#' 
#' sum_of_log2(1,2)
#' sum_of_log2(1,-2)
#' 
#' .problem
#' 
#' do.call(.problem$fn_name, .problem$args)
#' 
#' @references 
#' inspired from http://winvector.github.io/Debugging/
#' 
debuggable <- function(fn, saveFile=NULL){

  fn_name <- as.character(match.call())[2]
  
  new_fn <- function(...){
    
    
    args <- list(...)
    tryCatch({
      res = do.call(fn,args)
      res
    },
    error = function(e) {
      out <- list(fn_name=fn_name,args=args, fn_def = fn)
      if (is.null(saveFile)){
        .problem <<- out
        stop(paste0("Wrote object '.problem' on catching '",as.character(e),"'",
                    "\n You can reproduce the error with:\n'do.call(.problem$fn_name, .problem$args)'"))
      }else{
        saveRDS(out,file=saveFile)
        stop(paste0("Wrote '",saveFile,"' on catching '",as.character(e),"'",
                    "\n You can reproduce the error with:\n'p <- readRDS('",saveFile,"'); do.call(p$fn_name, p$args)'"))
      }
    })
    
  }
  
  return(new_fn)
}