Merge pull request #314 from vimc/mrc-3167

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: orderly
 Title: Lightweight Reproducible Reporting
-Version: 1.4.6
+Version: 1.4.7
 Description: Order, create and store reports from R.  By defining a
     lightweight interface around the inputs and outputs of an
     analysis, a lot of the repetitive work for reproducible research

NAMESPACE

@@ -9,6 +9,7 @@ export(orderly_bundle_list)
 export(orderly_bundle_pack)
 export(orderly_bundle_pack_remote)
 export(orderly_bundle_run)
+export(orderly_cancel_remote)
 export(orderly_cleanup)
 export(orderly_commit)
 export(orderly_config)

NEWS.md

@@ -1,3 +1,7 @@
+# orderly 1.4.7
+
+* Add `orderly_cancel_remote` which can be used to cancel one or more reports running on a remote via its key (mrc-3167)
+
 # orderly 1.4.3
 
 * Orderly now only records git information where a `.git` directory is found at the orderly root (vimc-4866)

R/remote.R

@@ -472,7 +472,8 @@ implements_remote <- function(x) {
     is.function(x$list_versions) &&
     is.function(x$pull) &&
     is.function(x$run) &&
-    is.function(x$url_report)
+    is.function(x$url_report) &&
+    is.function(x$kill)
 }
 
 
@@ -662,3 +663,29 @@ pull_info <- function(name, id, root, locate, remote, parameters) {
        config = config,
        remote = remote)
 }
+
+
+##' Cancel a report
+##'
+##' The action will depend on the status of the report:
+##'   * queued - report run will be deleted
+##'   * running - report run will be cancelled
+##'   * complete/errored - no effect
+##'
+##' @param keys The key or keys for the reports to cancel
+##'
+##' @inheritParams orderly_pull_dependencies
+##'
+##' @return List with names as report keys and values are lists containing
+##'   * `killed` - boolean TRUE if report successfully cancelled, FALSE
+##'   otherwise
+##'   * `message` - string detailing reason why cancellation failed
+##'
+##' @export
+orderly_cancel_remote <- function(keys, root = NULL, locate = TRUE,
+                                  remote = NULL) {
+  remote <- get_remote(remote, orderly_config(root, locate))
+  out <- lapply(keys, remote$kill)
+  names(out) <- keys
+  out
+}

R/remote_path.R

@@ -96,5 +96,9 @@ orderly_remote_path_ <- R6::R6Class(
 
     bundle_import = function(path) {
       orderly_bundle_import(path, root = self$config, locate = FALSE)
+    },
+
+    kill = function(...) {
+      stop("'orderly_remote_path' remotes do not kill")
     }
   ))

tests/testthat/test-remote-path.R

@@ -318,3 +318,11 @@ test_that("bundle pack and import", {
 
   expect_equal(remote$list_versions("example"), ans$id)
 })
+
+
+test_that("orderly_cancel_remote", {
+  dat <- prepare_orderly_remote_example()
+  expect_error(
+    orderly_cancel_remote("example", root = dat$config),
+    "'orderly_remote_path' remotes do not kill")
+})

tests/testthat/test-remote.R

@@ -269,7 +269,8 @@ test_that("orderly run remote passes instance to run", {
       list_reports = function() TRUE,
       list_versions = function() TRUE,
       pull = function() TRUE,
-      url_report = function() TRUE
+      url_report = function() TRUE,
+      kill = function() TRUE
     )
   )
 
@@ -334,7 +335,8 @@ test_that("orderly run remote passes ref to run", {
       list_reports = function() TRUE,
       list_versions = function() TRUE,
       pull = function() TRUE,
-      url_report = function() TRUE
+      url_report = function() TRUE,
+      kill = function() TRUE
     )
   )
 
@@ -379,6 +381,7 @@ test_that("can get status of remote queue", {
       pull = function() TRUE,
       run = function() TRUE,
       url_report = function() TRUE,
+      kill = function() TRUE,
       queue_status = function() mock_status()
     )
   )
@@ -490,3 +493,40 @@ test_that("Can't pull incompatible metadata", {
                           remote = dat$remote),
     "Report was created with orderly more recent than this, upgrade!")
 })
+
+
+test_that("reports can be cancelled", {
+  path_local <- test_prepare_orderly_example("demo")
+
+  res_1 <- list(
+    killed = TRUE,
+    message = NULL
+  )
+  res_2 <- list(
+    killed = FALSE,
+    message = "Could not kill task, already complete"
+  )
+  mock_kill <- mockery::mock(res_1, res_2)
+  ## Create a minimal remote class which will satisfy implements_remote
+  mock_remote <- R6::R6Class(
+    "orderly_mock_remote",
+    lock_objects = FALSE,
+    public = list(
+      list_reports = function() TRUE,
+      list_versions = function() TRUE,
+      pull = function() TRUE,
+      run = function() TRUE,
+      url_report = function() TRUE,
+      queue_status = function() TRUE,
+      kill = function(key) mock_kill()
+    )
+  )
+
+  remote <- mock_remote$new()
+  res <- orderly_cancel_remote(
+    c("fungiform_kiwi", "lithe_iaerismetalmark"), remote = remote)
+  mockery::expect_called(mock_kill, 2)
+  expect_equal(names(res), c("fungiform_kiwi", "lithe_iaerismetalmark"))
+  expect_equal(res$fungiform_kiwi, res_1)
+  expect_equal(res$lithe_iaerismetalmark, res_2)
+})