From 7682478d112a461c5fcdc6691c4fa8fda853cc46 Mon Sep 17 00:00:00 2001 From: wlandau Date: Thu, 5 Sep 2024 16:04:04 -0400 Subject: [PATCH] status and code --- NEWS.md | 2 + R/class_monad.R | 33 ++++++++++++++- R/crew_client.R | 1 - R/crew_controller.R | 45 +++++++++------------ R/crew_eval.R | 2 + man/crew_class_client.Rd | 4 -- man/crew_class_controller.Rd | 8 ++++ tests/testthat/test-crew_controller_local.R | 30 ++++++++++++++ 8 files changed, 93 insertions(+), 32 deletions(-) diff --git a/NEWS.md b/NEWS.md index 8dda195f..951f1849 100644 --- a/NEWS.md +++ b/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 diff --git a/R/class_monad.R b/R/class_monad.R index a2c23da2..a8405d06 100644 --- a/R/class_monad.R +++ b/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, diff --git a/R/crew_client.R b/R/crew_client.R index ca3398e5..f7c10b98 100644 --- a/R/crew_client.R +++ b/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")() diff --git a/R/crew_controller.R b/R/crew_controller.R index f834331f..504afb6e 100644 --- a/R/crew_controller.R +++ b/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) }, diff --git a/R/crew_eval.R b/R/crew_eval.R index ea0b2c91..7d1711b1 100644 --- a/R/crew_eval.R +++ b/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_, diff --git a/man/crew_class_client.Rd b/man/crew_class_client.Rd index e1d98078..c986cdc6 100644 --- a/man/crew_class_client.Rd +++ b/man/crew_class_client.Rd @@ -208,10 +208,6 @@ Get the true value of the \code{nanonext} condition variable. \if{html}{\out{
}}\preformatted{crew_class_client$resolved()}\if{html}{\out{
}} } -\subsection{Details}{ -Subtracts a safety offset which was padded on start. -} - \subsection{Returns}{ The value of the \code{nanonext} condition variable. } diff --git a/man/crew_class_controller.Rd b/man/crew_class_controller.Rd index 904910d5..3e6868e9 100644 --- a/man/crew_class_controller.Rd +++ b/man/crew_class_controller.Rd @@ -937,6 +937,14 @@ originally supplied to \code{push()}, just prior to the task can be restored using \code{set.seed(seed = seed, kind = algorithm)}, where \code{seed} and \code{algorithm} are part of this output. +\item \code{status}: a character string. \code{"success"} if the task did not +throw an error, \code{"cancel"} if the task was canceled with +the \code{cancel()} controller method, or \code{"error"} if the task +threw an error. +\item \code{code}: an integer code denoting the specific exit status: +\code{0} for successful tasks, \code{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/\code{nanonext} level. \item \code{error}: the first 2048 characters of the error message if the task threw an error, \code{NA} otherwise. \item \code{trace}: the first 2048 characters of the text of the traceback diff --git a/tests/testthat/test-crew_controller_local.R b/tests/testthat/test-crew_controller_local.R index ac10a38c..651a1f78 100644 --- a/tests/testthat/test-crew_controller_local.R +++ b/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(