R/util_log.R

In ftwkoopmans/msdap: Mass Spectrometry Downstream Analysis Pipeline

#' Log function that takes any string, appends it to global log (log_ , a list) and prints to console
#'
#' @param x your message as a character string
#' @param type the type of message. options: info, progress, warning, error. For the latter, an R error is thrown after logging!
#'
#' @importFrom crayon red cyan blue silver
#' @export
logger.default = function(x, type = "info") {
  if (!exists("log_")) {
    reset_log()
  }
  log_[[length(log_)+1]] = c(x, type, Sys.time())
  log_ <<- log_

  x = paste0(type, ifelse(is.character(type) && nchar(type) > 0, ": ", ""), x, "\n")
  style = switch(type,
                 error = crayon::red$bold,
                 warning = crayon::red,
                 info = crayon::blue,
                 success = crayon::green
  )

  if (is.null(style)) {
    style = crayon::silver
  }

  cat(style(x))
}



#' clear the log by resetting global log_ variable
#'
#' @export
reset_log = function() {
  log_ <<- list()
}



log_type_to_color = function(type, format="hex") {
  clr = switch(type,
               error = c(red="#cc2516"),
               warning = c(orange="#cc2516"),
               success = c(green="#018023"),
               info = c(blue="#0f07a8"))
  if (is.null(clr)) {
    clr = c(gray="#555555")
  }

  return( ifelse(format=="hex", as.character(clr), names(clr)) )
}



#' This function is called throughout the pipeline to append messages to the log
#'
#' @param s your message as a character string
#' @param type the type of message. supported color-coding through logger.default: progress, info, warning, error. For the latter, an R error is thrown after logging!
#' @param start_time optionally, provide a start time generated by Sys.time() that should be compared to the current Sys.time()
#'
#' @export
append_log = function(s, type = "info", start_time=NULL) { # s="test"
  if (!exists("logger_msdap")) {
    logger_msdap = logger.default
  }

  # if a time interval is provided, append to log message
  if(!is.null(start_time) && length(start_time) == 1) {
    cur_time = Sys.time()
    time_delta_mins = as.numeric(difftime(cur_time, start_time, units = "mins"))
    if(time_delta_mins >= 1) {
      s = sprintf("%s took %.1f minutes", s, time_delta_mins)
    } else {
      s = sprintf("%s took %d seconds", s, ceiling(as.numeric(difftime(cur_time, start_time, units = "secs"))))
    }
  }

  # log
  logger_msdap(s, type)

  # halt on error
  if(type == "error") {
    stop(call. = T)
  }
}



#' Append text to the log file and print to console, including a time duration
#'
#' @param s your message as a character string
#' @param start_time the start time, generated by Sys.time(), that will be compared to the current Sys.time()
#' @param type the type of message, typically "progress". See further append_log()
append_log_timestamp = function(s, start_time, type = "progress") {
  append_log(s, type, start_time)
}



#' Append error object to log
#'
#' prints message and call trace if these exist, otherwise dump the entire error object
#'
#' @param err error type object (e.g. from tryCatch function)
#' @param type the type of message, typically "progress". See further append_log()
append_log_error = function(err, type = "error") {
  if(length(err) > 0) {
    if(length(err$message) == 1 && nchar(err$message) > 3) {
      # if there is a message attached, try to neatly print the user-facing message followed by the erronous call
      if(length(err$call) > 0) { # report more details on where the error occurred
        # note that if type="error", code halts after first append_log call so all output/log should go into 1 call
        append_log(paste0(err$message, "\n", stringr::str_trim(capture.output(utils::str(err$call, nchar.max = 1000))) ), type = type)
      } else { # no call trace available
        append_log(err$message, type = type)
      }
    } else {
      # if there was no warning attached, just dump the entire object to console
      append_log(stringr::str_trim(capture.output(utils::str(err, nchar.max = 1000))), type = type)
    }
  }
}