Merge branch 'main' into mrc-5429

R/task-purge.R

@@ -68,6 +68,9 @@
 ##'   you cannot select tasks with status of `submitted` or `running`;
 ##'   use [task_cancel] for these first).
 ##'
+##' @param dry_run If TRUE, report what would have been done, but
+##'   no changes will be made.
+##'
 ##' @inheritParams task_eval
 ##'
 ##' @return A character vector of deleted identifiers, invisibly.
@@ -89,6 +92,7 @@ hipercow_purge <- function(task_ids = NULL,
                            finished_before = NULL,
                            in_bundle = NULL,
                            with_status = NULL,
+                           dry_run = FALSE,
                            root = NULL) {
   root <- hipercow_root(root)
   ids <- purge_select_ids(task_ids, finished_before, in_bundle, with_status,
@@ -122,14 +126,16 @@ hipercow_purge <- function(task_ids = NULL,
   }
 
   cli::cli_alert_info("Purging {length(ids)} task{?s}")
-  unlink(path_task(root$path$tasks, ids), recursive = TRUE)
+  maybe_unlink(path_task(root$path$tasks, ids), recursive = TRUE,
+         dry_run = dry_run)
 
   nms <- dir(root$path$bundles)
   contents <- lapply(nms, hipercow_bundle_load, root)
   to_delete <- vlapply(contents, function(x) any(ids %in% x$ids))
   if (any(to_delete)) {
     cli::cli_alert_info("Deleting {sum(to_delete)} task bundle{?s}")
-    unlink(file.path(root$path$bundles, nms[to_delete]))
+    maybe_unlink(file.path(root$path$bundles, nms[to_delete]),
+                 dry_run = dry_run)
   } else {
     cli::cli_alert_info("No task bundles need deleting")
   }

R/util.R

@@ -471,3 +471,14 @@ unlist_times <- function(x) {
 empty_time <- function() {
   Sys.time()[-1]
 }
+
+
+maybe_unlink <- function(x, recursive = FALSE, dry_run = FALSE) {
+  if (!dry_run) {
+    unlink(x, recursive)
+  } else {
+    cli::cli_rule(right = "Dry run - no files deleted {cli::symbol$arrow_down}")
+    cli::cli_bullets(set_names(paste0(x, if (recursive) " recursively."), "*"))
+    cli::cli_rule(right = "Dry run - no files deleted {cli::symbol$arrow_up}")
+  }
+}

tests/testthat/test-purge.R

@@ -280,10 +280,33 @@ test_that("disallow purging if running or submitted retried tasks selected", {
 })
 
 
-test_that("mut use at least one filter type", {
+test_that("must use at least one filter type", {
   path <- withr::local_tempdir()
   init_quietly(path)
   expect_error(
     hipercow_purge(root = path),
     "No filter selected")
 })
+
+test_that("can do a dry run purge", {
+  path <- withr::local_tempdir()
+  init_quietly(path)
+  b <- withr::with_dir(path,
+                       suppressMessages(task_create_bulk_call(sqrt, 1:5)))
+  res <- evaluate_promise(hipercow_purge(in_bundle = "*", root = path,
+                                         dry_run = TRUE))
+  expect_equal(res$result, b$ids)
+  expect_length(res$messages, 12)
+  expect_match(res$messages[[1]], "Purging 5 tasks")
+  expect_match(res$messages[[2]], "Dry run")
+  expect_match(res$messages[[9]], "Deleting 1 task bundle")
+  expect_match(res$messages[[10]], "Dry run")
+
+  files <- gsub("[^a-zA-Z0-9:_/\\]", "",
+             gsub(" recursively.", "",
+               res$message[c(3:7, 11)]))
+
+  expect_true(all(file.exists(files)))
+  suppressMessages(hipercow_purge(in_bundle = "*", root = path))
+  expect_false(any(file.exists(files)))
+})