Handle null values and empty vectors

Author: s-fleck

NEWS.md

@@ -9,7 +9,12 @@
   `sprintf()` or `glue()`). rawMessage will be added by default to json
   log files (#60)
 
-* updated Readme
+* Replace `NULL` values and empty characters in logging by the string `"<NULL>"`. 
+  Before, `NULL` values would have resulted in empty log messages. (#51)
+  
+* Support transformers for `LoggerGlue` (see `?glue::glue`) (#51)
+  
+* updated README
 
 
 # lgr 0.4.4

R/Logger.R

@@ -105,7 +105,7 @@
 NULL
 
 
-
+# Logger ------------------------------------------------------------------
 
 #' @export
 Logger <- R6::R6Class(
@@ -148,7 +148,8 @@ Logger <- R6::R6Class(
       threshold = NULL,
       filters = list(),
       exception_handler = default_exception_handler,
-      propagate = TRUE
+      propagate = TRUE,
+      replace_empty = "<NULL>"
     ){
       # fields
       # threshold must be set *after* the logging functions have been initalized
@@ -167,6 +168,7 @@ Logger <- R6::R6Class(
       self$set_propagate(propagate)
       self$set_filters(filters)
       self$set_exception_handler(exception_handler)
+      self$set_replace_empty(replace_empty)
 
       invisible(self)
     },
@@ -241,7 +243,9 @@ Logger <- R6::R6Class(
           dots <- list(...)
 
           if (is.null(names(dots))){
-            msg  <- sprintf(msg, ...)
+            dots <- replace_empty(dots, get("replace_empty", self))
+
+            msg  <- do.call(sprintf, args = c(list(msg), dots))
             vals <- list(
               logger = self,
               level = level,
@@ -252,8 +256,11 @@ Logger <- R6::R6Class(
             )
           } else {
             not_named <- vapply(names(dots), is_blank, TRUE, USE.NAMES = FALSE)
+            unnamed_dots <- dots[not_named]
+            unnamed_dots <- replace_empty(unnamed_dots, get("replace_empty", self))
+
             if (any(not_named)){
-              msg <- do.call(sprintf, c(list(msg), dots[not_named]))
+              msg <- do.call(sprintf, c(list(msg), unnamed_dots))
             }
 
             vals <- c(
@@ -559,6 +566,8 @@ Logger <- R6::R6Class(
     },
 
 
+    # .. setters --------------------------------------------------------------
+
     #' @description Set the exception handler of a logger
     #'
     #' @param fun a `function` with the single argument `e` (an error [condition])
@@ -611,6 +620,17 @@ Logger <- R6::R6Class(
       invisible(self)
     },
 
+    #' @description Set the replacement for empty values (`NULL` or empty
+    #'   vectors)
+    #'
+    #' @param x should be a `character` vector, but other types of values are
+    #'   supported. use wisely.
+    set_replace_empty = function(x){
+      private[[".replace_empty"]] <- x
+
+      invisible(self)
+    },
+
 
     #' @description Spawn a child Logger.
     #' This is very similar to using [get_logger()], but
@@ -625,7 +645,7 @@ Logger <- R6::R6Class(
   ),
 
 
-  # active bindings ---------------------------------------------------------
+  # .. active bindings ---------------------------------------------------------
   active = list(
 
     #' @field name A `character` scalar. The unique name of each logger,
@@ -716,6 +736,9 @@ Logger <- R6::R6Class(
       }
     },
 
+    replace_empty = function() {
+      get(".replace_empty", envir = private)
+    },
 
     #' @field exception_handler a `function`. See `$set_exception_handler` and
     #'   `$handle_exception`
@@ -725,7 +748,7 @@ Logger <- R6::R6Class(
   ),
 
 
-  # private -----------------------------------------------------------------
+  # .. private -----------------------------------------------------------------
   private = list(
     set_name = function(x){
       assert(is_scalar_character(x))
@@ -747,13 +770,13 @@ Logger <- R6::R6Class(
       invisible()
     },
 
-    # +- fields ---------------------------------------------------------------
     .propagate = NULL,
     .exception_handler = NULL,
     .name = NULL,
     .appenders = NULL,
     .threshold = NULL,
-    .last_event = NULL
+    .last_event = NULL,
+    .replace_empty = NULL
   )
 )
 
@@ -784,6 +807,40 @@ LoggerGlue <- R6::R6Class(
 
   public = list(
 
+    initialize = function(
+      name = "(unnamed logger)",
+      appenders = list(),
+      threshold = NULL,
+      filters = list(),
+      exception_handler = default_exception_handler,
+      propagate = TRUE,
+      replace_empty = "<NULL>",
+      transformer = NULL
+      ){
+        # fields
+        # threshold must be set *after* the logging functions have been initalized
+        if (identical(name, "(unnamed logger)")){
+          warning(
+            "When creating a new Logger, you should assign it a unique `name`. ",
+            "Please see ?Logger for more infos.", call. = FALSE
+          )
+        }
+
+        private$set_name(name)
+        private$.last_event <- LogEvent$new(self)
+
+        self$set_threshold(threshold)
+        self$set_appenders(appenders)
+        self$set_propagate(propagate)
+        self$set_filters(filters)
+        self$set_exception_handler(exception_handler)
+        self$set_replace_empty(replace_empty)
+        self$set_transformer(transformer)
+
+        invisible(self)
+      },
+
+    # .. methods --------------------------------------------------------------
     fatal = function(..., caller = get_caller(-8L), .envir = parent.frame()){
       if (isTRUE(get("threshold", envir = self) < 100L))
         return(invisible())
@@ -918,8 +975,18 @@ LoggerGlue <- R6::R6Class(
           }
         })
 
+        dots_msg <- replace_empty(dots_msg, get("replace_empty", self))
         rawMsg <- dots[[1]]
-        msg <- do.call(glue::glue, args = c(dots_msg, list(.envir = .envir)))
+
+        glue_args <- list(.envir = .envir)
+
+        transformer <- get("transformer", self)
+
+        if (!is.null(transformer)){
+          glue_args[[".transformer"]] <- transformer
+        }
+
+        msg <- do.call(glue::glue, args = c(dots_msg, glue_args))
 
         # Check if LogEvent should be created
         if (
@@ -992,7 +1059,31 @@ LoggerGlue <- R6::R6Class(
 
     spawn = function(name){
       get_logger_glue(c(private[[".name"]], name))
+    },
+
+    # .. setters -----------------------------------------------------------------
+
+    #' @description Set the transformer for glue string interpolation
+    #'
+    #' @param x single [function] taking two arguments. See [glue::glue()].
+    set_transformer = function(x){
+      private[[".transformer"]] <- x
+
+      invisible(self)
+    }
+  ),
+
+  # .. active bindings ---------------------------------------------------
+  active = list(
+    transformer = function() {
+      get(".transformer", envir = private)
     }
+  ),
+
+
+  # . private ------------------------------------
+  private = list(
+    .transformer = NULL
   )
 )
 

R/utils-sfmisc.R

@@ -58,13 +58,19 @@ class_fmt <- function(x, ignore = NULL){
 }
 
 
-
-
 compact <- function(x){
-  x[!vapply(x, is.null, FALSE)]
+  x[!vapply(x, is_empty, FALSE)]
 }
 
 
+replace_empty <- function(x, fallback = "<NULL>"){
+  for (i in seq_along(x)){
+    if (is_empty(x[[i]])){
+      x[[i]] <- fallback
+    }
+  }
+  x
+}
 
 
 walk <- function(.x, .f, ...){
@@ -385,14 +391,14 @@ is_equal_length <- function(...){
 
 #' Check if Object has length 0
 #'
-#' Check wheter an object is either `TRUE` or `FALSE`.
+#' Check whether an object is either `TRUE` or `FALSE`.
 #'
 #' @param x Any \R Object.
 #' @return either `TRUE` or `FALSE`
 #' @noRd
 #'
 is_empty <- function(x){
-  identical(length(x), 0L)
+  !length(x)
 }
 
 

tests/testthat/test_Logger.R

@@ -321,6 +321,24 @@ test_that("$ancestry works", {
 })
 
 
+test_that("Logger handles null values", {
+  l <- Logger$new("test", propagate = FALSE)
+
+  log_null <- l$info("foo %s %s", NULL, character())
+  expect_equal(log_null, "foo <NULL> <NULL>")
+})
+
+
+test_that("Logger handles null values along with named parameters", {
+  l <- Logger$new("test", propagate = FALSE)
+
+  log_null <- l$info("foo %s %s", NULL, character(), valbert = "hashbaz", nullbert = NULL)
+  expect_equal(log_null, "foo <NULL> <NULL>")
+
+  expect_true(l$last_event$valbert == "hashbaz")
+  expect_true("nullbert" %in% names(l$last_event$values))
+  expect_null(l$last_event$nullbert)
+})
 
 
 # LoggerGlue --------------------------------------------------------------
@@ -347,8 +365,6 @@ test_that("LoggerGlue supports custom fields", {
 })
 
 
-
-
 test_that("LoggerGlue uses the correct evaluation environment", {
   l <- LoggerGlue$new("glue", propagate = FALSE)
 
@@ -359,8 +375,6 @@ test_that("LoggerGlue uses the correct evaluation environment", {
 })
 
 
-
-
 test_that("$config works with lists", {
   l <- LoggerGlue$new("glue", propagate = FALSE)
 
@@ -380,6 +394,40 @@ test_that("$config works with lists", {
 })
 
 
+test_that("LoggerGlue handles null values", {
+  l <- LoggerGlue$new("glue", propagate = FALSE)
+
+  log_null <- l$info("foo", NULL)
+  expect_equal(log_null, "foo<NULL>")
+
+  log_null_parameter <- l$info("foo {bar} {baz}", bar = NULL, baz = character())
+  expect_equal(log_null_parameter, "foo <NULL> <NULL>")
+})
+
+
+test_that("LoggerGlue handles null values along with named parameters", {
+  l <- LoggerGlue$new("test", propagate = FALSE)
+
+  log_null <- l$info("foo ", NULL, character(), valbert = "hashbaz", nullbert = NULL)
+  expect_equal(log_null, "foo <NULL><NULL>")
+
+  expect_true(l$last_event$valbert == "hashbaz")
+  expect_true("nullbert" %in% names(l$last_event$values))
+  expect_null(l$last_event$nullbert)
+})
+
+
+test_that("Logger glue can use custom transformers", {
+  transformer <- function(text, envir) {
+    "transformed text"
+  }
+
+  l <- LoggerGlue$new("glue", propagate = FALSE, transformer = transformer)
+
+  e <- log_null <- l$info("foo {bar}", foo = "bar")
+
+  expect_equal(e, "foo transformed text")
+})
 
 
 # Multi-Logger tests -------------------------------------------------------------