Fix #1131

NAMESPACE

@@ -28,6 +28,8 @@ export(cache_path)
 export(cached)
 export(cached_planned)
 export(cached_unplanned)
+export(cancel)
+export(cancel_if)
 export(check)
 export(check_plan)
 export(clean)

NEWS.md

@@ -4,7 +4,7 @@
 
 - Add a new `format` argument to `make()`, an optional custom storage format for targets without an explicit `target(format = ...)` in the plan (#1124).
 - Add a new `lock_cache` argument to `make()` to optionally suppress cache locking (#1129). (It can be annoying to interrupt `make()` repeatedly and unlock the cache manually every time.)
-- Add a new function `cancel_if()` function to cancel targets mid-build if a condition is met (#1131).
+- Add new functions `cancel()` and `cancel_if()` function to cancel targets mid-build (#1131).
 
 ## Enhancements
 

R/cache.R

@@ -1419,7 +1419,7 @@ progress <- function(
   }
   progress <- match.arg(
     progress,
-    choices = c("done", "running", "failed"),
+    choices = c("done", "running", "cancelled", "failed"),
     several.ok = TRUE
   )
   out[out$progress %in% progress,, drop = FALSE] # nolint

R/decorate_storr.R

@@ -625,7 +625,7 @@ standardize_key <- function(text) {
 }
 
 ht_keys <- function(digest_fn) {
-  keys <- c("running", "done", "failed", "lock")
+  keys <- c("running", "done", "cancelled", "failed", "lock")
   out <- lapply(keys, precomputed_key_hash, digest_fn = digest_fn)
   names(out) <- keys
   out
@@ -647,6 +647,7 @@ deduce_progress <- Vectorize(function(substr) {
     substr,
     r = "running",
     d = "done",
+    c = "cancelled",
     f = "failed",
     "none"
   )

R/drake_build.R

@@ -71,6 +71,7 @@ drake_build_impl <- function(
   announce_build(target = target, config = config)
   build <- try_build(target = target, meta = meta, config = config)
   conclude_build(build = build, config = config)
+  invisible(build$value)
 }
 
 body(drake_build) <- config_util_body(drake_build_impl)

R/drake_graph_info.R

@@ -273,6 +273,7 @@ get_raw_node_category_data <- function(config) {
   config$outdated <- resolve_graph_outdated(config = config)
   prog <- config$cache$get_progress(config$targets)
   config$running <- config$targets[prog == "running"]
+  config$cancelled <- config$targets[prog == "cancelled"]
   config$failed <- config$targets[prog == "failed"]
   config$files <- all_labels[is_encoded_path(all_labels)]
   config$functions <- parallel_filter(
@@ -294,7 +295,7 @@ get_raw_node_category_data <- function(config) {
 
 trim_node_categories <- function(config) {
   elts <- c(
-    "failed", "files", "functions", "running", "missing",
+    "cancelled", "failed", "files", "functions", "running", "missing",
     "outdated", "targets"
   )
   for (elt in elts) {
@@ -426,6 +427,7 @@ legend_nodes <- function(font_size = 20) {
       "Up to date",
       "Outdated",
       "Running",
+      "Cancelled",
       "Failed",
       "Imported",
       "Missing",
@@ -439,13 +441,14 @@ legend_nodes <- function(font_size = 20) {
       "up_to_date",
       "outdated",
       "running",
+      "cancelled",
       "failed",
       "import",
       "missing",
       rep("generic", 5)
     )),
     shape = node_shape(c(
-      rep("object", 7),
+      rep("object", 8),
       "dynamic",
       "funct",
       "file",
@@ -531,6 +534,7 @@ categorize_nodes <- function(config) {
     nodes[missing, "status"] <- "missing"
     nodes[outdated, "status"] <- "outdated"
     nodes[running, "status"] <- "running"
+    nodes[cancelled, "status"] <- "cancelled"
     nodes[failed, "status"] <- "failed"
     nodes$type <- "object"
     nodes[dynamic, "type"] <- "dynamic"
@@ -564,6 +568,7 @@ style_nodes <- function(config) {
     nodes$font.size <- font_size # nolint
     nodes[nodes$status == "imported", "color"] <- node_color("import")
     nodes[nodes$status == "running", "color"] <- node_color("running")
+    nodes[nodes$status == "cancelled", "color"] <- node_color("cancelled")
     nodes[nodes$status == "failed", "color"] <- node_color("failed")
     nodes[nodes$status == "missing", "color"] <- node_color("missing")
     nodes[nodes$status == "outdated", "color"] <- node_color("outdated")
@@ -584,6 +589,7 @@ node_color <- Vectorize(function(x) {
     fail = "red",
     up_to_date = "forestgreen",
     outdated = "#000000",
+    cancelled = "#ecb753",
     failed = "#aa0000",
     import = "dodgerblue3",
     missing = "darkorchid3",

R/drake_plan_helpers.R

@@ -511,41 +511,83 @@ no_deps <- function(x = NULL) {
   x
 }
 
-#' @title Cancel a target mid-build \lifecycle{experimental}
+#' @title Cancel a target mid-build under some condition
+#'   \lifecycle{experimental}
 #' @description Cancel a target mid-build if some logical condition is met.
 #'   Upon cancellation, `drake` halts the current target and moves to the
-#'   next one. The target's previous value and metadata are still
-#'   in the cache.
+#'   next one. The target's previous value and metadata, if they exist,
+#'   remain in the cache.
 #' @export
+#' @seealso cancel
 #' @return Nothing.
+#' @inheritParams cancel
 #' @param condition Logical, whether to cancel the target.
 #' @examples
 #' \dontrun{
 #' isolate_example("cancel_if()", {
 #' f <- function(x) {
-#'   cancel_if()
-#'   Sys.sleep(2) # does not run
+#'   cancel_if(x > 1)
+#'   Sys.sleep(2) # Does not run if x > 1.
 #' }
 #' g <- function(x) f(x)
-#' plan <- drake_plan(y = g(1))
+#' plan <- drake_plan(y = g(2))
 #' make(plan)
-#' # does not exist
+#' # Does not exist.
 #' # readd(y)
 #' })
 #' }
-cancel_if <- function(condition = TRUE) {
+cancel_if <- function(condition, allow_missing = TRUE) {
+  envir_call()
+  if (length(condition) != 1L) {
+    stop("condition must be length 1 in cancel_if()")
+  }
   if (!condition) {
     return(invisible())
   }
-  calls <- vcapply(sys.calls(), safe_deparse)
-  matching_calls <- grepl("^drake_with_call_stack_8a6af5\\(", calls)
-  if (!any(matching_calls)) {
-    stop("not running make()", call. = FALSE)
+  cancel(allow_missing = allow_missing)
+}
+
+#' @title Cancel a target mid-build \lifecycle{experimental}
+#' @description Cancel a target mid-build.
+#'   Upon cancellation, `drake` halts the current target and moves to the
+#'   next one. The target's previous value and metadata, if they exist,
+#'   remain in the cache.
+#' @export
+#' @seealso cancel_if
+#' @return Nothing.
+#' @param condition Logical, whether to cancel the target.
+#' @param allow_missing Logical. If `FALSE`, `drake` will not cancel
+#'   the target if it is missing from the cache (or if you removed the
+#'   key with `clean()`).
+#' @examples
+#' \dontrun{
+#' isolate_example("cancel()", {
+#' f <- function(x) {
+#'   cancel()
+#'   Sys.sleep(2) # Does not run.
+#' }
+#' g <- function(x) f(x)
+#' plan <- drake_plan(y = g(1))
+#' make(plan)
+#' # Does not exist.
+#' # readd(y)
+#' })
+#' }
+cancel <- function(allow_missing = TRUE) {
+  envir <- envir_call()
+  if (!allow_missing) {
+    if (target_missing(envir$target, envir$config)) {
+      return(invisible())
+    }
   }
-  matching_calls <- grepl("^try_build\\(", calls)
-  pos <- max(which(matching_calls))
-  envir <- sys.frame(pos)
-  evalq(return(structure(NA, class = "drake_cancel")), envir = envir)
+  stop(cancellation(allow_missing = allow_missing))
+}
+
+cancellation <- function(...) {
+  structure(
+    list(message = "cancel", call = NULL),
+    class = c("drake_cancel", "error", "condition")
+  )
 }
 
 #' @title Name of the current target \lifecycle{maturing}
@@ -577,7 +619,7 @@ cancel_if <- function(condition = TRUE) {
 #' })
 #' }
 id_chr <- function() {
-  config <- envir_call()$target
+  envir_call()$target
 }
 
 #' @title Get the environment where drake builds targets
@@ -633,8 +675,8 @@ envir_call <- function() {
 envir_call_error <- function() {
   stop(
     "Could not find the environment where drake builds targets. ",
-    "Functions drake_envir(), id_chr(), and cancel_if() ",
-    "must only be invoked though make().",
+    "Functions drake_envir(), id_chr(), cancel(), and cancel_if() ",
+    "can only be invoked through make().",
     call. = FALSE
   )
 }

R/local_build.R

@@ -202,7 +202,6 @@ with_handling <- function(target, meta, config) {
   if (inherits(value, "error")) {
     value$message <- prepend_fork_advice(value$message)
     meta$error <- value
-    value <- NULL
   }
   list(
     target = target,
@@ -254,7 +253,8 @@ drake_with_call_stack_8a6af5 <- function(target, config) {
       eval(expr = tidy_expr, envir = config$envir_subtargets),
       error = capture_calls
     ),
-    error = identity
+    error = identity,
+    drake_cancel = cancellation
   )
 }
 
@@ -316,12 +316,24 @@ conclude_build <- function(build, config) {
   target <- build$target
   value <- build$value
   meta <- build$meta
+  conclude_build_impl(value, target, meta, config)
+}
+
+conclude_build_impl <- function(value, target, meta, config) {
+  UseMethod("conclude_build_impl")
+}
+
+conclude_build_impl.drake_cancel <- function(value, target, meta, config) {
+  config$cache$set_progress(target = target, value = "cancelled")
+  config$logger$major("cancel", target, target = target, color = "cancel")
+}
+
+conclude_build_impl.default <- function(value, target, meta, config) {
   assert_output_files(target = target, meta = meta, config = config)
   handle_build_exceptions(target = target, meta = meta, config = config)
   value <- assign_format(target = target, value = value, config = config)
   store_outputs(target = target, value = value, meta = meta, config = config)
   assign_to_envir(target = target, value = value, config = config)
-  invisible(value)
 }
 
 assign_format <- function(target, value, config) {

R/logger.R

@@ -98,7 +98,8 @@ text_color <- Vectorize(function(x) {
     target = "green3",
     recover = "#ffd700",
     retry = "#9400d3",
-    missing = "#9400d3",
+    missing = "red",
+    cancel = "#ffa500",
     fail = "red",
     "#888888"
   )

_pkgdown.yml

@@ -56,6 +56,8 @@ reference:
   - '`file_in`'
   - '`file_out`'
   - '`knitr_in`'
+  - '`cancel`'
+  - '`cancel_if`'
   - '`ignore`'
   - '`no_deps`'
   - '`id_chr`'