From f98e8a869efd89f4037167654aa29504f901b20e Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Thu, 14 Dec 2023 16:49:24 +0000 Subject: [PATCH 1/2] Add support for collecting logs --- NAMESPACE | 2 + R/configure.R | 8 +++- R/task.R | 40 ++++++++++++++++++++ drivers/windows/R/constants.R | 1 + drivers/windows/R/driver.R | 10 +++++ drivers/windows/tests/testthat/test-driver.R | 18 +++++++++ man/hipercow_driver.Rd | 7 +++- tests/testthat/helper-hipercow.R | 7 ++++ tests/testthat/test-interface.R | 29 ++++++++++++++ 9 files changed, 120 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a80cde09..cf4bf96c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,8 @@ export(task_cancel) export(task_create_explicit) export(task_create_expr) export(task_eval) +export(task_log_show) +export(task_log_value) export(task_result) export(task_status) export(task_submit) diff --git a/R/configure.R b/R/configure.R index ff1451e0..4b7e2545 100644 --- a/R/configure.R +++ b/R/configure.R @@ -59,6 +59,11 @@ hipercow_configure <- function(driver, ..., root = NULL) { ##' @param status Fetch a task status. Takes a vector of ids and ##' returns a vector of the same length of statuses. ##' +##' @param log Fetch the task log. Takes a single task id and an +##' integer (the number of lines already known) and returns a +##' character vector of new logs. Return `NULL` (and not a zero +##' length character vector) if a log is not available. +##' ##' @param result Fetch a task result. If needed, copies the result ##' file into the current hipercow root. Assume that a result is ##' available (i.e., we've already checked that the task status is @@ -75,11 +80,12 @@ hipercow_configure <- function(driver, ..., root = NULL) { ##' function will trigger running conan to provision a library. ##' ##' @export -hipercow_driver <- function(configure, submit, status, result, cancel, +hipercow_driver <- function(configure, submit, status, log, result, cancel, provision) { structure(list(configure = configure, submit = submit, status = status, + log = log, result = result, cancel = cancel, provision = provision), diff --git a/R/task.R b/R/task.R index da6dbf6f..390255e1 100644 --- a/R/task.R +++ b/R/task.R @@ -344,6 +344,46 @@ task_result <- function(id, root = NULL) { } +##' Get the task log, if the task has produced one. Tasks run by the +##' `windows` driver will generally produce a log. A log might be +##' quite long, and you might want to print it to screen in its +##' entirity (`task_log_show`), return it as character vector +##' (`task_log_value`). +##' +##' @title Get task result +##' +##' @inheritParams task_status +##' +##' @return The value of the queued expression +##' +##' @rdname task_log +##' @export +task_log_show <- function(id, root = NULL) { + result <- task_log_fetch(id, root) + if (is.null(result)) { + cli::cli_alert_danger("No logs for task '{id}' (yet?)") + } else if (length(result) == 0) { + cli::cli_alert_danger("Empty logs for task '{id}' (so far?)") + } else { + cat(paste0(result, "\n", collapse = "")) + } +} + + +##' @rdname task_log +##' @export +task_log_value <- function(id, root = NULL) { + task_log_fetch(id, root) +} + + +task_log_fetch <- function(id, root) { + driver <- task_get_driver(id, root = root) + dat <- hipercow_driver_prepare(driver, root, environment()) + dat$driver$log(id, dat$config, root$path$root) +} + + ##' Cancel one or more tasks ##' ##' @title Cancel tasks diff --git a/drivers/windows/R/constants.R b/drivers/windows/R/constants.R index e82e8ac2..a6f54385 100644 --- a/drivers/windows/R/constants.R +++ b/drivers/windows/R/constants.R @@ -1,4 +1,5 @@ # nolint start BATCH_RUN <- "run.bat" DIDE_ID <- "dide_id" +TASK_LOG <- "log" # nolint end diff --git a/drivers/windows/R/driver.R b/drivers/windows/R/driver.R index 0b2a32ae..de49b9bb 100644 --- a/drivers/windows/R/driver.R +++ b/drivers/windows/R/driver.R @@ -3,6 +3,7 @@ hipercow_driver_windows <- function() { configure = windows_configure, submit = windows_submit, status = windows_status, + log = windows_log, result = windows_result, cancel = windows_cancel, provision = windows_provision) @@ -57,6 +58,15 @@ windows_result <- function(id, config, path_root) { } +## TODO: It would be nice to offer the ability to hit the DIDE bit of +## log; I expect that pbs will have something similar though and it +## might be worth waiting until we know what the looks like and then +## adding an additional function that calls the API? +windows_log <- function(id, config, path_root) { + readlines_if_exists(file.path(path_root, "hipercow", "tasks", id, TASK_LOG)) +} + + windows_cancel <- function(id, config, path_root) { path_dide_id <- file.path(path_root, "hipercow", "tasks", id, DIDE_ID) dide_id <- vcapply(path_dide_id, readLines, USE.NAMES = FALSE) diff --git a/drivers/windows/tests/testthat/test-driver.R b/drivers/windows/tests/testthat/test-driver.R index 88bf7497..cdf55a1f 100644 --- a/drivers/windows/tests/testthat/test-driver.R +++ b/drivers/windows/tests/testthat/test-driver.R @@ -135,3 +135,21 @@ test_that("can cancel a bunch of tasks, in reverse order", { expect_equal(mockery::mock_args(mock_client$cancel)[[1]], list(c("1236", "1235", "1234"))) }) + + +test_that("can read a task log", { + mount <- withr::local_tempfile() + root <- example_root(mount, "b/c") + path_root <- root$path$root + config <- root$config$windows + id <- withr::with_dir( + path_root, + hipercow::task_create_explicit(quote(sessionInfo()), submit = FALSE)) + + path_log <- file.path(path_root, "hipercow", "tasks", id, "log") + expect_null(windows_log(id, config, path_root)) + file.create(path_log) + expect_equal(windows_log(id, config, path_root), character()) + writeLines(c("a", "b", "c"), path_log) + expect_equal(windows_log(id, config, path_root), c("a", "b", "c")) +}) diff --git a/man/hipercow_driver.Rd b/man/hipercow_driver.Rd index 5357d557..c31b6933 100644 --- a/man/hipercow_driver.Rd +++ b/man/hipercow_driver.Rd @@ -6,7 +6,7 @@ packages, and rarely called directly. If you are trying to run tasks on a cluster you do not need to call this!} \usage{ -hipercow_driver(configure, submit, status, result, cancel, provision) +hipercow_driver(configure, submit, status, log, result, cancel, provision) } \arguments{ \item{configure}{Function used to set core configuration for the @@ -23,6 +23,11 @@ arguments the task id, the configuration, the path to the root.} \item{status}{Fetch a task status. Takes a vector of ids and returns a vector of the same length of statuses.} +\item{log}{Fetch the task log. Takes a single task id and an +integer (the number of lines already known) and returns a +character vector of new logs. Return \code{NULL} (and not a zero +length character vector) if a log is not available.} + \item{result}{Fetch a task result. If needed, copies the result file into the current hipercow root. Assume that a result is available (i.e., we've already checked that the task status is diff --git a/tests/testthat/helper-hipercow.R b/tests/testthat/helper-hipercow.R index f6247b05..2be1e008 100644 --- a/tests/testthat/helper-hipercow.R +++ b/tests/testthat/helper-hipercow.R @@ -16,6 +16,7 @@ elsewhere_driver <- function() { configure = elsewhere_configure, submit = elsewhere_submit, status = elsewhere_status, + log = elsewhere_log, result = elsewhere_result, cancel = elsewhere_cancel, provision = elsewhere_provision) @@ -52,6 +53,12 @@ elsewhere_status <- function(id, config, path_root) { } +elsewhere_log <- function(id, config, path_root) { + path <- file.path(config$path, "hipercow", "tasks", id, "elsewhere_log") + if (file.exists(path)) readLines(path) else NULL +} + + elsewhere_result <- function(id, config, path_root) { src <- file.path(config$path, "hipercow", "tasks", id, "result") dst <- file.path(path_root, "hipercow", "tasks", id, "result") diff --git a/tests/testthat/test-interface.R b/tests/testthat/test-interface.R index c8679221..26da1b46 100644 --- a/tests/testthat/test-interface.R +++ b/tests/testthat/test-interface.R @@ -290,3 +290,32 @@ test_that("prevent autosubmission when more than one driver configured", { "Submitted task") expect_equal(task_status(id, root = root), "submitted") }) + + +test_that("can read logs", { + elsewhere_register() + path_here <- withr::local_tempdir() + path_there <- withr::local_tempdir() + init_quietly(path_here) + init_quietly(path_there) + suppressMessages( + hipercow_configure("elsewhere", path = path_there, root = path_here)) + suppressMessages( + id <- withr::with_dir(path_here, task_create_explicit(quote(sqrt(2))))) + + expect_null(task_log_value(id, path_here)) + expect_message(task_log_show(id, path_here), + "No logs for task '.+'") + + path_log <- file.path(path_there, "hipercow", "tasks", id, "elsewhere_log") + + file.create(path_log) + expect_equal(task_log_value(id, path_here), character()) + expect_message(task_log_show(id, path_here), + "Empty logs for task '.+'") + + writeLines(c("a", "b"), path_log) + expect_equal(task_log_value(id, path_here), c("a", "b")) + expect_output(task_log_show(id, path_here), + "a\nb") +}) From 89df249e8529f55d33afdb1154183f9a93d46a9c Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Thu, 14 Dec 2023 17:10:47 +0000 Subject: [PATCH 2/2] Add missing docs --- man/task_log.Rd | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 man/task_log.Rd diff --git a/man/task_log.Rd b/man/task_log.Rd new file mode 100644 index 00000000..7e21ad5a --- /dev/null +++ b/man/task_log.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/task.R +\name{task_log_show} +\alias{task_log_show} +\alias{task_log_value} +\title{Get task result} +\usage{ +task_log_show(id, root = NULL) + +task_log_value(id, root = NULL) +} +\arguments{ +\item{id}{The task identifier} + +\item{root}{A hipercow root, or path to it. If \code{NULL} we search up +your directory tree.} +} +\value{ +The value of the queued expression +} +\description{ +Get the task log, if the task has produced one. Tasks run by the +\code{windows} driver will generally produce a log. A log might be +quite long, and you might want to print it to screen in its +entirity (\code{task_log_show}), return it as character vector +(\code{task_log_value}). +}