Merge pull request #179 from hadley/lazy-meta

A lazier version of `get_logger_meta_variables()`

NEWS.md

@@ -1,5 +1,6 @@
 # logger (development version)
 
+* logger now computes metadata lazily, so various expensive computations are only performed if you actually add them to the log (#105).
 * `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)

R/layouts.R

@@ -106,16 +106,15 @@ layout_glue_generator <- function(format = '{level} [{format(time, "%Y-%m-%d %H:
       stop("Invalid log level, see ?log_levels")
     }
 
-    with(
-      get_logger_meta_variables(
-        log_level = level,
-        namespace = namespace,
-        .logcall = .logcall,
-        .topcall = .topcall,
-        .topenv = .topenv
-      ),
-      glue::glue(format)
+    meta <- logger_meta_env(
+      log_level = level,
+      namespace = namespace,
+      .logcall = .logcall,
+      .topcall = .topcall,
+      .topenv = .topenv,
+      parent = environment()
     )
+    glue::glue(format, .envir = meta)
   }, generator = deparse(match.call()))
 }
 
@@ -174,9 +173,12 @@ layout_logging <- function(level,
                            .logcall = sys.call(),
                            .topcall = sys.call(-1),
                            .topenv = parent.frame()) {
-  meta <- get_logger_meta_variables(
-    log_level = level, namespace = namespace,
-    .logcall = .logcall, .topcall = .topcall, .topenv = .topenv
+  meta <- logger_meta_env(
+    log_level = level,
+    namespace = namespace,
+    .logcall = .logcall,
+    .topcall = .topcall,
+    .topenv = .topenv
   )
   paste0(
     format(Sys.time(), "%Y-%m-%d %H:%M:%S"), " ",
@@ -247,6 +249,11 @@ attr(layout_glue_colors, "generator") <- quote(layout_glue_colors())
 layout_json <- function(fields = default_fields()) {
   force(fields)
 
+  if ("msg" %in% fields) {
+    warning("'msg' is always automatically included")
+    fields <- setdiff(fields, "msg")
+  }
+
   structure(function(level,
                      msg,
                      namespace = NA_character_,
@@ -255,12 +262,15 @@ layout_json <- function(fields = default_fields()) {
                      .topenv = parent.frame()) {
     fail_on_missing_package("jsonlite")
 
-    json <- get_logger_meta_variables(
-      log_level = level, namespace = namespace,
-      .logcall = .logcall, .topcall = .topcall, .topenv = .topenv
+    meta <- logger_meta_env(
+      log_level = level,
+      namespace = namespace,
+      .logcall = .logcall,
+      .topcall = .topcall,
+      .topenv = .topenv
     )
-
-    sapply(msg, function(msg) jsonlite::toJSON(c(json, list(msg = msg))[fields], auto_unbox = TRUE))
+    json <- mget(fields, meta)
+    sapply(msg, function(msg) jsonlite::toJSON(c(json, list(msg = msg)), auto_unbox = TRUE))
   }, generator = deparse(match.call()))
 }
 
@@ -291,14 +301,14 @@ layout_json_parser <- function(fields = default_fields()) {
                      .topenv = parent.frame()) {
     fail_on_missing_package("jsonlite")
 
-    meta <- get_logger_meta_variables(
+    meta <- logger_meta_env(
       log_level = level,
       namespace = namespace,
       .logcall = .logcall,
       .topcall = .topcall,
       .topenv = .topenv
-    )[fields]
-
+    )
+    meta <- mget(fields, meta)
     msg <- jsonlite::fromJSON(msg)
 
     jsonlite::toJSON(c(meta, msg), auto_unbox = TRUE, null = "null")
@@ -308,7 +318,7 @@ layout_json_parser <- function(fields = default_fields()) {
 default_fields <- function() {
   c(
     "time", "level", "ns", "ans", "topenv", "fn", "node", "arch",
-    "os_name", "os_release", "os_version", "pid", "user", "msg"
+    "os_name", "os_release", "os_version", "pid", "user"
   )
 }
 

R/logger-meta.R

@@ -0,0 +1,43 @@
+logger_meta_env <- function(log_level = NULL,
+                            namespace = NA_character_,
+                            .logcall = sys.call(),
+                            .topcall = sys.call(-1),
+                            .topenv = parent.frame(),
+                            parent = emptyenv()) {
+  timestamp <- Sys.time()
+
+  env <- new.env(parent = parent)
+  env$ns <- namespace
+  env$ans <- fallback_namespace(namespace)
+
+  force(.topcall)
+  force(.topenv)
+  delayedAssign("fn", deparse_to_one_line(.topcall[[1]]), assign.env = env)
+  delayedAssign("call", deparse_to_one_line(.topcall), assign.env = env)
+  delayedAssign("topenv", top_env_name(.topenv), assign.env = env)
+
+  env$time <- timestamp
+  env$levelr <- log_level
+  env$level <- attr(log_level, "level")
+
+  delayedAssign("pid", Sys.getpid(), assign.env = env)
+
+  # R and ns package versions
+  delayedAssign(
+    "ns_pkg_version",
+    tryCatch(as.character(packageVersion(namespace)), error = function(e) NA_character_),
+    assign.env = env
+  )
+  delayedAssign("r_version", as.character(getRversion()), assign.env = env)
+
+  # stuff from Sys.info
+  delayedAssign(".sysinfo", Sys.info())
+  delayedAssign("node", .sysinfo[["nodename"]], assign.env = env)
+  delayedAssign("arch", .sysinfo[["machine"]], assign.env = env)
+  delayedAssign("os_name", .sysinfo[["sysname"]], assign.env = env)
+  delayedAssign("os_release", .sysinfo[["release"]], assign.env = env)
+  delayedAssign("os_version", .sysinfo[["version"]], assign.env = env)
+  delayedAssign("user", .sysinfo[["user"]], assign.env = env)
+
+  env
+}

tests/testthat/_snaps/layout.md

@@ -0,0 +1,8 @@
+# JSON layout warns if you include msg
+
+    Code
+      layout <- layout_json(fields = "msg")
+    Condition
+      Warning in `layout_json()`:
+      'msg' is always automatically included
+

tests/testthat/test-layout.R

@@ -23,14 +23,21 @@ test_that("metavars", {
 })
 
 test_that("JSON layout", {
-  local_test_logger(layout = layout_json(fields = c("level", "msg")))
+  local_test_logger(layout = layout_json(fields = "level"))
 
   out <- jsonlite::fromJSON(capture.output(log_info("foobar")))
   expect_equal(out, list(level = "INFO", msg = "foobar"))
 })
 
+test_that("JSON layout warns if you include msg", {
+  expect_snapshot(layout <- layout_json(fields = "msg"))
+  local_test_logger(layout = layout)
+  out <- jsonlite::fromJSON(capture.output(log_info("foobar")))
+  expect_equal(out, list(msg = "foobar"))
+})
+
 test_that("JSON parser layout", {
-  local_test_logger(layout = layout_json_parser(fields = c()))
+  local_test_logger(layout = layout_json_parser(fields = character()))
   expect_output(log_info(skip_formatter('{"x": 4}')), '{"x":4}', fixed = TRUE)
 })
 

tests/testthat/test-logger-meta.R

@@ -0,0 +1,34 @@
+test_that("captures call/environment info", {
+  f <- function(...) logger_meta_env()
+  env <- f(x = 1)
+
+  # values are computed lazily
+  expect_type(substitute(fn, env), "language")
+  expect_type(substitute(call, env), "language")
+
+  # and give correct values
+  expect_equal(env$fn, "f")
+  expect_equal(env$call, "f(x = 1)")
+  expect_equal(env$topenv, "logger")
+})
+
+test_that("captures namespace info", {
+  env <- logger_meta_env(namespace = "testthat")
+  expect_equal(env$ns, "testthat")
+  expect_equal(env$ans, "global")
+  expect_equal(env$ns_pkg_version, as.character(packageVersion("testthat")))
+})
+
+test_that("captures other environmental metadata", {
+  env <- logger_meta_env()
+  expect_equal(env$pid, Sys.getpid())
+  expect_equal(env$r_version, as.character(getRversion()))
+
+  sysinfo <- as.list(Sys.info())
+  expect_equal(env$node, sysinfo$nodename)
+  expect_equal(env$arch, sysinfo$machine)
+  expect_equal(env$os_name, sysinfo$sysname)
+  expect_equal(env$os_release, sysinfo$release)
+  expect_equal(env$os_version, sysinfo$version)
+  expect_equal(env$user, sysinfo$user)
+})