Use the new environment interface for tasks

R/environment.R

@@ -50,7 +50,7 @@ hermod_environment_create <- function(name = "default", sources = NULL,
   } else if (exists && !overwrite) {
     cli::cli_abort(
       "Environment '{name}' already exists and 'overwrite' is FALSE")
-  } else{
+  } else {
     fs::dir_create(dirname(path))
     saveRDS(ret, path)
     action <- if (exists) "Updated" else "Created"

R/task.R

@@ -13,21 +13,20 @@
 ##' @param export Optional character vector of names of objects to
 ##'   export into the evaluating environment
 ##'
-##' @param envir Environment in which to find variables for `export`
+##' @param envir Local R environment in which to find variables for
+##'   `export`
 ##'
-##' @param packages Optional character vector of packages to attach
-##'   before the expression is run. Likely needed for things like
-##'   ggplot and dplyr which make use of exported functions.
+##' @param environment Name of the hermod environment to evaluate the
+##'   task within.
 ##'
 ##' @inheritParams hermod_task_eval
 ##'
 ##' @return A task id, a string of hex characters. Use this to
 ##'   interact with the task.
 ##'
 ##' @export
-hermod_task_create_explicit <- function(expr, export = NULL,
-                                        envir = .GlobalEnv, packages = NULL,
-                                        root = NULL) {
+hermod_task_create_explicit <- function(expr, export = NULL, envir = .GlobalEnv,
+                                        environment = "default", root = NULL) {
   root <- hermod_root(root)
   id <- ids::random_id()
   dest <- file.path(root$path$tasks, id)
@@ -37,13 +36,14 @@ hermod_task_create_explicit <- function(expr, export = NULL,
   } else {
     locals <- set_names(lapply(export, get, envir = envir), export)
   }
+  ensure_environment_exists(environment, root, environment())
   path <- relative_workdir(root$path$root)
   data <- list(type = "explicit",
                id = id,
                expr = expr,
                locals = locals,
                path = path,
-               packages = packages)
+               environment = environment)
   saveRDS(data, file.path(dest, EXPR))
   file.create(file.path(dest, STATUS_CREATED))
   id
@@ -78,19 +78,21 @@ hermod_task_eval <- function(id, envir = .GlobalEnv, root = NULL) {
 
   top <- rlang::current_env() # not quite right, but better than nothing
   local <- new.env(parent = emptyenv())
-  withr::local_dir(file.path(root$path$root, data$path))
-  result <- rlang::try_fetch(
+
+  result <- rlang::try_fetch({
+    environment_apply(data$environment, envir, root, top)
+    withr::local_dir(file.path(root$path$root, data$path))
     switch(
       data$type,
       explicit = task_eval_explicit(data, envir, root),
-      cli::cli_abort("Tried to evaluate unknown type of task {data$type}")),
-    error = function(e) {
-      if (is.null(e$trace)) {
-        e$trace <- rlang::trace_back(top)
-      }
-      local$error <- e
-      NULL
-    })
+      cli::cli_abort("Tried to evaluate unknown type of task '{data$type}'"))
+  }, error = function(e) {
+    if (is.null(e$trace)) {
+      e$trace <- rlang::trace_back(top)
+    }
+    local$error <- e
+    NULL
+  })
 
   success <- is.null(local$error)
   if (success) {
@@ -260,9 +262,6 @@ hermod_task_result <- function(id, root = NULL) {
 
 
 task_eval_explicit <- function(data, envir, root) {
-  for (p in data$packages) {
-    library(p, character.only = TRUE)
-  }
   if (!is.null(data$locals)) {
     list2env(data$locals, envir)
   }

tests/testthat/test-task.R

@@ -57,28 +57,6 @@ test_that("return missing status for nonexisting tasks", {
 })
 
 
-test_that("can load packages in a task", {
-  mock_library <- mockery::mock()
-  mockery::stub(task_eval_explicit, "library", mock_library)
-
-  path <- withr::local_tempdir()
-  init_quietly(path)
-  id <- withr::with_dir(
-    path,
-    hermod_task_create_explicit(sqrt(2), packages = c("foo", "bar")))
-  envir <- new.env()
-  root <- hermod_root(path)
-  data <- readRDS(file.path(root$path$tasks, id, EXPR))
-  result <- task_eval_explicit(data, envir, root)
-  expect_equal(result, sqrt(2))
-  mockery::expect_called(mock_library, 2)
-  expect_equal(
-    mockery::mock_args(mock_library),
-    list(list("foo", character.only = TRUE),
-         list("bar", character.only = TRUE)))
-})
-
-
 test_that("can run failing tasks", {
   path <- withr::local_tempdir()
   init_quietly(path)
@@ -147,3 +125,22 @@ test_that("hermod task status is vectorised", {
   expect_equal(hermod_task_status(c(id1, id1), root = path),
                c("created", "created"))
 })
+
+
+test_that("protect against unknown task types", {
+  path <- withr::local_tempdir()
+  init_quietly(path)
+  id <- withr::with_dir(path, hermod_task_create_explicit(sqrt(2)))
+  p <- file.path(path, "hermod", "tasks", id, "expr")
+  d <- readRDS(p)
+  d$type <- "magic"
+  saveRDS(d, p)
+  expect_false(
+    hermod_task_eval(id, root = path),
+    "Tried to evaluate unknown type of task 'magic'")
+  result <- hermod_task_result(id, root = path)
+  expect_s3_class(result, "error")
+  expect_s3_class(result$trace, "rlang_trace")
+  expect_equal(result$message,
+               "Tried to evaluate unknown type of task 'magic'")
+})