Merge pull request daroczig#170 from hadley/check-inputs

Check inputs for `log_` setters

NEWS.md

@@ -1,5 +1,7 @@
 # logger (development version)
 
+* `log_appender()`, `log_layout()` and `log_formatter()` now check that you are calling them with a function, and return the previously set value.
+
 # logger 0.3.0 (2024-03-03)
 
 Many unrelated small features, fixes and documentation updates collected over 2+ years.

R/logger.R

@@ -105,9 +105,11 @@ fallback_namespace <- function(namespace) {
 
 #' @param namespace logger namespace
 #' @param index index of the logger within the namespace
-#' @return currently set or return log function property
+#' @return If `value` is `NULL`, will return the currently set value.
+#'   If `value` is not `NULL`, will return the previously set value.
 #' @noRd
 log_config_setter <- function(name, value, namespace = "global", index = 1) {
+
   if (length(namespace) > 1) {
     for (ns in namespace) {
       log_config_setter(name, value, ns, index)
@@ -117,6 +119,7 @@ log_config_setter <- function(name, value, namespace = "global", index = 1) {
 
   configs <- get(fallback_namespace(namespace), envir = namespaces)
   config <- configs[[min(index, length(configs))]]
+  old <- config[[name]]
 
   if (name == "threshold") {
     if (is.null(value)) {
@@ -137,6 +140,8 @@ log_config_setter <- function(name, value, namespace = "global", index = 1) {
 
   configs[[min(index, length(config) + 1)]] <- config
   assign(namespace, configs, envir = namespaces)
+  invisible(old)
+
 }
 
 
@@ -195,6 +200,9 @@ log_threshold <- function(level = NULL, namespace = "global", index = 1) {
 #' }
 #' @seealso [logger()], [log_threshold()], [log_appender()] and [log_formatter()]
 log_layout <- function(layout = NULL, namespace = "global", index = 1) {
+  if (!is.null(layout) && !is.function(layout)) {
+    stop("`layout` must be a function")
+  }
   log_config_setter("layout", layout, namespace = namespace, index = index)
 }
 
@@ -209,6 +217,9 @@ log_layout <- function(layout = NULL, namespace = "global", index = 1) {
 #' @seealso [logger()], [log_threshold()], [log_appender()] and
 #'   [log_layout()]
 log_formatter <- function(formatter = NULL, namespace = "global", index = 1) {
+  if (!is.null(formatter) && !is.function(formatter)) {
+    stop("`formatter` must be a function")
+  }
   log_config_setter("formatter", formatter, namespace = namespace, index = index)
 }
 
@@ -236,6 +247,9 @@ log_formatter <- function(formatter = NULL, namespace = "global", index = 1) {
 #' }
 #' @seealso [logger()], [log_threshold()], [log_layout()] and [log_formatter()]
 log_appender <- function(appender = NULL, namespace = "global", index = 1) {
+  if (!is.null(appender) && !is.function(appender)) {
+    stop("`appender` must be a function")
+  }
   log_config_setter("appender", appender, namespace = namespace, index = index)
 }
 
@@ -425,10 +439,7 @@ log_trace <- function(..., namespace = NA_character_,
 #' log_trace("DONE")
 #' }
 with_log_threshold <- function(expression, threshold = ERROR, namespace = "global", index = 1) {
-  old <- log_threshold(namespace = namespace, index = index)
-  on.exit({
-    log_threshold(old, namespace = namespace, index = index)
-  })
-  log_threshold(threshold, namespace = namespace, index = index)
+  old <- log_threshold(threshold, namespace = namespace, index = index)
+  on.exit(log_threshold(old, namespace = namespace, index = index))
   expression
 }

R/utils.R

@@ -78,16 +78,14 @@ deparse_to_one_line <- function(x) {
 #' fun()
 #' catch_base_log(INFO, NA_character_, .topcall = call("funLONG"))
 #' }
-catch_base_log <- function(
-    level,
-    namespace,
-    .topcall = sys.call(-1),
-    .topenv = parent.frame()) {
+catch_base_log <- function(level, namespace, .topcall = sys.call(-1), .topenv = parent.frame()) {
   namespace <- fallback_namespace(namespace)
-  orginal_appender <- log_appender(namespace = namespace)
-  log_appender(appender_console, namespace = namespace)
+
+  old <- log_appender(appender_console, namespace = namespace)
+  on.exit(log_appender(old, namespace = namespace))
+
   # catch error, warning or message
-  res <- capture.output(
+  capture.output(
     log_level(
       level = level,
       "",
@@ -97,8 +95,7 @@ catch_base_log <- function(
     ),
     type = "message"
   )
-  log_appender(orginal_appender, namespace = namespace)
-  res
+
 }
 
 in_pkgdown <- function() {

tests/testthat/_snaps/logger.md

@@ -0,0 +1,23 @@
+# setters check inputs
+
+    Code
+      log_appender(1)
+    Condition
+      Error in `log_appender()`:
+      ! `appender` must be a function
+    Code
+      log_formatter(1)
+    Condition
+      Error in `log_formatter()`:
+      ! `formatter` must be a function
+    Code
+      log_layout(1)
+    Condition
+      Error in `log_layout()`:
+      ! `layout` must be a function
+    Code
+      log_threshold("x")
+    Condition
+      Error in `validate_log_level()`:
+      ! Invalid log level
+

tests/testthat/test-logger.R

@@ -147,3 +147,12 @@ test_that("providing log_level() args to wrappers diretly is OK", {
   local_test_logger(WARN)
   expect_silent(log_info("{Sepal.Length}", .topenv = iris))
 })
+
+test_that("setters check inputs", {
+  expect_snapshot(error = TRUE, {
+    log_appender(1)
+    log_formatter(1)
+    log_layout(1)
+    log_threshold("x")
+  })
+})