Nothing
#' Logger
#'
#' Create a logger.
#'
#' @importFrom crayon blurred
#'
#' @examples
#' info <- Logger$new("INFO")$
#' date()$
#' time()$
#' hook(crayon::blue)
#'
#' info$log("Hello")
#' Sys.sleep(.7)
#' info$log("World")
#'
#' @export
Logger <- R6::R6Class(
"Logger",
public = list(
#' @field printer A callback function to write the message
#' to the console, must accept a single argument,
#' defaults to `cat`.
printer = NA,
#' @field predicate A predicate function that determines whether
#' to actually run the log, useful if you want to switch the
#' logger on and off for debugging.
#'
#' If the function returns `TRUE` the logger runs as normal,
#' if `FALSE` the logger does not actually print, write or
#' dump the messages.
predicate = NA,
#' @details Initialise
#'
#' @param prefix String to prefix all log messages.
#' @param file Name of the file to dump the logs to,
#' only used if `write` is `TRUE`.
#' @param write Whether to write the log to the `file`.
#' @param sep Separator between `prefix` and other flags
#' and messages.
#'
#' @examples
#' info <- Logger$new("INFO")
#' info$log("hello")
initialize = function(prefix = NULL, write = FALSE, file = "log.log", sep = "\t"){
callback <- function(prefix, sep){
if(is.null(prefix))
sep <- ""
if(is.null(prefix))
prefix <- ""
pref <- sprintf("%s%s", prefix, sep)
function(){
private$.prefixHook(pref)
}
}
private$.callbacks <- list(callback(prefix, sep))
private$.file <- file
private$.write <- write
self$printer <- cli::cat_line
self$predicate <- function(){
TRUE
}
private$.prefixHook <- function(prefix){
return(prefix)
}
},
#' @details Include the date in the log
#' @param format Formatter for the item, passed
#' to [format()].
#' @examples
#' info <- Logger$new("INFO")$date()
#' info$log("today")
date = function(format = "%d-%m-%Y"){
callback <- function(){
blurred(format(Sys.Date(), format = format))
}
private$.callbacks <- append(private$.callbacks, callback)
invisible(self)
},
#' @details Include the time in the log
#' @param format Formatter for the item, passed
#' to [format()].
#' @examples
#' info <- Logger$new("INFO")$time()
#' info$log("now")
time = function(format = "%H:%M:%S"){
callback <- function(){
blurred(format(Sys.time(), format = format))
}
private$.callbacks <- append(private$.callbacks, callback)
invisible(self)
},
#' @details Include the time in the log
#' @examples
#' info <- Logger$new("INFO")$unix()
#' info$log("timestamp")
unix = function(){
callback <- function(){
blurred(as.numeric(Sys.time()))
}
private$.callbacks <- append(private$.callbacks, callback)
invisible(self)
},
#' @details Preprocess the prefix with a custom function
#'
#' @param fn A function that accepts one argument (string)
#' and returns a modified version of that string.
#' @examples
#' err <- Logger$new("INFO")$hook(crayon::red)
#' err$log("hello")
hook = function(fn){
private$.prefixHook <- fn
invisible(self)
},
#' @details Include the directory in the log
#' @examples
#' info <- Logger$new("INFO")$dir()
#' info$log("directory")
dir = function(){
callback <- function(){
blurred(getwd())
}
private$.callbacks <- append(private$.callbacks, callback)
invisible(self)
},
#' @details Pass a custom flag
#' @param what Function to run for every message logged
#' or string to include in log message.
#' @examples
#' fl <- function(){
#' paste0(sample(letters, 4), collapse = "")
#' }
#'
#' info <- Logger$new("INFO")$flag(fl)
#' info$log("random")
flag = function(what){
if(!is.function(what))
fn <- function(){
return(what)
}
else
fn <- what
private$.callbacks <- append(private$.callbacks, fn)
invisible(self)
},
#' @details Log messages
#' @param ... Elements to compose message.
#' @param sep,collapse Separators passed to [paste()].
#' @examples
#' info <- Logger$new("INFO")
#' info$log("Logger")
log = function(..., sep = " ", collapse = " ", prefix = NULL){
if(!self$predicate())
return(invisible())
if(length(list(...)) == 0)
return(invisible())
# support erratum
if(inherits(list(...)[[1]], "Issue"))
msg <- list(...)[[1]]$message
msg <- paste(..., sep = sep, collapse = collapse)
# run callbacks
cbs <- as.list(private$.callbacks)
if(!is.null(prefix) && is.function(prefix))
cbs[[1]] <- prefix
if(!is.null(prefix) && !is.function(prefix))
cbs[[1]] <- \() prefix
cbs <- sapply(cbs, function(fn) fn())
cbs <- paste(cbs, collapse = " ")
# prefix
msg_return <- paste(cbs, msg, collapse = " ")
msg_return <- trimws(msg_return)
msg_print <- msg_return
self$printer(msg_print)
if(private$.write)
write(clean_msg(msg_return), private$.file, append = TRUE)
else
private$.log <- c(private$.log, msg_return)
invisible(msg_return)
},
#' @details Dump the log to a file
#' @param file Name of the file to dump the logs to.
#' @examples
#' info <- Logger$new("INFO")
#' info$log("hello")
#' \dontrun{info$dump()}
dump = function(file = "dump.log"){
if(!self$predicate())
return(invisible())
log <- sapply(private$.log, clean_msg)
writeLines(log, file)
}
),
private = list(
.prefixHook = NULL,
.callbacks = list(),
.log = c(),
.file = "log.log",
.write = FALSE
)
)
#' Clean Message
#'
#' Clean message for writing to file.
#'
#' @param msg Message string.
#'
#' @noRd
#' @keywords internal
clean_msg <- function(msg){
gsub("\\n", "", msg)
}
#' Log Check
#'
#' @param obj Object to check.
#'
#' @return `TRUE` if object is a logger,
#' and `FALSE` otherwise.
#'
#' @examples
#' info <- Logger$new("INFO")
#' is.log(info)
#'
#' @export
is.log <- function(obj){
if(inherits(obj, "Logger"))
return(TRUE)
FALSE
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.