From 74258663469638a533bfc2e661c2e6219d924656 Mon Sep 17 00:00:00 2001 From: Alexander Rossell Hayes Date: Sun, 11 Feb 2024 18:40:47 -0800 Subject: [PATCH 1/7] refactor(check): create `is_nice()` helper function --- R/check.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/check.R b/R/check.R index b5f3cc7..2d99a41 100644 --- a/R/check.R +++ b/R/check.R @@ -17,9 +17,14 @@ #' x <- c("ten", "twenty", "thirty", "sixty nine") #' check(x) check <- function(x) { - if (any(x %in% c(69, 0.69, 0.069, 0.0069, "Sixty Nine", "sixty nine"))) { + if (is_nice(x)) { print("Nice!") } else { print("Not very nice.") } } + +is_nice <- function(x) { + any(x %in% c(69, 0.69, 0.069, 0.0069, "Sixty Nine", "sixty nine")) +} + From 972d1d1b3710ab605d088bab8ebf97b3b82f7245 Mon Sep 17 00:00:00 2001 From: Alexander Rossell Hayes Date: Sun, 11 Feb 2024 18:42:09 -0800 Subject: [PATCH 2/7] fix(is_nice): wrap logic in `isTRUE(try(...))` to prevent errors when called with an object that fails with `%in%` (e.g., a function definition) --- R/check.R | 8 ++++++-- tests/testthat/test-check.R | 1 + 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/R/check.R b/R/check.R index 2d99a41..0404055 100644 --- a/R/check.R +++ b/R/check.R @@ -25,6 +25,10 @@ check <- function(x) { } is_nice <- function(x) { - any(x %in% c(69, 0.69, 0.069, 0.0069, "Sixty Nine", "sixty nine")) + isTRUE( + try( + any(x %in% c(69, 0.69, 0.069, 0.0069, "Sixty Nine", "sixty nine")), + silent = TRUE + ) + ) } - diff --git a/tests/testthat/test-check.R b/tests/testthat/test-check.R index f10a29f..1e28e8d 100644 --- a/tests/testthat/test-check.R +++ b/tests/testthat/test-check.R @@ -12,4 +12,5 @@ test_that("check functions returns correct negative responses", { expect_equal(check(0.420), "Not very nice.") expect_equal(check(420), "Not very nice.") expect_equal(check("four twenty"), "Not very nice.") + expect_equal(check(check), "Not very nice.") }) From d4d1f9766b617d1a49d56bb1a8e38fc6e608f0d0 Mon Sep 17 00:00:00 2001 From: Alexander Rossell Hayes Date: Sun, 11 Feb 2024 19:29:02 -0800 Subject: [PATCH 3/7] feat(check_always): add function to register a task callback function to check all output (and a function to remove this task callback function) --- NAMESPACE | 2 ++ R/check_always.R | 44 ++++++++++++++++++++++++++++++++++++++++++++ man/check_always.Rd | 25 +++++++++++++++++++++++++ 3 files changed, 71 insertions(+) create mode 100644 R/check_always.R create mode 100644 man/check_always.Rd diff --git a/NAMESPACE b/NAMESPACE index 25c89ce..0b33f3a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,4 +1,6 @@ # Generated by roxygen2: do not edit by hand export(check) +export(check_always) export(check_df) +export(uncheck_always) diff --git a/R/check_always.R b/R/check_always.R new file mode 100644 index 0000000..4463923 --- /dev/null +++ b/R/check_always.R @@ -0,0 +1,44 @@ +nice_callback <- function(expr, value, ok, visible) { + if (visible && is_nice(value)) { + message("Nice!") + } + + return(TRUE) +} + +#' Always check whether R output is really nice +#' +#' `check_always()` creates a [task callback function][taskCallback()] +#' to check whether all R output is nice. +#' `uncheck_always()` disables the task callback function, +#' returning your R session to normal behavior. +#' +#' @keywords nice +#' +#' @export +#' +#' @examples +#' check_always() +#' 23 * 3 +#' +#' uncheck_always() +#' 23 * 3 +check_always <- function() { + if ("nice_callback" %in% getTaskCallbackNames()) { + return(message("Already checking whether all output is nice")) + } + + addTaskCallback(nice_callback, name = "nice_callback") + message("Now checking whether all output is nice") +} + +#' @rdname check_always +#' @export +uncheck_always <- function() { + if (!"nice_callback" %in% getTaskCallbackNames()) { + return(message("Not checking whether all output is nice")) + } + + removeTaskCallback("nice_callback") + message("No longer checking whether all output is nice") +} diff --git a/man/check_always.Rd b/man/check_always.Rd new file mode 100644 index 0000000..acba56f --- /dev/null +++ b/man/check_always.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nice_callback.R +\name{check_always} +\alias{check_always} +\alias{uncheck_always} +\title{Always check whether R output is really nice} +\usage{ +check_always() + +uncheck_always() +} +\description{ +\code{check_always()} creates a \link[=taskCallback]{task callback function} +to check whether all R output is nice. +\code{uncheck_always()} disables the task callback function, +returning your R session to normal behavior. +} +\examples{ +check_always() +23 * 3 + +uncheck_always() +23 * 3 +} +\keyword{nice} From 0a4ac84a1a7f902452c3dea6561188de44d9febb Mon Sep 17 00:00:00 2001 From: Alexander Rossell Hayes Date: Mon, 12 Feb 2024 20:48:39 -0800 Subject: [PATCH 4/7] docs: fix link to task callback documentation --- R/check_always.R | 2 +- man/check_always.Rd | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/check_always.R b/R/check_always.R index 4463923..2539c51 100644 --- a/R/check_always.R +++ b/R/check_always.R @@ -8,7 +8,7 @@ nice_callback <- function(expr, value, ok, visible) { #' Always check whether R output is really nice #' -#' `check_always()` creates a [task callback function][taskCallback()] +#' `check_always()` creates a [task callback function][addTaskCallback()] #' to check whether all R output is nice. #' `uncheck_always()` disables the task callback function, #' returning your R session to normal behavior. diff --git a/man/check_always.Rd b/man/check_always.Rd index acba56f..e08a010 100644 --- a/man/check_always.Rd +++ b/man/check_always.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/nice_callback.R +% Please edit documentation in R/check_always.R \name{check_always} \alias{check_always} \alias{uncheck_always} @@ -10,7 +10,7 @@ check_always() uncheck_always() } \description{ -\code{check_always()} creates a \link[=taskCallback]{task callback function} +\code{check_always()} creates a \link[=addTaskCallback]{task callback function} to check whether all R output is nice. \code{uncheck_always()} disables the task callback function, returning your R session to normal behavior. From 5bec800fc4d85139d02d63ec443e5a6f91fe64b4 Mon Sep 17 00:00:00 2001 From: Alexander Rossell Hayes Date: Mon, 12 Feb 2024 21:22:21 -0800 Subject: [PATCH 5/7] test(check_always): add tests --- tests/testthat/test-check_always.R | 62 ++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) create mode 100644 tests/testthat/test-check_always.R diff --git a/tests/testthat/test-check_always.R b/tests/testthat/test-check_always.R new file mode 100644 index 0000000..3c4ae35 --- /dev/null +++ b/tests/testthat/test-check_always.R @@ -0,0 +1,62 @@ +test_that("check_always() adds callback", { + expect_message( + check_always(), + "Now checking whether all output is nice" + ) + + expect_true("nice_callback" %in% getTaskCallbackNames()) +}) + +test_that("uncheck_always() removes callback", { + expect_message(check_always()) + + expect_message( + uncheck_always(), + "No longer checking whether all output is nice" + ) + + expect_false("nice_callback" %in% getTaskCallbackNames()) +}) + +test_that("check_always() doesn't add duplicate callback tasks", { + expect_message(check_always()) + + callback_list <- getTaskCallbackNames() + + expect_message( + check_always(), + "Already checking whether all output is nice" + ) + + expect_identical(getTaskCallbackNames(), callback_list) +}) + +test_that("uncheck_always() does nothing if there is no task callback", { + expect_message(uncheck_always()) + + callback_list <- getTaskCallbackNames() + + expect_message( + uncheck_always(), + "Not checking whether all output is nice" + ) + + expect_identical(getTaskCallbackNames(), callback_list) +}) + +test_that("nice_callback() gives message for nice values", { + expect_message( + nice_callback(quote(69), 69, TRUE, TRUE), + "Nice!" + ) + + expect_silent( + nice_callback(quote(420), 420, TRUE, TRUE) + ) +}) + +test_that("nice_callback() doesn't give message for invisible values", { + expect_silent( + nice_callback(quote(invisible(69)), 69, TRUE, FALSE) + ) +}) From 71fa17d447a7d426956ccce8e7fd43eb930dc00a Mon Sep 17 00:00:00 2001 From: Alexander Rossell Hayes Date: Mon, 12 Feb 2024 21:34:28 -0800 Subject: [PATCH 6/7] feat(check_always): add `verbose` argument which can be used to suppress messages --- R/check_always.R | 18 ++++++++++++------ man/check_always.Rd | 9 +++++++-- tests/testthat/test-check_always.R | 12 ++++++++++-- 3 files changed, 29 insertions(+), 10 deletions(-) diff --git a/R/check_always.R b/R/check_always.R index 2539c51..ecfb3a3 100644 --- a/R/check_always.R +++ b/R/check_always.R @@ -13,6 +13,10 @@ nice_callback <- function(expr, value, ok, visible) { #' `uncheck_always()` disables the task callback function, #' returning your R session to normal behavior. #' +#' @param verbose If `TRUE`, prints a message when `check_always()` and +#' `uncheck_always()` are run. +#' Defaults to `TRUE`. +#' #' @keywords nice #' #' @export @@ -23,22 +27,24 @@ nice_callback <- function(expr, value, ok, visible) { #' #' uncheck_always() #' 23 * 3 -check_always <- function() { +check_always <- function(verbose = TRUE) { if ("nice_callback" %in% getTaskCallbackNames()) { - return(message("Already checking whether all output is nice")) + if (isTRUE(verbose)) message("Already checking whether all output is nice") + return(invisible()) } addTaskCallback(nice_callback, name = "nice_callback") - message("Now checking whether all output is nice") + if (isTRUE(verbose)) message("Now checking whether all output is nice") } #' @rdname check_always #' @export -uncheck_always <- function() { +uncheck_always <- function(verbose = TRUE) { if (!"nice_callback" %in% getTaskCallbackNames()) { - return(message("Not checking whether all output is nice")) + if (isTRUE(verbose)) message("Not checking whether all output is nice") + return(invisible()) } removeTaskCallback("nice_callback") - message("No longer checking whether all output is nice") + if (isTRUE(verbose)) message("No longer checking whether all output is nice") } diff --git a/man/check_always.Rd b/man/check_always.Rd index e08a010..beb4a63 100644 --- a/man/check_always.Rd +++ b/man/check_always.Rd @@ -5,9 +5,14 @@ \alias{uncheck_always} \title{Always check whether R output is really nice} \usage{ -check_always() +check_always(verbose = TRUE) -uncheck_always() +uncheck_always(verbose = TRUE) +} +\arguments{ +\item{verbose}{If \code{TRUE}, prints a message when \code{check_always()} and +\code{uncheck_always()} are run. +Defaults to \code{TRUE}.} } \description{ \code{check_always()} creates a \link[=addTaskCallback]{task callback function} diff --git a/tests/testthat/test-check_always.R b/tests/testthat/test-check_always.R index 3c4ae35..0200c27 100644 --- a/tests/testthat/test-check_always.R +++ b/tests/testthat/test-check_always.R @@ -18,8 +18,16 @@ test_that("uncheck_always() removes callback", { expect_false("nice_callback" %in% getTaskCallbackNames()) }) +test_that("verbose argument controls messages", { + expect_silent(check_always(verbose = FALSE)) + expect_true("nice_callback" %in% getTaskCallbackNames()) + + expect_silent(uncheck_always(verbose = FALSE)) + expect_false("nice_callback" %in% getTaskCallbackNames()) +}) + test_that("check_always() doesn't add duplicate callback tasks", { - expect_message(check_always()) + check_always(verbose = FALSE) callback_list <- getTaskCallbackNames() @@ -32,7 +40,7 @@ test_that("check_always() doesn't add duplicate callback tasks", { }) test_that("uncheck_always() does nothing if there is no task callback", { - expect_message(uncheck_always()) + uncheck_always(verbose = FALSE) callback_list <- getTaskCallbackNames() From a419b24b851128e067a83286c16961638c422e94 Mon Sep 17 00:00:00 2001 From: Paul Johnson Date: Tue, 13 Feb 2024 11:12:13 +0000 Subject: [PATCH 7/7] Add check_always() reference to _pkgdown.yml --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index ffb2434..582adfd 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -27,3 +27,4 @@ reference: contents: - check - check_df + - check_always