Merge pull request #7 from rossellhayes/feat/check_always

Add `check_always()` function to start checking all output automatically

NAMESPACE

@@ -1,4 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
 export(check)
+export(check_always)
 export(check_df)
+export(uncheck_always)

R/check.R

@@ -17,9 +17,18 @@
 #' 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) {
+  isTRUE(
+    try(
+      any(x %in% c(69, 0.69, 0.069, 0.0069, "Sixty Nine", "sixty nine")),
+      silent = TRUE
+    )
+  )
+}

R/check_always.R

@@ -0,0 +1,50 @@
+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][addTaskCallback()]
+#' to check whether all R output is nice.
+#' `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
+#'
+#' @examples
+#' check_always()
+#' 23 * 3
+#'
+#' uncheck_always()
+#' 23 * 3
+check_always <- function(verbose = TRUE) {
+  if ("nice_callback" %in% getTaskCallbackNames()) {
+    if (isTRUE(verbose)) message("Already checking whether all output is nice")
+    return(invisible())
+  }
+
+  addTaskCallback(nice_callback, name = "nice_callback")
+  if (isTRUE(verbose)) message("Now checking whether all output is nice")
+}
+
+#' @rdname check_always
+#' @export
+uncheck_always <- function(verbose = TRUE) {
+  if (!"nice_callback" %in% getTaskCallbackNames()) {
+    if (isTRUE(verbose)) message("Not checking whether all output is nice")
+    return(invisible())
+  }
+
+  removeTaskCallback("nice_callback")
+  if (isTRUE(verbose)) message("No longer checking whether all output is nice")
+}

_pkgdown.yml

@@ -27,3 +27,4 @@ reference:
     contents:
       - check
       - check_df
+      - check_always

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.")
 })

tests/testthat/test-check_always.R

@@ -0,0 +1,70 @@
+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("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", {
+  check_always(verbose = FALSE)
+
+  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", {
+  uncheck_always(verbose = FALSE)
+
+  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)
+  )
+})