Merge pull request #13 from mrc-ide/task-result

R/configure.R

@@ -49,16 +49,22 @@ hermod_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 result Fetch a task result.  If needed, copies the result
+##'   file into the current hermod root.  Assume that a result is
+##'   available (i.e., we've already checked that the task status is
+##'   terminal)
+##'
 ##' @param provision Provision a library. Works with conan, and must
 ##'   accept `method`, `config`, `path_root` followed by `...` to pass
 ##'   through to `conan::conan_configure`. It is expected this
 ##'   function will trigger running conan to provision a library.
 ##'
 ##' @export
-hermod_driver <- function(configure, submit, status, provision) {
+hermod_driver <- function(configure, submit, status, result, provision) {
   structure(list(configure = configure,
                  submit = submit,
                  status = status,
+                 result = result,
                  provision = provision),
             class = "hermod_driver")
 }

R/task.R

@@ -253,7 +253,13 @@ hermod_task_result <- function(id, root = NULL) {
   path_result <- file.path(path, RESULT)
   if (!file.exists(path_result)) {
     status <- hermod_task_status(id, root)
-    cli::cli_abort("Result for task '{id}' not available, status is '{status}'")
+    task_driver <- vcapply(id, hermod_task_driver, root = root)
+    if (is.na(task_driver) || !(status %in% c("success", "failure"))) {
+      cli::cli_abort(
+        "Result for task '{id}' not available, status is '{status}'")
+    }
+    dat <- hermod_driver_prepare(task_driver, root, environment())
+    dat$driver$result(id, dat$config, root$path$root)
   }
   readRDS(path_result)
 }

drivers/windows/R/driver.R

@@ -3,6 +3,7 @@ hermod_driver_windows <- function() {
     configure = windows_configure,
     submit = windows_submit,
     status = windows_status,
+    result = windows_result,
     provision = windows_provision)
 }
 
@@ -47,3 +48,9 @@ windows_status <- function(id, config, path_root) {
   status[is.na(status)] <- "submitted"
   status
 }
+
+
+windows_result <- function(id, config, path_root) {
+  ## Nothing to do here, but we might want to do something in the
+  ## cases where the result is not found but the task has failed.
+}

drivers/windows/tests/testthat/test-driver.R

@@ -56,3 +56,19 @@ test_that("can get a task status", {
   file.create(file.path(path_root, "hermod", "tasks", id, "status-success"))
   expect_equal(windows_status(id, config, path_root), "success")
 })
+
+
+test_that("can get a task result", {
+  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,
+    hermod::hermod_task_create_explicit(quote(sqrt(2))))
+  hermod::hermod_task_eval(id, root = path_root)
+  expect_silent(windows_result(id, config, path_root))
+  expect_equal(
+    hermod::hermod_task_result(id, root = path_root),
+    sqrt(2))
+})

tests/testthat/helper-hermod.R

@@ -16,6 +16,7 @@ elsewhere_driver <- function() {
     configure = elsewhere_configure,
     submit = elsewhere_submit,
     status = elsewhere_status,
+    result = elsewhere_result,
     provision = elsewhere_provision)
 }
 
@@ -52,6 +53,13 @@ elsewhere_status <- function(id, config, path_root) {
 }
 
 
+elsewhere_result <- function(id, config, path_root) {
+  src <- file.path(config$path, "hermod", "tasks", id, "result")
+  dst <- file.path(path_root, "hermod", "tasks", id, "result")
+  file.copy(src, dst)
+}
+
+
 elsewhere_provision <- function(method, config, path_root, ...) {
   conan_config <- conan::conan_configure(
     method,

tests/testthat/test-interface.R

@@ -90,6 +90,28 @@ test_that("knowning driver stops refetching from disk", {
 })
 
 
+test_that("can retrieve a task result via a driver", {
+  elsewhere_register()
+  path_here <- withr::local_tempdir()
+  path_there <- withr::local_tempdir()
+  init_quietly(path_here)
+  init_quietly(path_there)
+  root <- hermod_root(path_here)
+  hermod_configure("elsewhere", path = path_there, root = path_here)
+  id <- withr::with_dir(path_here, hermod_task_create_explicit(quote(getwd())))
+  withr::with_dir(path_here, hermod_task_submit(id))
+  expect_error(
+    hermod_task_result(id, root = path_here),
+    "Result for task '[[:xdigit:]]{32}' not available, status is 'submitted'")
+  expect_true(withr::with_dir(path_there, hermod_task_eval(id)))
+  expect_equal(
+    hermod_task_result(id, root = path_here),
+    normalize_path(path_there))
+  expect_true(file.exists(
+    file.path(path_here, "hermod", "tasks", id, "result")))
+})
+
+
 test_that("can call provision", {
   elsewhere_register()
   mock_provision <- mockery::mock()