Simplify log_level()

R/formatters.R

@@ -235,6 +235,9 @@ skip_formatter <- function(message, ...) {
   structure(message, skip_formatter = TRUE)
 }
 
+is_skip_formatter <- function(x) {
+  isTRUE(attr(x, "skip_formatter", exact = TRUE))
+}
 
 #' Mimic the default formatter used in the \pkg{logging} package
 #'
@@ -262,17 +265,18 @@ skip_formatter <- function(message, ...) {
 #' log_info("vector %s", 1:3)
 #' log_info(12, 1 + 1, 2 * 2)
 #' }
-formatter_logging <- structure(function(...,
-                                        .logcall = sys.call(), .topcall = sys.call(-1), .topenv = parent.frame()) {
-  params <- list(...)
-  .logcall <- substitute(.logcall)
-
-  if (is.character(params[[1]])) {
-    return(do.call(sprintf, params, envir = .topenv))
+formatter_logging <- structure(function(..., .logcall = sys.call(), .topcall = sys.call(-1), .topenv = parent.frame()) {
+  # If the first argument is a string, then use sprintf
+  if (is.character(..1)) {
+    return(sprintf(...))
   }
 
+  # Otherwise show unevaluated inputs next to result
+  params <- list(...)
+  args <- as.list(.logcall)[-1]
+
   sapply(seq_along(params), function(i) {
-    paste(deparse(as.list(.logcall)[-1][[i]]), params[[i]], sep = ": ")
+    paste(deparse(args[[i]]), params[[i]], sep = ": ")
   })
 }, generator = quote(formatter_logging()))
 

R/logger.R

@@ -317,42 +317,50 @@ log_namespaces <- function() {
 #' log_info(glue::glue("ok {1:3} + {1:3} = {2*(1:3)}"))
 #' }
 #' @return Invisible `list` of `logger` objects. See [logger()] for more details on the format/
-log_level <- function(level, ..., namespace = NA_character_,
-                      .logcall = sys.call(), .topcall = sys.call(-1), .topenv = parent.frame()) {
+log_level <- function(level,
+                      ...,
+                      namespace = NA_character_,
+                      .logcall = sys.call(),
+                      .topcall = sys.call(-1),
+                      .topenv = parent.frame()) {
+  level <- validate_log_level(level)
   ## guess namespace
   if (is.na(namespace)) {
     topenv <- top_env_name(.topenv)
     namespace <- ifelse(topenv == "R_GlobalEnv", "global", topenv)
   }
+  .topcall <- .topcall %||% NA
 
-  definitions <- get_logger_definitions(namespace, .topenv = .topenv)
-  level <- validate_log_level(level)
+  loggers <- get_logger_definitions(namespace, .topenv = .topenv)
+  for (logger in loggers) {
+    if (level > logger$threshold) {
+      next
+    }
 
-  ## super early return (even before evaluating passed parameters)
-  if (length(definitions) == 1 && level > definitions[[1]]$threshold) {
-    return(invisible(NULL))
-  }
+    if (...length() == 1 && is_skip_formatter(..1)) {
+      # optionally skip fomrmatting
+      message <- ..1
+    } else {
+      message <- logger$formatter(
+        ...,
+        .logcall = .logcall,
+        .topcall = .topcall,
+        .topenv = .topenv
+      )
+    }
 
-  log_arg <- list(...)
-  log_arg$level <- level
-  log_arg$.logcall <- .logcall
-  log_arg$.topcall <- if (!is.null(.topcall)) {
-    .topcall
-  } else {
-    ## cannot pass NULL
-    NA
+    record <- logger$layout(
+      level,
+      message,
+      namespace = namespace,
+      .logcall = .logcall,
+      .topcall = .topcall,
+      .topenv = .topenv
+    )
+    logger$appender(record)
   }
-  log_arg$.topenv <- .topenv
-  log_arg$namespace <- namespace
-
-  invisible(lapply(definitions, function(definition) {
-    if (level > definition$threshold) {
-      return(NULL)
-    }
 
-    log_fun <- do.call(logger, definition)
-    structure(do.call(log_fun, log_arg), class = "logger")
-  }))
+  invisible()
 }
 
 

R/utils.R

@@ -100,3 +100,7 @@ catch_base_log <- function(level, namespace, .topcall = sys.call(-1), .topenv =
 in_pkgdown <- function() {
   identical(Sys.getenv("IN_PKGDOWN"), "true")
 }
+
+`%||%` <- function(x, y) {
+  if (is.null(x)) y else x
+}

tests/testthat/test-formatters.R

@@ -19,9 +19,6 @@ test_that("glue works", {
   expect_equal(formatter_glue("Hi {everything}"), "Hi 42")
   expect_equal(formatter_glue("Hi {1:2}"), paste("Hi", 1:2))
 
-  expect_output(do.call(logger, namespaces$global[[1]])(INFO, 42), "42")
-  expect_output(do.call(logger, namespaces$global[[1]])(INFO, "Hi {everything}"), "42")
-
   expect_output(log_info("Hi {everything}"), "42")
   expect_output(log_warn("Hi {everything}"), "42")
   expect_output(g(), "42")