Function to open the function in a new file editor

show_function()

show_function <- function(fun){
  tmp_dir <- tempdir()
  fun_expr <- enexpr(fun)
  if(rlang::is_call(fun_expr) &&
     (identical(fun_expr[[1]],quote(`::`)) || identical(fun_expr[[1]],quote(`:::`)))) {
    fun_name <- rlang::as_name(fun_expr[[3]])
  } else {
    fun_name <- rlang::as_name(fun_expr)
  }
  
  out_file <- file.path(tmp_dir,paste0(fun_name,".R"))
  
  fun_env <- environment(fun)
  
  if(isNamespace(fun_env)){
    env_var_ss <- c(paste0("# ",fun_name,"() is in the ",
                          gsub("namespace:","",rlang::env_label(fun_env)),
                          " namespace"),
                    "# so no environment variables loaded")
  } else if(length(ls(fun_env))>0){
    env_vars <- ls(fun_env)
    env_var_ss <- vapply(1:length(env_vars),
                         function(i)
                           paste0(env_vars[i]," <- environment(",fun_name,")[[\"",env_vars[i],"\"]]"),
                         character(1))
    env_var_ss <- c("# Loading environment variables",env_var_ss)
  } else {
    env_var_ss <- paste0("# No variables in ",fun_name,"() environment")
  }
  
  fun_formals <- formals(fun)
  if(length(fun_formals)>0){
    fun_formals <- fun_formals[names(fun_formals) != "..."]
    missing_formals <- vapply(fun_formals,rlang::is_missing,logical(1))
    
    if(any(!missing_formals)){
      default_formals <- fun_formals[!missing_formals]
      default_var_ss <- vapply(1:length(default_formals),
                               function(i)
                                 paste0(names(default_formals)[i],
                                        " <- ",
                                        default_formals[[i]] %||% "NULL"),
                               character(1))
      default_var_ss <- c("# Setting default arguments",
                          default_var_ss)
    } else {
      default_var_ss <- paste0("# No formals have default values")
    }
    
    if(any(missing_formals)){
      required_formals <- fun_formals[missing_formals]
      required_var_ss <- c("# These arguments are required",
                           names(required_formals))
    } else {
      required_var_ss <- ""
    }
    formals_var_ss <- c(default_var_ss,"",required_var_ss)
    
  } else {
    formals_var_ss <- paste0("# No formal arguments required for ",fun_name,"()")
  }
  
  fun_body <- body(fun)
  if(identical(fun_body[[1]],quote(`{`))){
    body_var_ss <- lapply(as.list(fun_body[-1]),deparse)
    body_var_ss <- purrr::flatten_chr(body_var_ss)
  } else {
    body_var_ss <- deparse(body(fun))
  }
  
  body_var_ss <- c("# Body of the function",body_var_ss)
  
  
  output_text <- c("",env_var_ss,"",formals_var_ss,"",body_var_ss)
  writeLines(output_text,out_file)
  file.edit(out_file)
  
}