new register_handlers function (#73)

close insightsengineering/coredev-tasks#502
#69

I tried to use `logger::log_messages()` (and similar functions for
warnings and errors) but I have encounter following problems:
- this is logging into the global logger namespace whereas we want
particular (package) namespace instead - created an issue
- I cloned logger locally and fixed / enhanced the above but then I
realized that the (global) message / warning / stop calls from the
outside of a package will also log to that package logger namespace. In
other words, these are _global_ handlers for all the warnings and not
only warnings created inside `teal` e.g.
```
r$> warning(1)
[WARN] 2024-01-26 15:58:17.0061 pid:83248 token:[] teal 1
Warning message:
1
```

Therefore I have decided to implement own register handlers mechanism. I
initially started doing this separately inside each package but then I
realised that it's not so DRY and decided to extend core `teal.logger`
functionality.

This is not a reprex as I modified `teal` and `teal.slice` namespaces in
a following way:
- added `register_handlers(<pkg>)` in both packages
- For debugging: added following definitions:
  - `teal.slice`:
    - `teal_s_message` calling `message()`
    - `teal_s_warning` calling `warning()`
    - `teal_s_stop` calling `stop()`
  - in `teal`:
    - `teal_message` calling `message()`
    - `teal_warning` calling `warning()`
    - `teal_stop` calling `stop()`
- `teal_message_nested` calling `teal_s_message()` (so as to simulate
`teal` calling `teal.slice`)
    - `teal_warning_nested` calling `teal_s_warning()`
    - `teal_stop_nested` calling `teal_s_stop()`

The outcome:

```
r$> devtools::load_all("teal.logger")
r$> devtools::load_all("teal.slice")
r$> devtools::load_all("teal")

r$> message(1)
1
r$> teal_message(1)
[INFO] 2024-01-26 15:57:40.8901 pid:83248 token:[] teal 1
1
r$> teal_s_message(1)
[INFO] 2024-01-26 15:57:42.1464 pid:83248 token:[] teal.slice 1
1
r$> teal_message_nested(1)
[INFO] 2024-01-26 15:57:50.9231 pid:83248 token:[] teal 1
[INFO] 2024-01-26 15:57:50.9257 pid:83248 token:[] teal.slice 1
1

r$> warning(2)
Warning message:
2 
r$> teal_s_warning(2)
[WARN] 2024-01-26 15:58:17.0061 pid:83248 token:[] teal.slice In ‘teal_s_warning(2)’: 2
Warning message:
In teal_s_warning(2) : 2
r$> teal_warning(2)
[WARN] 2024-01-26 15:58:18.4165 pid:83248 token:[] teal In ‘teal_warning(2)’: 2
Warning message:
In teal_warning(2) : 2
r$> teal_warning_nested(2)
[WARN] 2024-01-26 15:58:20.8666 pid:83248 token:[] teal In ‘teal.slice:::teal_s_warning(message)’: 2
[WARN] 2024-01-26 15:58:20.8685 pid:83248 token:[] teal.slice In ‘teal.slice:::teal_s_warning(message)’: 2
Warning message:
In teal.slice:::teal_s_warning(message) : 2

r$> stop(3)
Error: 3
r$> teal_s_stop(3)
[ERROR] 2024-01-26 15:58:32.9558 pid:83248 token:[] teal.slice In ‘teal_s_stop(3)’: 3
Error in teal_s_stop(3) : 3
r$> teal_stop(3)
[ERROR] 2024-01-26 15:58:33.5246 pid:83248 token:[] teal In ‘teal_stop(3)’: 3
Error in teal_stop(3) : 3
r$> teal_stop_nested(3)
[ERROR] 2024-01-26 15:58:34.0213 pid:83248 token:[] teal In ‘teal.slice:::teal_s_stop(message)’: 3
[ERROR] 2024-01-26 15:58:34.0226 pid:83248 token:[] teal.slice In ‘teal.slice:::teal_s_stop(message)’: 3
Error in teal.slice:::teal_s_stop(message) : 3
```

Interpretation (where "m/w/s" stands for "message / warning / stop"):
- global m/w/s is not impacted - we only capture m/w/s called from
inside the package
- capturing m/w/s in the appropriate logger namespace - see it as a part
of logger produced string - second last part
- the case of nested calls looks odd at the very first glance but I
think it's correct. Each (package) logger instance might have its own
log threshold, appender function, layout etc. It's expected to have
duplicated logs for each of the registered package namespace found on
the stack of calls. I'm interested in hearing your thoughts on this


PRs:

- [ ] insightsengineering/teal#1081
- [ ] insightsengineering/teal.goshawk#258
- [ ]
insightsengineering/teal.modules.clinical#1010
- [ ]
insightsengineering/teal.modules.general#628
- [ ]
insightsengineering/teal.modules.hermes#354
- [ ] insightsengineering/teal.osprey#252
- [ ] insightsengineering/teal.slice#551
- [ ] insightsengineering/teal.transform#175

(I'll keep them as draft as this is conflicting with release plans
because teal.logger would have to be released first)

TODO: tests - however I'm not yet sure how to make them "clean"

---------

Signed-off-by: Pawel Rucki <[email protected]>
Co-authored-by: Dawid Kałędkowski <[email protected]>

.Rbuildignore

@@ -13,6 +13,7 @@ SECURITY.md
 ^[^/]+\.html$
 ^[^/]+\.png$
 ^\.CI-FORCE-RELEASE-VERSION$
+^\.covrignore$
 ^\.Rprofile$
 ^\.Rproj\.user$
 ^\.github$

.covrignore

@@ -0,0 +1 @@
+R/zzz.R

.pre-commit-config.yaml

@@ -38,6 +38,7 @@ repos:
           .*\.svg|
           .*\.xml|
           (.*/|)\_pkgdown.y[a]?ml|
+          (.*/|)\.covrignore|
           (.*/|)\.gitignore|
           (.*/|)\.gitlab-ci\.y[a]?ml|
           (.*/|)\.lintr|

DESCRIPTION

@@ -21,6 +21,7 @@ Imports:
     glue (>= 1.0.0),
     lifecycle (>= 0.2.0),
     logger (>= 0.2.0),
+    methods,
     shiny (>= 1.6.0),
     withr (>= 2.1.0)
 Suggests:

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(log_system_info)
+export(register_handlers)
 export(register_logger)
 export(suppress_logs)
 importFrom(lifecycle,badge)

NEWS.md

@@ -1,5 +1,6 @@
 # teal.logger 0.1.3.9012
 
+* New function `register_handlers` to register global handlers for logging messages, warnings and errors.
 * Specified minimal version of package dependencies.
 
 # teal.logger 0.1.3

R/register_handlers.R

@@ -0,0 +1,142 @@
+#' Register handlers for logging messages, warnings and errors
+#'
+#' @param namespace (`character(1)`) the logger namespace
+#' @param package (`character(1)`) the package name
+#'
+#' @return `NULL` invisibly. Called for its side effects.
+#'
+#' @details
+#' This function registers global handlers for messages, warnings and errors.
+#' The handlers will investigate the call stack and if it contains a function
+#' from the package, the message, warning or error will be logged into the respective
+#' namespace.
+#'
+#' The handlers are registered only once per package and type. Consecutive calls will no effect.
+#' Registering handlers for package `base` is not supported.
+#'
+#' Use `TEAL.LOG_MUFFLE` environmental variable or `teal.log_muffle` R option to optionally
+#' control recover strategies. If `TRUE` (a default value) then the handler will jump to muffle
+#' restart for a given type of condition and doesn't continue (with output to the console).
+#' Applicable for message and warning types only. The errors won't be suppressed.
+#'
+#' @note Registering handlers is forbidden within `tryCatch()` or `withCallingHandlers()`.
+#' Because of this, handlers are registered only if it is possible.
+#'
+#' @seealso [globalCallingHandlers()]
+#'
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' register_handlers("teal.logger")
+#' # see the outcome
+#' globalCallingHandlers()
+#' }
+register_handlers <- function(namespace, package = namespace) {
+  if (register_handlers_possible()) {
+    register_handler_type(namespace = namespace, package = package, type = "message")
+    register_handler_type(namespace = namespace, package = package, type = "warning")
+    register_handler_type(namespace = namespace, package = package, type = "error")
+  }
+
+  invisible(NULL)
+}
+
+register_handler_type <- function(
+    namespace,
+    package = namespace,
+    type = c("error", "warning", "message")) {
+  if (!(is.character(namespace) && length(namespace) == 1 && !is.na(namespace))) {
+    stop("namespace argument must be a single string.")
+  }
+  if (!(namespace %in% logger::log_namespaces())) {
+    stop("namespace argument must be a pre-registered logger namespace.")
+  }
+  if (!(is.character(package) && length(package) == 1 && !is.na(package))) {
+    stop("package argument must be a single string.")
+  }
+  match.arg(type)
+
+  registered_handlers_namespaces[[package]] <- namespace
+
+  # avoid re-registering handlers
+  gch <- globalCallingHandlers()[names(globalCallingHandlers()) == type]
+  if (length(gch) > 0 && any(sapply(gch, attr, "type") == "teal.logger_handler")) {
+    return(invisible(NULL))
+  }
+
+  # create a handler object
+  # loop through the call stack starting from the bottom (the last call)
+  # if a function is from pre-registered package then log using pre-specified namespace
+  logger_fun <- switch(type,
+    error = logger::log_error,
+    warning = logger::log_warn,
+    message = logger::log_info
+  )
+  # nocov start
+  handler_fun <- function(m) {
+    i <- sys.nframe() - 1L # loop starting from the bottom of the stack and go up
+    while (i > 0L) { # exclude 0L as this value will detect the current `handler_fun()` function
+      env_sys_fun_i <- environment(sys.function(i))
+      pkg_sys_fun_i <- if (!is.null(env_sys_fun_i)) { # primitive functions don't have environment
+        methods::getPackageName(env_sys_fun_i)
+      } else {
+        ""
+      }
+      if (pkg_sys_fun_i %in% ls(envir = registered_handlers_namespaces)) {
+        msg <- parse_logger_message(m)
+
+        log_namespace <- registered_handlers_namespaces[[pkg_sys_fun_i]]
+        logger_fun(msg, namespace = log_namespace)
+
+        # muffle restart
+        if (isTRUE(as.logical(get_val("TEAL.LOG_MUFFLE", "teal.log_muffle", TRUE)))) {
+          if (type == "message") {
+            invokeRestart("muffleMessage")
+          }
+          if (type == "warning") {
+            invokeRestart("muffleWarning")
+          }
+        }
+
+        break
+      }
+      i <- i - 1L
+    }
+    m
+  }
+  # nocov end
+  # add attributes to enable checking if the handler is already registered
+  handler_obj <- structure(
+    handler_fun,
+    type = "teal.logger_handler"
+  )
+
+  # construct & eval the call - globalCallingHandlers() requires named arguments
+  do.call(
+    globalCallingHandlers,
+    stats::setNames(list(handler_obj), type)
+  )
+
+  invisible(NULL)
+}
+
+parse_logger_message <- function(m) {
+  stopifnot(inherits(m, "condition"))
+
+  type <- class(m)[2]
+  msg <- m$message
+  if (type %in% c("error", "warning") && !is.null(m$call)) {
+    msg <- sprintf("In %s: %s", sQuote(paste0(format(m$call), collapse = "")), msg)
+  }
+  return(msg)
+}
+
+register_handlers_possible <- function() {
+  for (i in seq_len(sys.nframe())) {
+    if (identical(sys.function(i), tryCatch) || identical(sys.function(i), withCallingHandlers)) {
+      return(FALSE)
+    }
+  }
+  return(TRUE) # nocov: impossible to cover because testthat introduces it's own handlers and we want to return FALSE
+}

R/register_logger.R

@@ -27,7 +27,7 @@
 #'
 #' @seealso The package vignettes for more help: `browseVignettes("teal.logger")`.
 #'
-#' @param namespace (`character(1)` or `NA`)\cr
+#' @param namespace (`character(1)` or `NA_character_`)\cr
 #'  the name of the logging namespace
 #' @param layout (`character(1)`)\cr
 #'  the log layout. Alongside the standard logging variables provided by the `logging` package
@@ -52,11 +52,12 @@ register_logger <- function(namespace = NA_character_,
                             layout = NULL,
                             level = NULL) {
   if (!((is.character(namespace) && length(namespace) == 1) || is.na(namespace))) {
-    stop("namespace argument to register_logger must be a scalar character or NA.")
+    stop("namespace argument to register_logger must be a single string or NA.")
   }
 
-  if (is.null(level)) level <- Sys.getenv("TEAL.LOG_LEVEL")
-  if (is.null(level) || level == "") level <- getOption("teal.log_level", default = "INFO")
+  if (is.null(level)) {
+    level <- get_val("TEAL.LOG_LEVEL", "teal.log_level", "INFO")
+  }
 
   tryCatch(
     logger::log_threshold(level, namespace = namespace),
@@ -69,13 +70,14 @@ register_logger <- function(namespace = NA_character_,
     }
   )
 
-  if (is.null(layout)) layout <- Sys.getenv("TEAL.LOG_LAYOUT")
-  if (is.null(layout) || layout == "") {
-    layout <- getOption(
+  if (is.null(layout)) {
+    layout <- get_val(
+      "TEAL.LOG_LAYOUT",
       "teal.log_layout",
-      default = "[{level}] {format(time, \"%Y-%m-%d %H:%M:%OS4\")} pid:{pid} token:[{token}] {ans} {msg}"
+      "[{level}] {format(time, \"%Y-%m-%d %H:%M:%OS4\")} pid:{pid} token:[{token}] {ans} {msg}"
     )
   }
+
   tryCatch(
     expr = {
       logger::log_layout(layout_teal_glue_generator(layout), namespace = namespace)

R/utils.R

@@ -27,3 +27,15 @@ log_system_info <- function() {
   pasted_names_and_versions <- paste(paste_pkgs_name_with_version(names(info$loadedOnly)), collapse = ", ")
   logger::log_trace("Loaded packages: { pasted_names_and_versions }")
 }
+
+#' Get value from environmental variable or R option or default in that order if the previous one is missing.
+#' @param env_var_name (`character(1)`) name of the system variable
+#' @param option_name (`character(1)`) name of the option
+#' @param default optional, default value if both `Sys.getenv(env_var_name)` and `getOption(option_name)` are empty
+#' @return an object of any class
+#' @keywords internal
+get_val <- function(env_var_name, option_name, default = NULL) {
+  value <- Sys.getenv(env_var_name)
+  if (is.null(value) || value == "") value <- getOption(option_name, default = default)
+  return(value)
+}

R/zzz.R

@@ -1,5 +1,9 @@
+# create an object to store the information of registered handlers
+registered_handlers_namespaces <- new.env()
+
 .onLoad <- function(libname, pkgname) { # nolint
   # Set up the teal logger instance
   register_logger("teal.logger")
+  register_handlers("teal.logger")
   invisible()
 }

_pkgdown.yml

@@ -26,4 +26,5 @@ reference:
     contents:
       - log_system_info
       - register_logger
+      - register_handlers
       - suppress_logs