Add log location info to meta

NEWS.md

@@ -1,5 +1,6 @@
 # logger (development version)
 
+* File and line location of the log call is now available to the layouts (#110, @thomasp85)
 * Added `log_elapsed()` to show cumulative elapsed running time (@thomasp85)
 * New `formatter_cli()` allows you to use the syntax from the cli package to create log messages (#210, @thomasp85)
 

R/layouts.R

@@ -22,6 +22,8 @@
 #' * `topenv`: the name of the top environment from which the parent call was called
 #'   (eg R package name or `GlobalEnv`)
 #' * `call`: parent call (if any) calling the logging function
+#' * `location`: A list with element `path` and `line` giving the location of the
+#'   log call
 #' * `fn`: function's (if any) name calling the logging function
 #'
 #' @param log_level log level as per [log_levels()]
@@ -45,6 +47,7 @@
     topenv = top_env_name(.topenv),
     fn = deparse_to_one_line(.topcall[[1]]),
     call = deparse_to_one_line(.topcall),
+    location = log_call_location(.logcall),
     time = timestamp,
     levelr = log_level,
     level = attr(log_level, "level"),

R/logger-meta.R

@@ -15,6 +15,7 @@ logger_meta_env <- function(log_level = NULL,
   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)
+  delayedAssign("location", log_call_location(.logcall), assign.env = env)
 
   env$time <- timestamp
   env$levelr <- log_level

R/utils.R

@@ -45,6 +45,29 @@ top_env_name <- function(.topenv = parent.frame()) {
   environmentName(topenv(.topenv))
 }
 
+#' Finds the location of the logger call (file and line)
+#' @return list with path and line element
+#' @noRd
+#' @param .logcall The call that emitted the log
+log_call_location <- function(.logcall) {
+  call_string <- deparse(.logcall)
+  loc <- list(
+    path = "<console>",
+    line = ""
+  )
+  for (trace in .traceback(0)) {
+    if (identical(call_string, as.vector(trace))) {
+      ref <- attr(trace, "srcref")
+      loc$line <- ref[1L]
+      file <- attr(ref, "srcfile")
+      if (!is.null(file)) {
+        loc$path <- normalizePath(file$filename, winslash = "/")
+      }
+      break
+    }
+  }
+  loc
+}
 
 #' Deparse and join all lines into a single line
 #'

tests/testthat/helper.R

@@ -1,3 +1,8 @@
+# Do not move this to another line as the location of this piece of code is tested for
+test_info <- function() {
+  log_info("TEST")
+}
+
 local_test_logger <- function(threshold = INFO,
                               formatter = formatter_glue,
                               layout = layout_simple,

tests/testthat/test-logger-meta.R

@@ -31,4 +31,7 @@ test_that("captures other environmental metadata", {
   expect_equal(env$os_release, sysinfo$release)
   expect_equal(env$os_version, sysinfo$version)
   expect_equal(env$user, sysinfo$user)
+
+  local_test_logger(layout = layout_glue_generator("{location$path}#{location$line}: {msg}"))
+  expect_output(test_info(), file.path(getwd(), "helper.R#3: TEST"))
 })