From 0e75a90ddad42c937c482145481975d3c9cccf21 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 5 Jul 2024 18:13:49 +0100 Subject: [PATCH 01/11] Add dry_run to task_purge --- DESCRIPTION | 2 +- R/task-purge.R | 10 ++++++++-- R/util.R | 10 ++++++++++ drivers/windows/DESCRIPTION | 2 +- tests/testthat/test-purge.R | 22 +++++++++++++++++++++- 5 files changed, 41 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index bc5334ce..29203ac2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: hipercow Title: High Performance Computing -Version: 1.0.27 +Version: 1.0.28 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), person("Wes", "Hinsley", role = "aut"), diff --git a/R/task-purge.R b/R/task-purge.R index 571da742..40c22492 100644 --- a/R/task-purge.R +++ b/R/task-purge.R @@ -67,6 +67,9 @@ ##' use are `created`, `success`, `failure` and `cancelled` (note ##' 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 ##' @@ -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") } diff --git a/R/util.R b/R/util.R index fdad350f..fbd34219 100644 --- a/R/util.R +++ b/R/util.R @@ -471,3 +471,13 @@ 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) + return() + } + recurse <- if (recursive) " recursively." + cli::cli_alert_info("Dry_run - would have deleted {x}{recurse}") +} \ No newline at end of file diff --git a/drivers/windows/DESCRIPTION b/drivers/windows/DESCRIPTION index 0307dee7..a796ce2b 100644 --- a/drivers/windows/DESCRIPTION +++ b/drivers/windows/DESCRIPTION @@ -1,6 +1,6 @@ Package: hipercow.windows Title: DIDE HPC Support for Windows -Version: 1.0.27 +Version: 1.0.28 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), person("Wes", "Hinsley", role = "aut"), diff --git a/tests/testthat/test-purge.R b/tests/testthat/test-purge.R index cff99c29..5287cb2c 100644 --- a/tests/testthat/test-purge.R +++ b/tests/testthat/test-purge.R @@ -280,10 +280,30 @@ 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, 4) + expect_match(res$messages[[1]], "Purging 5 tasks") + expect_match(res$messages[[2]], "Dry_run") + expect_match(res$messages[[3]], "Deleting 1 task bundle") + expect_match(res$messages[[4]], "Dry_run") + + file1 <- + expect_true(file.exists(substring(res$message[[4]], 32))) + + +}) From b942208b7ed466aa57e6f2e729c947afe51a9417 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 5 Jul 2024 18:14:07 +0100 Subject: [PATCH 02/11] Document --- man/hipercow_purge.Rd | 4 ++++ tests/testthat/test-purge.R | 4 ++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/man/hipercow_purge.Rd b/man/hipercow_purge.Rd index 28ac133d..bb4e6749 100644 --- a/man/hipercow_purge.Rd +++ b/man/hipercow_purge.Rd @@ -9,6 +9,7 @@ hipercow_purge( finished_before = NULL, in_bundle = NULL, with_status = NULL, + dry_run = FALSE, root = NULL ) } @@ -35,6 +36,9 @@ use are \code{created}, \code{success}, \code{failure} and \code{cancelled} (not you cannot select tasks with status of \code{submitted} or \code{running}; use \link{task_cancel} for these first).} +\item{dry_run}{If TRUE, report what would have been done, but +no changes will be made.} + \item{root}{A hipercow root, or path to it. If \code{NULL} we search up your directory tree.} } diff --git a/tests/testthat/test-purge.R b/tests/testthat/test-purge.R index 5287cb2c..ced29dfa 100644 --- a/tests/testthat/test-purge.R +++ b/tests/testthat/test-purge.R @@ -302,8 +302,8 @@ test_that("can do a dry run purge", { expect_match(res$messages[[3]], "Deleting 1 task bundle") expect_match(res$messages[[4]], "Dry_run") - file1 <- - expect_true(file.exists(substring(res$message[[4]], 32))) + file <- gsub("\n", "", substring(res$message[[4]], 32)) + expect_true(file.exists(file)) }) From 0aace88f1bccd632ee5a9356d2efc7688ccfd1fd Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 5 Jul 2024 18:26:17 +0100 Subject: [PATCH 03/11] Prettier output --- R/util.R | 8 ++++++-- tests/testthat/test-purge.R | 18 ++++++++++-------- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/R/util.R b/R/util.R index fbd34219..6dae8ffd 100644 --- a/R/util.R +++ b/R/util.R @@ -479,5 +479,9 @@ maybe_unlink <- function(x, recursive = FALSE, dry_run = FALSE) { return() } recurse <- if (recursive) " recursively." - cli::cli_alert_info("Dry_run - would have deleted {x}{recurse}") -} \ No newline at end of file + cli::cli_alert_info("Dry_run - would have deleted:") + cli::cli_ul() + for (file in x) { + cli::cli_li("{file}{recurse}") + } +} diff --git a/tests/testthat/test-purge.R b/tests/testthat/test-purge.R index ced29dfa..4bfaf371 100644 --- a/tests/testthat/test-purge.R +++ b/tests/testthat/test-purge.R @@ -296,14 +296,16 @@ test_that("can do a dry run purge", { res <- evaluate_promise(hipercow_purge(in_bundle = "*", root = path, dry_run = TRUE)) expect_equal(res$result, b$ids) - expect_length(res$messages, 4) + expect_length(res$messages, 10) expect_match(res$messages[[1]], "Purging 5 tasks") expect_match(res$messages[[2]], "Dry_run") - expect_match(res$messages[[3]], "Deleting 1 task bundle") - expect_match(res$messages[[4]], "Dry_run") - - file <- gsub("\n", "", substring(res$message[[4]], 32)) - expect_true(file.exists(file)) - - + expect_match(res$messages[[8]], "Deleting 1 task bundle") + expect_match(res$messages[[9]], "Dry_run") + + for (f in c(3:7, 10)) { + file <- substring(res$message[[f]], 3) + file <- gsub(" recursively.", "", file) + file <- gsub("\n", "", file) + expect_true(file.exists(file)) + } }) From a773ec9fc7619f8793dd7752fda2a8797f7154ad Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 5 Jul 2024 18:41:14 +0100 Subject: [PATCH 04/11] Fix substring to clip
  • --- tests/testthat/test-purge.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-purge.R b/tests/testthat/test-purge.R index 4bfaf371..d22aa2f3 100644 --- a/tests/testthat/test-purge.R +++ b/tests/testthat/test-purge.R @@ -301,9 +301,9 @@ test_that("can do a dry run purge", { expect_match(res$messages[[2]], "Dry_run") expect_match(res$messages[[8]], "Deleting 1 task bundle") expect_match(res$messages[[9]], "Dry_run") - + for (f in c(3:7, 10)) { - file <- substring(res$message[[f]], 3) + file <- substring(res$message[[f]], 7) file <- gsub(" recursively.", "", file) file <- gsub("\n", "", file) expect_true(file.exists(file)) From 3a1ea0c85efae2ec8d6290977d86a2ccf95f1919 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 5 Jul 2024 18:58:17 +0100 Subject: [PATCH 05/11] Use regex --- tests/testthat/test-purge.R | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test-purge.R b/tests/testthat/test-purge.R index d22aa2f3..1bf02eb5 100644 --- a/tests/testthat/test-purge.R +++ b/tests/testthat/test-purge.R @@ -301,11 +301,12 @@ test_that("can do a dry run purge", { expect_match(res$messages[[2]], "Dry_run") expect_match(res$messages[[8]], "Deleting 1 task bundle") expect_match(res$messages[[9]], "Dry_run") - - for (f in c(3:7, 10)) { - file <- substring(res$message[[f]], 7) - file <- gsub(" recursively.", "", file) - file <- gsub("\n", "", file) - expect_true(file.exists(file)) - } + + files <- gsub("[^a-zA-Z0-9:_/\\]", "", + gsub(" recursively.", "", + res$message[c(3:7, 10)])) + + expect_true(all(file.exists(files))) + suppressMessages(hipercow_purge(in_bundle = "*", root = path)) + expect_false(any(file.exists(files))) }) From 7cd2bb57a365000df975d2bf7ff0e8cab7bcaedf Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 5 Jul 2024 19:02:58 +0100 Subject: [PATCH 06/11] Codefactor --- R/task-purge.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/task-purge.R b/R/task-purge.R index 40c22492..c54c82df 100644 --- a/R/task-purge.R +++ b/R/task-purge.R @@ -67,7 +67,7 @@ ##' use are `created`, `success`, `failure` and `cancelled` (note ##' 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. ##' @@ -126,7 +126,7 @@ hipercow_purge <- function(task_ids = NULL, } cli::cli_alert_info("Purging {length(ids)} task{?s}") - maybe_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) @@ -134,7 +134,7 @@ hipercow_purge <- function(task_ids = NULL, 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}") - maybe_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") From 558579db5cbe36d3dcd7f02cb75b5266145a65e6 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 5 Jul 2024 19:04:26 +0100 Subject: [PATCH 07/11] Whitespace --- tests/testthat/test-purge.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-purge.R b/tests/testthat/test-purge.R index 1bf02eb5..7e668b31 100644 --- a/tests/testthat/test-purge.R +++ b/tests/testthat/test-purge.R @@ -303,9 +303,9 @@ test_that("can do a dry run purge", { expect_match(res$messages[[9]], "Dry_run") files <- gsub("[^a-zA-Z0-9:_/\\]", "", - gsub(" recursively.", "", + gsub(" recursively.", "", res$message[c(3:7, 10)])) - + expect_true(all(file.exists(files))) suppressMessages(hipercow_purge(in_bundle = "*", root = path)) expect_false(any(file.exists(files))) From d599e82b53c3e5833caeba59a1abb96d0eeb651e Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 5 Jul 2024 19:32:03 +0100 Subject: [PATCH 08/11] Clean up cli ul --- R/util.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/util.R b/R/util.R index 6dae8ffd..7cad7b14 100644 --- a/R/util.R +++ b/R/util.R @@ -480,8 +480,9 @@ maybe_unlink <- function(x, recursive = FALSE, dry_run = FALSE) { } recurse <- if (recursive) " recursively." cli::cli_alert_info("Dry_run - would have deleted:") - cli::cli_ul() + ul <- cli::cli_ul() for (file in x) { cli::cli_li("{file}{recurse}") } + cli::cli_end(ul) } From c1ff74650ed1a81d8d0e3b2e2b1fe50b39c04607 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Mon, 8 Jul 2024 13:32:43 +0100 Subject: [PATCH 09/11] Use cli_bullets and a couple of cli_rules --- R/util.R | 15 +++++++-------- tests/testthat/test-purge.R | 10 +++++----- 2 files changed, 12 insertions(+), 13 deletions(-) diff --git a/R/util.R b/R/util.R index 7cad7b14..156a4b5b 100644 --- a/R/util.R +++ b/R/util.R @@ -476,13 +476,12 @@ empty_time <- function() { maybe_unlink <- function(x, recursive = FALSE, dry_run = FALSE) { if (!dry_run) { unlink(x, recursive) - return() - } - recurse <- if (recursive) " recursively." - cli::cli_alert_info("Dry_run - would have deleted:") - ul <- cli::cli_ul() - for (file in x) { - cli::cli_li("{file}{recurse}") + } else { + recurse <- if (recursive) " recursively." + files <- paste0(x, recurse) + names(files) <- rep("*", length(files)) + cli::cli_rule(right = "Dry run - files were not deleted {cli::symbol$arrow_down}") + cli::cli_bullets(files) + cli::cli_rule(right = "Dry run - files were not deleted {cli::symbol$arrow_up}") } - cli::cli_end(ul) } diff --git a/tests/testthat/test-purge.R b/tests/testthat/test-purge.R index 7e668b31..ede33ffd 100644 --- a/tests/testthat/test-purge.R +++ b/tests/testthat/test-purge.R @@ -296,15 +296,15 @@ test_that("can do a dry run purge", { res <- evaluate_promise(hipercow_purge(in_bundle = "*", root = path, dry_run = TRUE)) expect_equal(res$result, b$ids) - expect_length(res$messages, 10) + expect_length(res$messages, 12) expect_match(res$messages[[1]], "Purging 5 tasks") - expect_match(res$messages[[2]], "Dry_run") - expect_match(res$messages[[8]], "Deleting 1 task bundle") - expect_match(res$messages[[9]], "Dry_run") + 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, 10)])) + res$message[c(3:7, 11)])) expect_true(all(file.exists(files))) suppressMessages(hipercow_purge(in_bundle = "*", root = path)) From b0f98421b23f7ce1cc05320cb6cee0da8a426945 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Mon, 8 Jul 2024 13:35:20 +0100 Subject: [PATCH 10/11] Shorten line length --- R/util.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/util.R b/R/util.R index 156a4b5b..37abb6c8 100644 --- a/R/util.R +++ b/R/util.R @@ -480,8 +480,10 @@ maybe_unlink <- function(x, recursive = FALSE, dry_run = FALSE) { recurse <- if (recursive) " recursively." files <- paste0(x, recurse) names(files) <- rep("*", length(files)) - cli::cli_rule(right = "Dry run - files were not deleted {cli::symbol$arrow_down}") + down <- cli::symbol$arrow_down + up <- cli::symbol$arrow_up + cli::cli_rule(right = "Dry run - files were not deleted {down}") cli::cli_bullets(files) - cli::cli_rule(right = "Dry run - files were not deleted {cli::symbol$arrow_up}") + cli::cli_rule(right = "Dry run - files were not deleted {up}") } } From 5ec0208836f97569b5cde4c26595e241e171a70f Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Mon, 8 Jul 2024 16:54:06 +0100 Subject: [PATCH 11/11] Use set_names --- R/util.R | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/R/util.R b/R/util.R index 37abb6c8..51616071 100644 --- a/R/util.R +++ b/R/util.R @@ -477,13 +477,8 @@ maybe_unlink <- function(x, recursive = FALSE, dry_run = FALSE) { if (!dry_run) { unlink(x, recursive) } else { - recurse <- if (recursive) " recursively." - files <- paste0(x, recurse) - names(files) <- rep("*", length(files)) - down <- cli::symbol$arrow_down - up <- cli::symbol$arrow_up - cli::cli_rule(right = "Dry run - files were not deleted {down}") - cli::cli_bullets(files) - cli::cli_rule(right = "Dry run - files were not deleted {up}") + 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}") } }