Add stopifnot handler (#25)

* doc: Use `family` for `handlers`

* feat: Add `stopifnot`

* fix: Mask old `base::`usage

* doc: Fix code links

* fix: Don't remove "echo" if only `...`

* feat: Add `expect_identical_error`

* feat: Add `expect_identical_warning` and `expect_identical_message`

* tests: Add first tests for `stopifnot`

* tests: Add second tests for `stopifnot`

* tests: Add 3th tests for `stopifnot`

* tests: Add 4th tests for `stopifnot`

* doc: Add NEWS bullet

NAMESPACE

@@ -9,4 +9,5 @@ export(rotate_logs)
 export(set_logfile)
 export(set_timestamp_format)
 export(stop)
+export(stopifnot)
 export(warning)

NEWS.md

@@ -1,5 +1,8 @@
 # loggit DEV
 
+## New features
+* New `stopifnot()` handler. 
+
 ## Minor changes
 * All `set_*` functions use `message` instead of `print` for confirmation.
   This ensures that the confirmations no longer interfere with the log via echo.

R/handlers.R

@@ -1,20 +1,14 @@
-#' loggit's Exception Handlers
+#' Diagnostic Messages Log Handler
 #'
-#' These exception handlers are identical to base R's [message][base::message],
-#' [warning][base::warning], and [stop][base::stop], but with included logging
-#' of the exception messages via `loggit()`.
+#' This function is identical to base R's [`message`][base::message],
+#' but it includes logging of the exception message via `loggit()`.
 #'
-#' @param .loggit Should loggit function execute? Defaults to `TRUE`.
-#' @param echo Should loggit's log entry be echoed to the console, as well?
-#'   Defaults to `TRUE`.
+#' @inherit base::message params return
 #'
-#' @name handlers
-NULL
-
-
-#' @rdname handlers
+#' @param .loggit Should loggit function execute? Defaults to `TRUE`.
+#' @param echo Should loggit's log entry be echoed to the console, as well? Defaults to `TRUE`.
 #'
-#' @inheritParams base::message
+#' @family handlers
 #'
 #' @examples
 #'   if (2 < 1) message("Don't say such silly things!")
@@ -28,9 +22,15 @@ message <- function(..., domain = NULL, appendLF = TRUE, .loggit = TRUE, echo =
 }
 
 
-#' @rdname handlers
+#' Warning Messages Log Handler
+#'
+#' This function is identical to base R's [`warning`][base::warning],
+#' but it includes logging of the exception message via `loggit()`.
 #'
-#' @inheritParams base::warning
+#' @inherit base::warning params return
+#' @inheritParams message
+#'
+#' @family handlers
 #'
 #' @examples
 #'   if (2 < 1) warning("You may want to review that math, and so this is your warning")
@@ -45,9 +45,15 @@ warning <- function(..., call. = TRUE, immediate. = FALSE, noBreaks. = FALSE,
 }
 
 
-#' @rdname handlers
+#' Stop Function Log Handler
+#'
+#' This function is identical to base R's [`stop`][base::stop],
+#' but it includes logging of the exception message via `loggit()`.
 #'
-#' @inheritParams base::stop
+#' @inherit base::stop params
+#' @inheritParams message
+#'
+#' @family handlers
 #'
 #' @examples
 #'   if (2 < 1) stop("This is a completely false condition, which throws an error")
@@ -59,3 +65,34 @@ stop <- function(..., call. = TRUE, domain = NULL, .loggit = TRUE, echo = TRUE)
 
   base::stop(unlist(args), call. = call., domain = domain)
 }
+
+#' Conditional Stop Function Log Handler
+#'
+#' This function is identical to base R's [`stopifnot`][base::stopifnot],
+#' but it includes logging of the exception message via `loggit()`.
+#'
+#' @inherit base::stopifnot params return
+#' @inheritParams message
+#'
+#' @family handlers
+#'
+#' @examples
+#'   stopifnot("This is a completely false condition, which throws an error" = TRUE)
+#'
+#' @export
+stopifnot <- function(..., exprObject, local, echo = TRUE) {
+  # Since no calling function can be detected within tryCatch from base::stopifnot
+  call <- if (p <- sys.parent(1L)) sys.call(p)
+  # Required to avoid early (and simultaneous) evaluation of the arguments.
+  # Also handles the case of 'missing' at the same time.
+  call_args <- as.list(match.call()[-1L])
+  if(!is.null(names(call_args))) call_args <- call_args[names(call_args) != "echo"]
+  stop_call <- as.call(c(quote(base::stopifnot), call_args))
+  tryCatch({
+    eval.parent(stop_call, 1L)
+  }, error = function(e) {
+    cond <- simpleError(message = e$message, call = call)
+    loggit(log_lvl = "ERROR", log_msg = cond$message, echo = echo)
+    signalCondition(cond = cond)
+  })
+}

R/utils.R

@@ -19,7 +19,7 @@
 #' @export
 read_logs <- function(logfile = get_logfile(), unsanitizer = default_ndjson_unsanitizer) {
 
-  stopifnot("Log file does not exist" = file.exists(logfile))
+  base::stopifnot("Log file does not exist" = file.exists(logfile))
 
   read_ndjson(logfile, unsanitizer = unsanitizer)
 }

tests/testthat/setup.R

@@ -3,3 +3,51 @@
 cleanup <- function() {
   file.remove(.config$logfile)
 }
+
+expect_identical_condition <- function(actual, expected, type = c("message", "warning", "error")) {
+  type <- match.arg(type)
+
+  capture <- switch(
+    type,
+    message = testthat::capture_message,
+    warning = testthat::capture_warning,
+    error = testthat::capture_error
+  )
+
+  capture.output({
+    actual <- capture(actual)
+    expected <- capture(expected)
+  })
+
+  if (is.null(actual)) {
+    testthat::fail("Actual don't throws an error.")
+  }
+  if (is.null(expected)) {
+    testthat::fail("Expected don't throws an error.")
+  }
+
+  if (actual$message != expected$message) {
+    testthat::fail(sprintf("Actual message is '%s' and expected is '%s'.", actual$message, expected$message))
+  }
+
+  if (xor(is.null(actual$call), is.null(expected$call))) {
+    if (is.null(actual$call)) {
+      fail(sprintf("Actual has no call, but expected has '%s'.", deparse(expected$call)))
+    } else {
+      fail(sprintf("Actual has call '%s', and expected has non.", deparse(actual$call)))
+    }
+  }
+
+  if (actual$call != expected$call) {
+    fail(sprintf("Actual has call '%s', but expected has '%s'", deparse(actual$call), deparse(expected$call)))
+  }
+
+  testthat::succeed()
+  return(invisible())
+}
+
+expect_identical_error <- function(actual, expected) expect_identical_condition(actual, expected, type = "error")
+
+expect_identical_warning <- function(actual, expected) expect_identical_condition(actual, expected, type = "warning")
+
+expect_identical_message <- function(actual, expected) expect_identical_condition(actual, expected, type = "message")