Modernize debug

Author: HenrikBengtsson

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: future.batchtools
-Version: 0.12.1-9008
+Version: 0.12.1-9009
 Depends:
     R (>= 3.2.0),
     parallelly,

R/utils-debug.R

@@ -0,0 +1,73 @@
+now <- function(x = Sys.time(), format = "[%H:%M:%OS3] ") {
+  ## format(x, format = format) ## slower
+  format(as.POSIXlt(x, tz = ""), format = format)
+}
+
+debug_indent <- local({
+  symbols <- rep(c("|", ":", ".", "'", ",", ";", "`"), times = 10L)
+  function() {
+    depth <- length(.debug[["stack"]])
+    if (depth == 0) return("")
+    indent <- getOption("future.debug.indent", " ")
+    paste(paste(symbols[seq_len(depth)], indent, sep = ""), collapse = "")
+  }
+})
+
+if (!exists(".debug", inherits = FALSE)) .debug <- new.env(parent = emptyenv())
+if (!"stack" %in% names(".debug")) .debug$stack <- list()
+
+mdebug_push <- function(...) {
+  msg <- mdebug(...)
+  .debug$stack <- c(.debug$stack, msg)
+  invisible(msg)
+}
+
+mdebugf_push <- function(...) {
+  msg <- mdebugf(...)
+  .debug$stack <- c(.debug$stack, msg)
+  invisible(msg)
+}
+
+mdebug_pop <- function(...) {
+  n <- length(.debug$stack)
+  msg <- c(...)
+  if (length(msg) == 0) {
+    msg <- .debug$stack[n]
+    msg <- sprintf("%s done", msg)
+  }
+  .debug$stack <- .debug$stack[-n]
+  if (length(msg) == 0 || !is.na(msg)) mdebug(msg)
+}
+
+mdebugf_pop <- function(...) {
+  n <- length(.debug$stack)
+  msg <- .debug$stack[n]
+  .debug$stack <- .debug$stack[-n]
+  mdebug(sprintf("%s done", msg))
+}
+
+mdebug <- function(..., prefix = now()) {
+  prefix <- paste(prefix, debug_indent(), sep = "")
+  msg <- paste(..., sep = "")
+  message(sprintf("%s%s", prefix, msg))
+  invisible(msg)
+}
+
+mdebugf <- function(..., appendLF = TRUE, prefix = now()) {
+  prefix <- paste(prefix, debug_indent(), sep = "")
+  msg <- sprintf(...)
+  message(sprintf("%s%s", prefix, msg), appendLF = appendLF)
+  invisible(msg)
+}
+
+#' @importFrom utils capture.output
+mprint <- function(..., appendLF = TRUE, prefix = now()) {
+  prefix <- paste(prefix, debug_indent(), sep = "")
+  message(paste(prefix, capture.output(print(...)), sep = "", collapse = "\n"), appendLF = appendLF)
+}
+
+#' @importFrom utils capture.output str
+mstr <- function(..., appendLF = TRUE, prefix = now()) {
+  prefix <- paste(prefix, debug_indent(), sep = "")
+  message(paste(prefix, capture.output(str(...)), sep = "", collapse = "\n"), appendLF = appendLF)
+}

R/utils.R

@@ -46,35 +46,6 @@ capture_output <- function(expr, envir = parent.frame(), ...) {
 
 printf <- function(...) cat(sprintf(...))
 
-now <- function(x = Sys.time(), format = "[%H:%M:%OS3] ") {
-  ## format(x, format = format) ## slower
-  format(as.POSIXlt(x, tz = ""), format = format)
-}
-
-mdebug <- function(..., debug = getOption("future.debug", FALSE)) {
-  if (!debug) return()
-  message(now(), ...)
-}
-
-mdebugf <- function(..., appendLF = TRUE,
-                    debug = getOption("future.debug", FALSE)) {
-  if (!debug) return()
-  message(now(), sprintf(...), appendLF = appendLF)
-}
-
-#' @importFrom utils capture.output
-mprint <- function(..., appendLF = TRUE, debug = getOption("future.debug", FALSE)) {
-  if (!debug) return()
-  message(paste(now(), capture.output(print(...)), sep = "", collapse = "\n"), appendLF = appendLF)
-}
-
-#' @importFrom utils capture.output str
-mstr <- function(..., appendLF = TRUE, debug = getOption("future.debug", FALSE)) {
-  if (!debug) return()
-  message(paste(now(), capture.output(str(...)), sep = "", collapse = "\n"), appendLF = appendLF)
-}
-
-
 ## From R.utils 2.0.2 (2015-05-23)
 hpaste <- function(..., sep="", collapse=", ", last_collapse=NULL,
                    max_head=if (missing(last_collapse)) 3 else Inf,