Prompt users during make() in interactive mode

NAMESPACE

@@ -205,6 +205,7 @@ importFrom(storr,storr_environment)
 importFrom(storr,storr_rds)
 importFrom(utils,compareVersion)
 importFrom(utils,head)
+importFrom(utils,menu)
 importFrom(utils,packageVersion)
 importFrom(utils,read.csv)
 importFrom(utils,sessionInfo)

NEWS.md

@@ -29,6 +29,7 @@
 - Introduce a new experimental domain-specific language for generating large plans (#233). Details [here](file:///home/landau/projects/drake-manual/_book/plans.html#large-plans).
 - Implement a `lock_envir` argument to safeguard reproducibility. See [this thread](https://github.com/ropensci/drake/issues/615#issuecomment-447585359) for a demonstration of the problem solved by `make(lock_envir = TRUE)`. More discussion: #619, #620.
 - The new `from_plan()` function allows the users to reference custom plan columns from within commands. Changes to values in these columns columns do not invalidate targets.
+- Add a menu prompt (https://github.com/ropensci/drake/pull/762) to safeguard against `make()` pitfalls in interactive mode (https://github.com/ropensci/drake/issues/761). Disable with `make(force = TRUE)` or `options(drake_force_interactive = TRUE)`.
 
 ## Enhancements
 

R/api-make.R

@@ -9,8 +9,7 @@
 #'   [drake_plan()],
 #'   [drake_config()],
 #'   [vis_drake_graph()],
-#'   [outdated()],
-#'   [triggers()]
+#'   [outdated()]
 #' @export
 #' @return nothing
 #' @inheritParams drake_config
@@ -69,7 +68,7 @@ make <- function(
   cpu = Inf,
   elapsed = Inf,
   retries = 0,
-  force = FALSE,
+  force = NULL,
   graph = NULL,
   trigger = drake::trigger(),
   skip_imports = FALSE,
@@ -151,6 +150,16 @@ make <- function(
   if (!config$skip_imports) {
     process_imports(config)
   }
+  if (is.character(config$parallelism)) {
+    config$schedule <- pretrim_schedule(config)
+  }
+  abort <- FALSE
+  if (check_intv_make(config)) {
+    abort <- abort_intv_make(config) # nocov
+  }
+  if (abort) {
+    return(invisible()) # nocov
+  }
   if (!config$skip_targets) {
     process_targets(config)
   }

R/api-package.R

@@ -49,6 +49,6 @@
 #' @importFrom methods new setRefClass
 #' @importFrom rlang enquo eval_tidy expr quo_squash quos
 #' @importFrom storr storr_environment storr_rds
-#' @importFrom utils compareVersion head packageVersion
+#' @importFrom utils compareVersion head menu packageVersion
 #'   read.csv sessionInfo stack type.convert unzip write.table
 NULL

R/exec-backend.R

@@ -11,7 +11,6 @@ run_native_backend <- function(config) {
     config$parallelism,
     c("loop", "clustermq", "future")
   )
-  config$schedule <- pretrim_schedule(config)
   if (igraph::gorder(config$schedule)) {
     get(
       paste0("backend_", parallelism),

R/exec-session.R

@@ -83,3 +83,26 @@ conclude_session <- function(config) {
   console_final_notes(config)
   invisible()
 }
+
+check_intv_make <- function(config) {
+  force_intv <- config$force %||%
+    getOption("drake_force_interactive") %||%
+    FALSE
+  interactive() &&
+    igraph::gorder(config$schedule) &&
+    !identical(force_intv, TRUE)
+}
+
+abort_intv_make <- function(config) {
+  # nocov start
+  title <- paste(
+    paste(igraph::gorder(config$schedule), "outdated targets:"),
+    multiline_message(igraph::V(config$schedule)$name),
+    "\nReally run make() in interactive mode?",
+    "Considerations: https://github.com/ropensci/drake/issues/761",
+    sep = "\n"
+  )
+  out <- utils::menu(choices = c("yes", "no"), title = title)
+  identical(as.integer(out), 2L)
+  # nocov end
+}

R/preprocess-config.R

@@ -142,14 +142,23 @@
 #'   Assign target-level retries with an optional `retries`
 #'   column in `plan`.
 #'
-#' @param force Logical. If `FALSE` (default) then `drake` will stop you
-#'   if the cache was created with an old
-#'   and incompatible version of drake.
-#'   This gives you an opportunity to
+#' @param force Logical. If `FALSE` (default) then `drake` 
+#'   imposes the following safeguards
+#'   to keep `make()` from mangling your project.
+#'   1. If you are running an interactive session
+#'   (i.e. if `interactive()` is `TRUE`)
+#'   and some targets are outdated,
+#'   then `make()` pauses with a menu to check if you really want to
+#'   proceed. Ref: <https://github.com/ropensci/drake/issues/761>.
+#'   You can also disable this menu with
+#'   `options(drake_force_interactive = TRUE)`.
+#'   Save `options(drake_force_interactive = TRUE)` in your
+#'   `~/.Rprofile` file to never see the menu.
+#'   2. If the cache was created with an old
+#'   and incompatible version of drake, `make()` stops to
+#'   give you an opportunity to
 #'   downgrade `drake` to a compatible version
 #'   rather than rerun all your targets from scratch.
-#'   If `force` is `TRUE`, then `make()` executes your workflow
-#'   regardless of the version of `drake` that last ran `make()` on the cache.
 #'
 #' @param graph An `igraph` object from the previous `make()`.
 #'   Supplying a pre-built graph could save time.
@@ -432,7 +441,7 @@ drake_config <- function(
   cpu = Inf,
   elapsed = Inf,
   retries = 0,
-  force = FALSE,
+  force = NULL,
   log_progress = FALSE,
   graph = NULL,
   trigger = drake::trigger(),
@@ -553,7 +562,7 @@ drake_config <- function(
       console_log_file = console_log_file
     )
   }
-  if (force) {
+  if (force %||% FALSE) {
     drake_set_session_info(cache = cache, full = session_info)
   }
   seed <- choose_seed(supplied = seed, cache = cache)
@@ -632,7 +641,8 @@ drake_config <- function(
     template = template,
     sleep = sleep,
     hasty_build = hasty_build,
-    lock_envir = lock_envir
+    lock_envir = lock_envir,
+    force = force
   )
   out <- enforce_compatible_config(out)
   config_checks(out)

R/vis-color.R

@@ -14,6 +14,7 @@ colors <- c(
   launch = "#ff9933",
   load = "#ff9933",
   unload = "#ff7221",
+  interactive = "#ff7221",
   trigger = "maroon",
   skip = "skyblue1",
   store = "skyblue1",

R/vis-console.R

@@ -123,7 +123,25 @@ console_up_to_date <- function(config) {
   }
 }
 
+console_interactive <- function(config) {
+  if (!interactive()) {
+    return()
+  }
+  # nocov start
+  msg <- paste0(
+    "make() in interactive mode requires extra care:\n",
+    "https://github.com/ropensci/drake/issues/761"
+  )
+  out <- color(msg, colors["interactive"])
+  drake_message(out, config = config)
+  # nocov end
+}
+
 console_final_notes <- function(config) {
+  if (config$verbose < 1L) {
+    return()
+  }
+  console_interactive(config)
   if (config$verbose < 2L) {
     return()
   }

tests/testthat/test-always-skipped.R

@@ -81,4 +81,41 @@ test_with_dir("forks + lock_envir = informative error msg", {
   )
 })
 
+test_with_dir("make() in interactive mode", {
+  # Must run this test in an interactive session.
+  # Cannot be fully automated like the other tests.
+  load_mtcars_example()
+  config <- drake_config(my_plan)
+  make(my_plan) # Select 2.
+  expect_equal(cached(), character(0))
+  expect_equal(sort(outdated(config)), sort(my_plan$target))
+  expect_equal(sort(justbuilt(config)), character(0))
+  make(my_plan, console_log_file = "log.txt") # Select 1.
+  expect_equal(cached(), sort(my_plan$target))
+  expect_equal(sort(outdated(config)), character(0))
+  expect_equal(sort(justbuilt(config)), sort(my_plan$target))
+  lines <- readLines("log.txt")
+  expect_true(any(grepl("interactive", lines)))
+  expect_false(any(grepl("up to date", lines)))
+  make(my_plan, console_log_file = "log.txt") # No menu.
+  expect_equal(cached(), sort(my_plan$target))
+  expect_equal(sort(outdated(config)), character(0))
+  expect_equal(sort(justbuilt(config)), character(0))
+  lines <- readLines("log.txt")
+  expect_true(any(grepl("interactive", lines)))
+  expect_true(any(grepl("up to date", lines)))
+  clean()
+  make(my_plan, force = TRUE) # No menu.
+  expect_equal(sort(outdated(config)), character(0))
+  expect_equal(sort(justbuilt(config)), sort(my_plan$target))
+  clean()
+  options(drake_force_interactive = TRUE)
+  make(my_plan, force = FALSE) # Select 2.
+  expect_equal(sort(outdated(config)), sort(my_plan$target))
+  expect_equal(sort(justbuilt(config)), character(0))
+  make(my_plan) # No menu.
+  expect_equal(sort(outdated(config)), character(0))
+  expect_equal(sort(justbuilt(config)), sort(my_plan$target))
+})
+
 }