status and code

NEWS.md

@@ -9,6 +9,8 @@
 * Add a `resources()` method to client to track memory usage.
 * Client `log()` method to log memory consumption to a CSV file.
 * To passively log memory usage when `log_resources` is given, the controller now calls `log()` as a side effect in most controller methods, with throttling to preserve speed.
+* Return a status and status code from `pop()` etc.
+* New internal function `as_monad()` makes error reporting more consistent.
 
 # crew 0.9.5
 

R/class_monad.R

@@ -5,6 +5,8 @@ monad_init <- function(
   seconds = NA_real_,
   seed = NA_integer_,
   algorithm = NA_character_,
+  status = NA_character_,
+  code = NA_integer_,
   error = NA_character_,
   trace = NA_character_,
   warnings = NA_character_,
@@ -19,6 +21,8 @@ monad_init <- function(
     seconds = seconds,
     seed = seed,
     algorithm = algorithm,
+    status = status,
+    code = code,
     error = error,
     trace = trace,
     warnings = warnings,
@@ -36,6 +40,8 @@ monad_new <- function(
   seconds = NULL,
   seed = NULL,
   algorithm = NULL,
+  status = NULL,
+  code = NULL,
   error = NULL,
   trace = NULL,
   warnings = NULL,
@@ -50,6 +56,8 @@ monad_new <- function(
     seconds = seconds,
     seed = seed,
     algorithm = algorithm,
+    status = status,
+    code = code,
     error = error,
     trace = trace,
     warnings = warnings,
@@ -66,6 +74,7 @@ monad_validate <- function(monad) {
     "name",
     "command",
     "algorithm",
+    "status",
     "error",
     "trace",
     "warnings",
@@ -78,11 +87,33 @@ monad_validate <- function(monad) {
   for (col in c("seconds", "seed")) {
     crew_assert(monad[[col]], is.numeric(.), length(.) == 1L)
   }
-  crew_assert(monad$worker, is.integer(.), length(.) == 1L)
+  for (col in c("code", "worker")) {
+    crew_assert(monad[[col]], is.integer(.), length(.) == 1L)
+  }
   crew_assert(monad$result, is.list(.), length(.) == 1L)
   invisible()
 }
 
+as_monad <- function(task, name) {
+  out <- .subset2(task, "data")
+  if (!is.list(out)) {
+    out <- monad_init(
+      name = name,
+      status = if_any(
+        identical(as.integer(out), 20L),
+        "canceled",
+        "error"
+      ),
+      code = as.integer(out),
+      error = paste(
+        utils::capture.output(print(out), type = "output"),
+        collapse = "\n"
+      )
+    )
+  }
+  monad_tibble(out)
+}
+
 monad_tibble <- function(monad) {
   attributes(monad) <- list(
     names = monad_names,

R/crew_client.R

@@ -417,7 +417,6 @@ crew_class_client <- R6::R6Class(
       mirai::nextget(x = "cv", .compute = .subset2(self, "name"))
     },
     #' @description Get the true value of the `nanonext` condition variable.
-    #' @details Subtracts a safety offset which was padded on start.
     #' @return The value of the `nanonext` condition variable.
     resolved = function() {
       condition <- .subset2(self, "condition")()

R/crew_controller.R

@@ -918,8 +918,13 @@ crew_class_controller <- R6::R6Class(
       if (verbose) {
         cli::cli_progress_done(.envir = progress_envir)
       }
-      results <- map(tasks, ~.subset2(.x, "data"))
-      out <- lapply(results, monad_tibble)
+      out <- list()
+      for (index in seq_along(tasks)) {
+        out[[length(out) + 1L]] <- as_monad(
+          task = tasks[[index]],
+          name = names[[index]]
+        )
+      }
       out <- tibble::new_tibble(data.table::rbindlist(out, use.names = FALSE))
       out <- out[match(x = names, table = out$name),, drop = FALSE] # nolint
       out <- out[!is.na(out$name),, drop = FALSE] # nolint
@@ -1011,6 +1016,14 @@ crew_class_controller <- R6::R6Class(
     #'      just prior to the task can be restored using
     #'      `set.seed(seed = seed, kind = algorithm)`, where `seed` and
     #'      `algorithm` are part of this output.
+    #'   * `status`: a character string. `"success"` if the task did not
+    #'     throw an error, `"cancel"` if the task was canceled with
+    #'     the `cancel()` controller method, or `"error"` if the task
+    #'     threw an error.
+    #'   * `code`: an integer code denoting the specific exit status:
+    #'     `0` for successful tasks, `1` for tasks with an error in the R
+    #'     command of the task, and another positive integer with an NNG
+    #'     status code if there is an error at the NNG/`nanonext` level.
     #'   * `error`: the first 2048 characters of the error message if
     #'     the task threw an error, `NA` otherwise.
     #'   * `trace`: the first 2048 characters of the text of the traceback
@@ -1089,34 +1102,15 @@ crew_class_controller <- R6::R6Class(
       if (is.null(task)) {
         return(NULL)
       }
-      out <- task$data
-      # The contents of the if() statement below happen
-      # if mirai cannot evaluate the command.
-      # I cannot cover this in automated tests, but
-      # I did test it by hand.
-      # nocov start
-      if (!is.list(out)) {
-        out <- monad_init(
-          name = name,
-          error = paste(
-            utils::capture.output(print(out), type = "output"),
-            collapse = "\n"
-          )
-        )
-      }
-      # nocov end
-      out <- monad_tibble(out)
+      out <- as_monad(task, name = name)
       summary <- .subset2(private, ".summary")
-      # Same as above.
       on.exit({
         private$.tasks[[index_delete]] <- NULL
         private$.popped <- .subset2(self, "popped") + 1L
       })
-      # nocov start
       if (anyNA(.subset2(out, "launcher"))) {
         return(out)
       }
-      # nocov end
       on.exit({
         index <- .subset2(out, "worker")
         private$.summary$tasks[index] <- .subset2(summary, "tasks")[index] +
@@ -1166,11 +1160,10 @@ crew_class_controller <- R6::R6Class(
       controllers = NULL
     ) {
       pop <- .subset2(self, "pop")
-      results <- list()
-      while (!is.null(result <- pop(scale = FALSE, error = error))) {
-        results[[length(results) + 1L]] <- result
+      out <- list()
+      while (!is.null(task <- pop(scale = FALSE, error = error))) {
+        out[[length(out) + 1L]] <- task
       }
-      out <- lapply(results, monad_tibble)
       out <- tibble::new_tibble(data.table::rbindlist(out, use.names = FALSE))
       if_any(nrow(out), out, NULL)
     },

R/crew_eval.R

@@ -104,6 +104,8 @@ crew_eval <- function(
     seconds = seconds,
     seed = seed %|||% NA_integer_,
     algorithm = algorithm %|||% NA_character_,
+    status = if_any(is.null(state$error), "success", "error"),
+    code = as.integer(!is.null(state$error)),
     error = state$error %|||% NA_character_,
     trace = state$trace %|||% NA_character_,
     warnings = state$warnings %|||% NA_character_,

tests/testthat/test-crew_controller_local.R

@@ -232,6 +232,36 @@ crew_test("crew_controller_local() launch method", {
   expect_false(handle$is_alive())
 })
 
+crew_test("exit status and code", {
+  skip_on_cran()
+  skip_on_os("windows")
+  x <- crew_controller_local()
+  on.exit({
+    x$terminate()
+    rm(x)
+    gc()
+    crew_test_sleep()
+  })
+  x$start()
+  x$push(Sys.sleep(0.01), name = "short")
+  x$wait(mode = "one")
+  task <- x$pop()
+  expect_equal(task$status, "success")
+  expect_equal(task$code, 0L)
+  x$push(stop("message"), name = "broken")
+  x$wait(mode = "one")
+  task <- x$pop()
+  expect_equal(task$status, "error")
+  expect_equal(task$code, 1L)
+  x$push(Sys.sleep(10000), name = "long")
+  x$cancel(names = "long")
+  x$wait()
+  task <- x$pop()
+  expect_equal(task$status, "canceled")
+  expect_equal(task$code, 20L)
+  expect_equal(x$client$resolved(), 3L)
+})
+
 crew_test("deprecate seconds_exit", {
   expect_warning(
     x <- crew_controller_local(