From 3153fc006887b4a67d0f2f073d159f7a3ae99731 Mon Sep 17 00:00:00 2001 From: MEO265 <99362508+MEO265@users.noreply.github.com> Date: Thu, 11 Jan 2024 21:29:59 +0100 Subject: [PATCH] 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 | 1 + NEWS.md | 3 ++ R/handlers.R | 71 +++++++++++++++++++++++++-------- R/utils.R | 2 +- man/message.Rd | 38 ++++++++++++++++++ man/stop.Rd | 38 ++++++++++++++++++ man/stopifnot.Rd | 44 ++++++++++++++++++++ man/{handlers.Rd => warning.Rd} | 52 +++++++++++------------- tests/testthat/setup.R | 48 ++++++++++++++++++++++ tests/testthat/test-handlers.R | 46 +++++++++++++++++++-- 10 files changed, 293 insertions(+), 50 deletions(-) create mode 100644 man/message.Rd create mode 100644 man/stop.Rd create mode 100644 man/stopifnot.Rd rename man/{handlers.Rd => warning.Rd} (56%) diff --git a/NAMESPACE b/NAMESPACE index 03cf87f..fa73cef 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,4 +9,5 @@ export(rotate_logs) export(set_logfile) export(set_timestamp_format) export(stop) +export(stopifnot) export(warning) diff --git a/NEWS.md b/NEWS.md index 14bb07d..ef2aa2e 100644 --- a/NEWS.md +++ b/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. diff --git a/R/handlers.R b/R/handlers.R index 2f5ac80..0f8158d 100644 --- a/R/handlers.R +++ b/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) + }) +} diff --git a/R/utils.R b/R/utils.R index ce7bdca..95ab3e8 100644 --- a/R/utils.R +++ b/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) } diff --git a/man/message.Rd b/man/message.Rd new file mode 100644 index 0000000..bc7e118 --- /dev/null +++ b/man/message.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/handlers.R +\name{message} +\alias{message} +\title{Diagnostic Messages Log Handler} +\usage{ +message(..., domain = NULL, appendLF = TRUE, .loggit = TRUE, echo = TRUE) +} +\arguments{ +\item{...}{zero or more objects which can be coerced to character + (and which are pasted together with no separator) or (for + \code{message} only) a single condition object.} + +\item{domain}{see \code{\link[base]{gettext}}. If \code{NA}, messages will + not be translated, see also the note in \code{\link[base]{stop}}.} + +\item{appendLF}{logical: should messages given as a character string + have a newline appended?} + +\item{.loggit}{Should loggit function execute? Defaults to \code{TRUE}.} + +\item{echo}{Should loggit's log entry be echoed to the console, as well? Defaults to \code{TRUE}.} +} +\description{ +This function is identical to base R's \code{\link[base:message]{message}}, +but it includes logging of the exception message via \code{loggit()}. +} +\examples{ + if (2 < 1) message("Don't say such silly things!") + +} +\seealso{ +Other handlers: +\code{\link{stopifnot}()}, +\code{\link{stop}()}, +\code{\link{warning}()} +} +\concept{handlers} diff --git a/man/stop.Rd b/man/stop.Rd new file mode 100644 index 0000000..0f1b407 --- /dev/null +++ b/man/stop.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/handlers.R +\name{stop} +\alias{stop} +\title{Stop Function Log Handler} +\usage{ +stop(..., call. = TRUE, domain = NULL, .loggit = TRUE, echo = TRUE) +} +\arguments{ +\item{...}{zero or more objects which can be coerced to character + (and which are pasted together with no separator) or a single + condition object.} + +\item{call.}{logical, indicating if the call should become part of the + error message.} + +\item{domain}{see \code{\link[base]{gettext}}. If \code{NA}, messages will + not be translated.} + +\item{.loggit}{Should loggit function execute? Defaults to \code{TRUE}.} + +\item{echo}{Should loggit's log entry be echoed to the console, as well? Defaults to \code{TRUE}.} +} +\description{ +This function is identical to base R's \code{\link[base:stop]{stop}}, +but it includes logging of the exception message via \code{loggit()}. +} +\examples{ + if (2 < 1) stop("This is a completely false condition, which throws an error") + +} +\seealso{ +Other handlers: +\code{\link{message}()}, +\code{\link{stopifnot}()}, +\code{\link{warning}()} +} +\concept{handlers} diff --git a/man/stopifnot.Rd b/man/stopifnot.Rd new file mode 100644 index 0000000..1c3d79f --- /dev/null +++ b/man/stopifnot.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/handlers.R +\name{stopifnot} +\alias{stopifnot} +\title{Conditional Stop Function Log Handler} +\usage{ +stopifnot(..., exprObject, local, echo = TRUE) +} +\arguments{ +\item{...}{zero or more objects which can be coerced to character + (and which are pasted together with no separator) or (for + \code{message} only) a single condition object.} + +\item{exprObject}{alternative to \code{exprs} or \code{...}: + an \sQuote{expression-like} object, typically an + \code{\link[base]{expression}}, but also a \code{\link[base]{call}}, a + \code{\link[base]{name}}, or atomic constant such as \code{TRUE}. + } + +\item{local}{(only when \code{exprs} is used:) indicates the + \code{\link[base]{environment}} in which the expressions should be + evaluated; by default the one from where \code{stopifnot()} has been + called.} + +\item{echo}{Should loggit's log entry be echoed to the console, as well? Defaults to \code{TRUE}.} +} +\value{ +(\code{\link[base]{NULL}} if all statements in \code{\dots} are \code{TRUE}.) +} +\description{ +This function is identical to base R's \code{\link[base:stopifnot]{stopifnot}}, +but it includes logging of the exception message via \code{loggit()}. +} +\examples{ + stopifnot("This is a completely false condition, which throws an error" = TRUE) + +} +\seealso{ +Other handlers: +\code{\link{message}()}, +\code{\link{stop}()}, +\code{\link{warning}()} +} +\concept{handlers} diff --git a/man/handlers.Rd b/man/warning.Rd similarity index 56% rename from man/handlers.Rd rename to man/warning.Rd index 79e9454..54bee75 100644 --- a/man/handlers.Rd +++ b/man/warning.Rd @@ -1,14 +1,9 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/handlers.R -\name{handlers} -\alias{handlers} -\alias{message} +\name{warning} \alias{warning} -\alias{stop} -\title{loggit's Exception Handlers} +\title{Warning Messages Log Handler} \usage{ -message(..., domain = NULL, appendLF = TRUE, .loggit = TRUE, echo = TRUE) - warning( ..., call. = TRUE, @@ -18,24 +13,11 @@ warning( .loggit = TRUE, echo = TRUE ) - -stop(..., call. = TRUE, domain = NULL, .loggit = TRUE, echo = TRUE) } \arguments{ \item{...}{zero or more objects which can be coerced to character - (and which are pasted together with no separator) or (for - \code{message} only) a single condition object.} - -\item{domain}{see \code{\link[base]{gettext}}. If \code{NA}, messages will - not be translated, see also the note in \code{\link[base]{stop}}.} - -\item{appendLF}{logical: should messages given as a character string - have a newline appended?} - -\item{.loggit}{Should loggit function execute? Defaults to \code{TRUE}.} - -\item{echo}{Should loggit's log entry be echoed to the console, as well? -Defaults to \code{TRUE}.} + (and which are pasted together with no separator) or a single + condition object.} \item{call.}{logical, indicating if the call should become part of the warning message.} @@ -45,17 +27,29 @@ Defaults to \code{TRUE}.} \item{noBreaks.}{logical, indicating as far as possible the message should be output as a single line when \code{options(warn = 1)}.} + +\item{domain}{see \code{\link[base]{gettext}}. If \code{NA}, messages will + not be translated, see also the note in \code{\link[base]{stop}}.} + +\item{.loggit}{Should loggit function execute? Defaults to \code{TRUE}.} + +\item{echo}{Should loggit's log entry be echoed to the console, as well? Defaults to \code{TRUE}.} +} +\value{ +The warning message as \code{\link[base]{character}} string, invisibly. } \description{ -These exception handlers are identical to base R's \link[base:message]{message}, -\link[base:warning]{warning}, and \link[base:stop]{stop}, but with included logging -of the exception messages via \code{loggit()}. +This function is identical to base R's \code{\link[base:warning]{warning}}, +but it includes logging of the exception message via \code{loggit()}. } \examples{ - if (2 < 1) message("Don't say such silly things!") - if (2 < 1) warning("You may want to review that math, and so this is your warning") - if (2 < 1) stop("This is a completely false condition, which throws an error") - } +\seealso{ +Other handlers: +\code{\link{message}()}, +\code{\link{stopifnot}()}, +\code{\link{stop}()} +} +\concept{handlers} diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 8059874..4847964 100644 --- a/tests/testthat/setup.R +++ b/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") \ No newline at end of file diff --git a/tests/testthat/test-handlers.R b/tests/testthat/test-handlers.R index ab6d64d..e383674 100644 --- a/tests/testthat/test-handlers.R +++ b/tests/testthat/test-handlers.R @@ -1,7 +1,7 @@ test_that("message works as it does in base R", { expect_message(base::message("this is a message test")) expect_message(loggit::message("this is also a message test", echo = FALSE)) - + # Multiple args are concatenated captured_output <- capture_output( loggit::message('this should be ', 'concatenated ', 'in the log') @@ -13,7 +13,7 @@ test_that("message works as it does in base R", { test_that("warning works as it does in base R", { expect_warning(base::warning("this is a warning test")) expect_warning(loggit::warning("this is also a warning test", echo = FALSE)) - + # Multiple args are concatenated suppressWarnings( captured_output <- capture_output( @@ -27,7 +27,7 @@ test_that("warning works as it does in base R", { test_that("stop works as it does in base R", { expect_error(base::stop("this is a stop test")) expect_error(loggit::stop("this is also a stop test", echo = FALSE)) - + # Multiple args are concatenated # Test looks different to get around the stop() call expect_error(loggit::stop('this should be ', 'concatenated ', 'in the log', echo = FALSE)) @@ -38,3 +38,43 @@ test_that("stop works as it does in base R", { }) cleanup() + +test_that("stopifnot", { + # stopifnot works as in base R (with echo = TRUE) + expect_no_error(stopifnot()) + expect_identical_error(stopifnot(FALSE), base::stopifnot(FALSE)) + f <- function(x, ...) x + expect_identical_error(stopifnot(f(x = FALSE)), base::stopifnot(f(x = FALSE))) + g <- function() f(FALSE) + expect_identical_error(stopifnot(4 == 4, g()), base::stopifnot(4 == 4, g())) + expect_identical_error(stopifnot(4 == 4, "Test" = g()), base::stopifnot(4 == 4, "Test" = g())) + expect_identical_error(stopifnot(exprs = { TRUE; FALSE }), base::stopifnot(exprs = { TRUE; FALSE })) + expect_identical_error(stopifnot(exprObject = { TRUE; FALSE }), base::stopifnot(exprObject = { TRUE; FALSE })) + expect_no_error(stopifnot(TRUE, 3 == 3)) + + # stopifnot works as in base R (with echo = FALSE) + expect_no_error(stopifnot(echo = FALSE)) + expect_identical_error(stopifnot(FALSE, echo = FALSE), base::stopifnot(FALSE)) + f <- function(x, ...) x + expect_identical_error(stopifnot(f(x = FALSE), echo = FALSE), base::stopifnot(f(x = FALSE))) + g <- function() f(FALSE) + expect_identical_error(stopifnot(4 == 4, g(), echo = FALSE), base::stopifnot(4 == 4, g())) + expect_identical_error(stopifnot(4 == 4, "A Test" = g(), echo = FALSE), base::stopifnot(4 == 4, "A Test" = g())) + expect_identical_error(stopifnot(exprs = { TRUE; FALSE }, echo = FALSE), base::stopifnot(exprs = { TRUE; FALSE })) + expect_identical_error(stopifnot(exprObject = { TRUE; FALSE }, echo = FALSE), base::stopifnot(exprObject = { TRUE; FALSE })) + expect_no_error(stopifnot(TRUE, 3 == 3, echo = FALSE)) + + cleanup() + + # Test for logging + expect_output(try(stopifnot("This is a stop if not error" = FALSE), silent = TRUE)) + expect_silent(try(stopifnot("Should not echo" = FALSE, echo = FALSE), silent = TRUE)) + stopifnot("Should not show" = TRUE) + log_actual <- read_logs() + expect_setequal(names(log_actual), c("timestamp", "log_lvl", "log_msg")) + log_actual$timestamp <- NULL + log_expected <- data.frame(log_lvl = "ERROR", log_msg = c("This is a stop if not error", "Should not echo")) + expect_equal(log_actual, log_expected) +}) + +cleanup() \ No newline at end of file