From 5c5aaee2d8ab4778d0b197ec61ecad390f5fba8e Mon Sep 17 00:00:00 2001
From: Eliot McIntire <eliotmci@mail.ubc.ca>
Date: Thu, 5 Dec 2024 12:10:08 -0800
Subject: [PATCH] rm crayon; update tests for cli

---
 DESCRIPTION                 |  1 -
 R/messages.R                | 10 +++++-----
 tests/testthat/test-cache.R | 15 +++++++--------
 3 files changed, 12 insertions(+), 14 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 82c3d5694..fc43a73b5 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -65,7 +65,6 @@ Imports:
 Suggests:
     archive,
     covr,
-    crayon,
     DBI,
     future,
     geodata,
diff --git a/R/messages.R b/R/messages.R
index 4a3d713e3..bb503c650 100644
--- a/R/messages.R
+++ b/R/messages.R
@@ -223,10 +223,10 @@ messageColoured <- function(..., colour = NULL, indent = NULL, hangingIndent = T
 
     } else {
 
-      needCrayon <- FALSE
+      needCli <- FALSE
       if (!is.null(colour)) {
         if (is.character(colour)) {
-          needCrayon <- TRUE
+          needCli <- TRUE
         }
       }
       mess <- paste0(..., collapse = "")
@@ -283,15 +283,15 @@ messageColoured <- function(..., colour = NULL, indent = NULL, hangingIndent = T
       }
       if (any(grepl(.spaceTmpChar, mess)))
         mess <- gsub(.spaceTmpChar, " ", mess)
-      if (needCrayon && requireNamespace("cli", quietly = TRUE)) {
+      if (needCli && requireNamespace("cli", quietly = TRUE)) {
         mess <- lapply(strsplit(mess, "\n"), function(m)
           paste0(cliCol(colour)(m)))[[1]]
         mess <- .addSlashNToAllButFinalElement(mess)
         message(mess, appendLF = appendLF)
       } else {
-        if (needCrayon && !isTRUE(.pkgEnv$.checkedCrayon) && !.requireNamespace("cli")) {
+        if (needCli && !isTRUE(.pkgEnv$.checkedCli) && !.requireNamespace("cli")) {
           message("To add colours to messages, install.packages('cli')", appendLF = appendLF)
-          .pkgEnv$.checkedCrayon <- TRUE
+          .pkgEnv$.checkedCli <- TRUE
         }
         message(mess, appendLF = appendLF)
       }
diff --git a/tests/testthat/test-cache.R b/tests/testthat/test-cache.R
index f9c9b154d..259e2011a 100644
--- a/tests/testthat/test-cache.R
+++ b/tests/testthat/test-cache.R
@@ -564,7 +564,7 @@ test_that("test asPath", {
     .message$LoadedCacheResult("Memoised"), "|",
     .message$LoadedCacheResult()
   ), a2)) == 1)
-  expect_true(sum(grepl(paste(.message$LoadedCacheResult("Memoised"), "saveRDS call"), a3)) == 1)
+  expect_true(sum(grepl(paste(.message$LoadedCacheResult("Memoised"), ".*saveRDS.*call"), a3)) == 1)
 
   unlink("filename.RData")
   try(clearCache(tmpdir, ask = FALSE), silent = TRUE)
@@ -585,7 +585,7 @@ test_that("test asPath", {
     .message$LoadedCacheResult("Memoised"), "|",
     .message$LoadedCacheResult()
   ), a2)) == 1)
-  expect_true(sum(grepl(paste(.message$LoadedCacheResult("Memoised"), "saveRDS call"), a3)) == 1)
+  expect_true(sum(cli::ansi_grepl(paste(.message$LoadedCacheResult("Memoised"), "saveRDS call"), a3)) == 1)
 })
 
 test_that("test wrong ways of calling Cache", {
@@ -654,7 +654,7 @@ test_that("test Cache argument inheritance to inner functions", {
   # does cachePath propagate to outer ones -- no message about cachePath being tempdir()
   out <- capture_messages(Cache(outer, n = 2, cachePath = tmpdir))
   expect_true(length(out) == 2)
-  expect_true(sum(grepl(paste(.message$LoadedCacheResult(), "outer call"), out)) == 1)
+  expect_true(sum(cli::ansi_grepl(paste(.message$LoadedCacheResult(), "outer call"), out)) == 1)
 
   # check that the rnorm inside "outer" returns cached value even if outer "outer" function is changed
   outer <- function(n) {
@@ -667,7 +667,7 @@ test_that("test Cache argument inheritance to inner functions", {
                    "There is no similar item in the cachePath",
                    sep = "|"
   )
-  expect_true(sum(grepl(msgGrep, out)) == 1)
+  expect_true(sum(cli::ansi_grepl(msgGrep, out)) == 1)
 
   # Override with explicit argument
   outer <- function(n) {
@@ -690,7 +690,7 @@ test_that("test Cache argument inheritance to inner functions", {
   # Second time will get a cache on outer
   out <- capture_messages(Cache(outer, n = 2, cachePath = tmpdir))
   expect_true(length(out) == 2)
-  expect_true(sum(grepl(paste(.message$LoadedCacheResult(), "outer call"), out)) == 1)
+  expect_true(sum(cli::ansi_grepl(paste(.message$LoadedCacheResult(), "outer call"), out)) == 1)
 
   # doubly nested
   inner <- function(mean, useCache = TRUE) {
@@ -728,7 +728,7 @@ test_that("test Cache argument inheritance to inner functions", {
                    "There is no similar item in the cachePath",
                    sep = "|"
   )
-  expect_true(sum(grepl(msgGrep, out)) == 1)
+  expect_true(sum(cli::ansi_grepl(msgGrep, out)) == 1)
 
   # Check userTags -- all items have it
   clearCache(tmpdir, ask = FALSE)
@@ -801,7 +801,7 @@ test_that("test future", {
   (dd <- system.time({
     for (i in 1:3) d[[i]] <- Cache(cachePath = tmpCache, rnorm(1e6 + i))
   }))
-  expect_true((dd[[3]] * 3) < aa[[3]])
+  expect_true((dd[[3]] * 2) < aa[[3]])
   for (i in 1:3) {
     expect_true(identical(attr(d[[i]], ".Cache")$newCache, FALSE))
   }
@@ -1361,7 +1361,6 @@ test_that("change to new capturing of FUN & base pipe", {
         # (function(xx) rnorm(1, 2, sd = xx))() |>
         Cache(cachePath = tmpCache)
     ")
-  browser()
   mess3 <- capture_messages(
     eval(parse(text = f2))
   )