Fix log shiny inputs@main

R/log_formatter.R

@@ -0,0 +1,34 @@
+#' Teal `log_formatter`
+#'
+#' Custom `log_formatter` supporting atomic vectors. By default `glue::glue`
+#' returns n-element vector when vector is provided as an input. This function
+#' generates `"[elem1, elem2, ...]"` for atomic vectors. Function also handles
+#' `NULL` value which normally causes `logger` to return empty character.
+#' @name teal_logger_formatter
+#' @return (`character(1)`) formatted log entry
+#' @keywords internal
+teal_logger_formatter <- function() {
+  logger::log_formatter(
+    function(..., .logcall = sys.call(), .topcall = sys.call(-1), .topenv = parent.frame()) {
+      logger::formatter_glue(
+        ...,
+        .null = "NULL", .logcall = .logcall, .topcall = .topcall, .topenv = .topenv,
+        .transformer = teal_logger_transformer
+      )
+    }
+  )
+}
+
+#' @rdname teal_logger_formatter
+#' @inheritParams glue::identity_transformer
+teal_logger_transformer <- function(text, envir) {
+  value <- glue::identity_transformer(text, envir)
+  if (is.null(value)) {
+    "NULL"
+  } else if (is.vector(value)) {
+    utils::capture.output(expr <- dput(value)) # dput prints
+    deparse1(expr)
+  } else {
+    glue::glue_collapse(value, sep = ", ")
+  }
+}

R/log_shiny_input_changes.R

@@ -4,10 +4,11 @@
 #'
 #' Function having very similar behavior as [logger::log_shiny_input_changes()] but adjusted for `teal` needs.
 #'
-#' @param input passed from Shiny \code{server}
-#' @param excluded_inputs character vector of input names to exclude from logging
-#' @param excluded_pattern character of length one including a grep pattern of names to be excluded from logging
-#' @param namespace the name of the namespace
+#' @param input passed from Shiny `server`
+#' @param excluded_inputs (`character`) character vector of input names to exclude from logging
+#' @param excluded_pattern (`character(1)`) `regexp` pattern of names to be excluded from logging
+#' @param namespace (`character(1)`) the name of the namespace
+#' @param session the Shiny session
 #' @examples
 #' \dontrun{
 #' library(shiny)
@@ -37,35 +38,38 @@ log_shiny_input_changes <- function(
     input,
     namespace = NA_character_,
     excluded_inputs = character(),
-    excluded_pattern = "_width$") {
-  session <- shiny::getDefaultReactiveDomain()
-  if (!(shiny::isRunning() || inherits(session, "MockShinySession") || inherits(session, "session_proxy"))) {
-    stop("No Shiny app running, it makes no sense to call this function outside of a Shiny app")
+    excluded_pattern = "_width$",
+    session = shiny::getDefaultReactiveDomain()) {
+  stopifnot(inherits(input, "reactivevalues"))
+  stopifnot(is.character(namespace) && length(namespace) == 1)
+  stopifnot(is.character(excluded_inputs))
+  stopifnot(is.character(excluded_pattern) && length(excluded_pattern) == 1)
+  stopifnot(inherits(session, "session_proxy"))
+
+  if (logger::TRACE > logger::as.loglevel(get_val("TEAL.LOG_LEVEL", "teal.log_level", "INFO"))) {
+    # to avoid setting observers when not needed
+    return(invisible(NULL))
   }
-  ns <- ifelse(!is.null(session), session$ns(character(0)), "")
 
-  # utils::assignInMyNamespace and utils::assignInNamespace are needed
-  # so that observer is executed only once, not twice.
-  input_values <- shiny::isolate(shiny::reactiveValuesToList(input))
-  utils::assignInMyNamespace("shiny_input_values", input_values)
+  ns <- session$ns(character(0))
+  reactive_input_list <- shiny::reactive({
+    input_list <- shiny::reactiveValuesToList(input)
+    input_list[!grepl(excluded_pattern, names(input_list))]
+  })
+  shiny_input_values <- shiny::reactiveVal(shiny::isolate(reactive_input_list()))
 
-  shiny::observe({
-    old_input_values <- shiny_input_values
-    new_input_values <- shiny::reactiveValuesToList(input)
-    names <- unique(c(names(old_input_values), names(new_input_values)))
-    names <- setdiff(names, excluded_inputs)
-    if (length(excluded_pattern)) {
-      names <- grep(excluded_pattern, names, invert = TRUE, value = TRUE)
-    }
+  shiny::observeEvent(reactive_input_list(), {
+    old_input_values <- shiny_input_values()
+    new_input_values <- reactive_input_list()
+    names <- intersect(names(old_input_values), names(new_input_values))
     for (name in names) {
-      old <- old_input_values[name]
-      new <- new_input_values[name]
+      old <- old_input_values[[name]]
+      new <- new_input_values[[name]]
       if (!identical(old, new)) {
         message <- trimws("{ns} Shiny input change detected in {name}: {old} -> {new}")
         logger::log_trace(message, namespace = namespace)
       }
     }
-    utils::assignInNamespace("shiny_input_values", new_input_values, ns = "teal.logger")
+    shiny_input_values(new_input_values)
   })
 }
-shiny_input_values <- NULL

R/zzz.R

@@ -3,6 +3,7 @@ registered_handlers_namespaces <- new.env()
 
 .onLoad <- function(libname, pkgname) { # nolint
   # Set up the teal logger instance
+  teal_logger_formatter()
   register_logger("teal.logger")
   register_handlers("teal.logger")
   invisible()

tests/testthat/setup-logger.R

@@ -0,0 +1 @@
+logger::log_appender(function(...) NULL, namespace = "teal.logger")

tests/testthat/test-log_formatter.R

@@ -0,0 +1,47 @@
+testthat::test_that("teal.logger formats NULL asis", {
+  out <- logger::log_info("null: {NULL}")
+  testthat::expect_identical(out$default$message, "null: NULL")
+})
+
+testthat::test_that("teal.logger formats character(0) asis", {
+  out <- logger::log_info("empty character: {character(0)}")
+  testthat::expect_identical(out$default$message, "empty character: character(0)")
+})
+
+testthat::test_that("teal.logger formats NA asis", {
+  out <- logger::log_info("na: {NA}")
+  testthat::expect_identical(
+    out$default$message,
+    "na: NA"
+  )
+})
+
+testthat::test_that("teal.logger formats scalar asis", {
+  out <- logger::log_info("numeric: {1}")
+  testthat::expect_identical(out$default$message, "numeric: 1")
+  out <- logger::log_info("character: {'a'}")
+  testthat::expect_identical(out$default$message, 'character: "a"')
+})
+
+testthat::test_that("teal.logger formats vector as an array literal", {
+  out <- logger::log_info("{letters[1:3]}")
+  testthat::expect_identical(out$default$message, 'c("a", "b", "c")')
+})
+
+testthat::test_that("teal.logger formats two vectors in a single log", {
+  out <- logger::log_info("one: {letters[1:2]} two: {letters[3:4]}")
+  testthat::expect_identical(out$default$message, 'one: c("a", "b") two: c("c", "d")')
+})
+
+testthat::test_that("teal.logger formats list as a list literal", {
+  out <- logger::log_info("list: {list(letters[1:2])}")
+  testthat::expect_identical(out$default$message, 'list: list(c("a", "b"))')
+})
+
+testthat::test_that("teal.logger formats nested list as a named list array literal", {
+  out <- logger::log_info("nested list: {list(a = letters[1:2], b = list(letters[3:4]))}")
+  testthat::expect_identical(
+    out$default$message,
+    'nested list: list(a = c("a", "b"), b = list(c("c", "d")))'
+  )
+})