Merge pull request #126 from mrc-ide/mrc-5436

Allow driver-specific environment variables

DESCRIPTION

@@ -1,9 +1,10 @@
 Package: hipercow
 Title: High Performance Computing
-Version: 1.0.21
+Version: 1.0.22
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "[email protected]"),
              person("Wes", "Hinsley", role = "aut"),
+             person("Paul", "Liétar", role = "aut"),
              person("Imperial College of Science, Technology and Medicine",
                     role = "cph"))
 Description: Set up cluster environments and jobs. Moo.

R/configure.R

@@ -164,11 +164,17 @@ hipercow_unconfigure <- function(driver, root = NULL) {
 ##'   names, used for validating [hipercow_resources] against that
 ##'   cluster.
 ##'
+##' @param default_envvars Driver-specific default environment
+##'   variables.  Drivers can use this to add environment variables
+##'   that have a higher precedence than the hipercow defaults, but
+##'   lower precedence than the `hipercow.default_envvars` option or
+##'   the `envvars` argument to a task.
+##'
 ##' @export
 hipercow_driver <- function(configure, submit, status, info, log, result,
                             cancel, provision_run, provision_list,
                             provision_compare, keypair, check_hello,
-                            cluster_info) {
+                            cluster_info, default_envvars = NULL) {
   structure(list(configure = configure,
                  submit = submit,
                  status = status,
@@ -181,7 +187,8 @@ hipercow_driver <- function(configure, submit, status, info, log, result,
                  provision_compare = provision_compare,
                  keypair = keypair,
                  check_hello = check_hello,
-                 cluster_info = cluster_info),
+                 cluster_info = cluster_info,
+                 default_envvars = default_envvars),
             class = "hipercow_driver")
 }
 

R/envvars.R

@@ -4,9 +4,11 @@
 ##'
 ##' @param ... <[`dynamic-dots`][rlang::dyn-dots]> Named environment
 ##'   variable.  If unnamed, it is assumed to refer to an environment
-##'   variable that exists.
+##'   variable that exists.  Use an `NA` value to unset an environment
+##'   variable.
 ##'
-##' @param secret Are these environment variables secret?  If so we will save
+##' @param secret Are these environment variables secret?  If so we
+##'   will encrypt them at saving and decrypt on use.
 ##'
 ##' @return A list with class `hipercow_envvars` which should not be modified.
 ##'
@@ -70,6 +72,7 @@ c.hipercow_envvars <- function(...) {
   }
   ret <- rlang::inject(rbind(!!!inputs))
   ret <- ret[!duplicated(ret$name, fromLast = TRUE), ]
+  ret <- ret[!is.na(ret$value), ]
   rownames(ret) <- NULL
 
   class(ret) <- c("hipercow_envvars", "data.frame")
@@ -117,8 +120,17 @@ prepare_envvars <- function(envvars, driver, root, call = NULL) {
     cli::cli_abort("Expected a 'hipercow_envvars' object for 'envvars'")
   }
 
-  defaults <- getOption("hipercow.default_envvars", DEFAULT_ENVVARS)
-  envvars <- c(defaults, envvars)
+  ## If a driver is not explicitly given (as in there is one
+  ## unambiguous choice) we don't look up the environment variables.
+  ## The driver loading here is all getting a bit tangled and we might
+  ## look more carefully at this once we get the linux version going.
+  if (is.null(driver)) {
+    dat <- NULL
+  } else {
+    dat <- hipercow_driver_prepare(driver, root, call)
+  }
+
+  envvars <- envvars_combine(dat$driver$default_envvars, envvars)
 
   ## Early exit prevents having to load keypair; this is always
   ## the same regardless of the chosen driver.
@@ -131,7 +143,7 @@ prepare_envvars <- function(envvars, driver, root, call = NULL) {
       "No driver {problem}, so cannot work with secret environment variables",
       arg = "envvars", call = call)
   }
-  dat <- hipercow_driver_prepare(driver, root, call)
+
   keypair <- dat$driver$keypair(dat$config, root$path$root)
   encrypt(envvars, keypair)
 }
@@ -156,3 +168,11 @@ envvars_export <- function(envvars, path) {
     file.create(path)
   }
 }
+
+
+envvars_combine <- function(driver_envvars, task_envvars) {
+  c(DEFAULT_ENVVARS,
+    driver_envvars,
+    getOption("hipercow.default_envvars"),
+    task_envvars)
+}

R/task-create.R

@@ -39,6 +39,12 @@
 ##'
 ##' @param envvars Environment variables as generated by
 ##'   [hipercow_envvars], which you might use to control your task.
+##'   These will be combined with the default environment variables
+##'   (see `vignettes("details")`, this can be overridden by the
+##'   option `hipercow.default_envvars`), and any driver-specific
+##'   environment variables (see `vignette("windows")`).  Variables
+##'   provided here have the highest precedence.  You can **unset** an
+##'   environment variable by setting it to `NA`.
 ##'
 ##' @param parallel Parallel configuration as generated by
 ##'   [hipercow_parallel], which defines which method, if any, will be used

drivers/windows/DESCRIPTION

@@ -1,9 +1,10 @@
 Package: hipercow.windows
 Title: DIDE HPC Support for Windows
-Version: 1.0.21
+Version: 1.0.22
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "[email protected]"),
              person("Wes", "Hinsley", role = "aut"),
+             person("Paul", "Lietar", role = "aut"),
              person("Imperial College of Science, Technology and Medicine",
                     role = "cph"))
 Description: Driver for using the DIDE windows cluster, via the hipercow

drivers/windows/R/driver.R

@@ -12,7 +12,8 @@ hipercow_driver_windows <- function() {
     provision_compare = windows_provision_compare,
     keypair = windows_keypair,
     check_hello = windows_check_hello,
-    cluster_info = windows_cluster_info)
+    cluster_info = windows_cluster_info,
+    default_envvars = DEFAULT_ENVVARS)
 }
 
 

drivers/windows/R/zzz.R

@@ -22,3 +22,8 @@ cache <- new.env(parent = emptyenv())
   packageStartupMessage(paste(strwrap(msg), collapse = "\n"))
   # nocov end
 }
+
+
+DEFAULT_ENVVARS <- hipercow::hipercow_envvars( # nolint
+  "CMDSTAN" = "I:/cmdstan",
+  "CMDSTANR_USE_R_TOOLS" = "TRUE")

tests/testthat/test-envvars.R

@@ -67,6 +67,19 @@ test_that("can concatenate environment variables", {
 })
 
 
+test_that("can unset environment variables by setting them as NA", {
+  e1 <- hipercow_envvars(A = "1", B = "2", C = "3", D = "4")
+  expect_equal(
+    c(e1, hipercow_envvars(A = "10", B = NA)),
+    hipercow_envvars(C = "3", D = "4", A = "10"))
+   expect_equal(
+    c(e1,
+      hipercow_envvars(A = "10", B = NA),
+      hipercow_envvars(B = "20")),
+    hipercow_envvars(C = "3", D = "4", A = "10", B = "20"))
+})
+
+
 test_that("can override environment variables when concatenating", {
   e1 <- hipercow_envvars(A = "1", B = "x")
   e2 <- hipercow_envvars(A = "2")
@@ -118,8 +131,10 @@ test_that("dont load driver if no secrets present", {
   init_quietly(path)
   root <- hipercow_root(path)
   e <- hipercow_envvars(MY_ENVVAR = "hello")
-  expect_equal(prepare_envvars(NULL, NULL, root), hipercow_envvars())
-  expect_equal(prepare_envvars(e, NULL, root), e)
+  expect_equal(prepare_envvars(NULL, NULL, root),
+               DEFAULT_ENVVARS)
+  expect_equal(prepare_envvars(e, NULL, root),
+               c(DEFAULT_ENVVARS, e))
 })
 
 
@@ -164,20 +179,28 @@ test_that("Default environment variables are applied", {
   init_quietly(path)
   root <- hipercow_root(path)
 
+  expect_equal(
+    prepare_envvars(NULL, NULL, root),
+    DEFAULT_ENVVARS)
+
+  expect_equal(
+    prepare_envvars(hipercow_envvars(B = "y"), NULL, root),
+    c(DEFAULT_ENVVARS, hipercow_envvars(B = "y")))
+
   withr::local_options(
     hipercow.default_envvars = hipercow_envvars(A = "x"))
 
   expect_equal(
     prepare_envvars(NULL, NULL, root),
-    hipercow_envvars(A = "x"))
+    c(DEFAULT_ENVVARS, hipercow_envvars(A = "x")))
 
   expect_equal(
     prepare_envvars(hipercow_envvars(B = "y"), NULL, root),
-    hipercow_envvars(A = "x", B = "y"))
+    c(DEFAULT_ENVVARS, hipercow_envvars(A = "x", B = "y")))
 
   expect_equal(
     prepare_envvars(hipercow_envvars(A = "y"), NULL, root),
-    hipercow_envvars(A = "y"))
+    c(DEFAULT_ENVVARS, hipercow_envvars(A = "y")))
 })
 
 
@@ -192,4 +215,33 @@ test_that("Has built-in default variables", {
   expect_equal(
     prepare_envvars(NULL, NULL, root),
     DEFAULT_ENVVARS)
+
+  expect_equal(envvars_combine(NULL, NULL), DEFAULT_ENVVARS)
+})
+
+
+test_that("overlay driver envvars with defaults", {
+  withr::local_options(
+    hipercow.default_envvars =
+      hipercow_envvars(ENV1 = "a", ENV2 = "b", ENV3 = "c"))
+  expect_equal(
+    envvars_combine(NULL, NULL),
+    c(DEFAULT_ENVVARS,
+      hipercow_envvars(ENV1 = "a", ENV2 = "b", ENV3 = "c")))
+  expect_equal(
+    envvars_combine(hipercow_envvars(ENV1 = "A", ENV4 = "d"), NULL),
+    c(DEFAULT_ENVVARS,
+      hipercow_envvars(ENV4 = "d", ENV1 = "a", ENV2 = "b", ENV3 = "c")))
+  expect_equal(
+    envvars_combine(hipercow_envvars(ENV1 = "A", ENV4 = "D", ENV5 = "E"),
+                    hipercow_envvars(ENV1 = "AA", ENV5 = "EE", ENV6 = "FF")),
+    c(DEFAULT_ENVVARS,
+      hipercow_envvars(ENV4 = "D", ENV2 = "b", ENV3 = "c",
+                       ENV1 = "AA", ENV5 = "EE", ENV6 = "FF")))
+  expect_equal(
+    envvars_combine(NULL,
+                    hipercow_envvars(ENV1 = "AA", ENV5 = "EE", ENV6 = "FF")),
+    c(DEFAULT_ENVVARS,
+      hipercow_envvars(ENV2 = "b", ENV3 = "c",
+                       ENV1 = "AA", ENV5 = "EE", ENV6 = "FF")))
 })