Merge pull request #136 from mrc-ide/mrc-5234

Allow orderly_shared_resource to be used with unnamed arguments.

R/metadata.R

@@ -298,7 +298,7 @@ static_orderly_dependency <- function(args) {
   has_name <- !is.null(static_name) || is.null(name)
 
   name <- static_string(name)
-  files <- static_character_vector(files, TRUE)
+  files <- fill_missing_names(static_character_vector(files, TRUE))
 
   if (is.character(args$query)) {
     query <- static_string(query)
@@ -325,9 +325,16 @@ static_orderly_dependency <- function(args) {
 ##'
 ##' @title Copy shared resources into a packet directory
 ##'
-##' @param ... Named arguments corresponding to shared resources to
-##'   copy. The name will be the destination filename, while the value
-##'   is the filename within the shared resource directory.
+##' @param ... The shared resources to copy. If arguments are named, the name
+##'   will be the destination file while the value is the filename within the
+##'   shared resource directory.
+##'
+##' You can use a limited form of string interpolation in the names of
+##'   this argument; using `${variable}` will pick up values from
+##'   `envir` and substitute them into your string.  This is similar
+##'   to the interpolation you might be familiar with from
+##'   `glue::glue` or similar, but much simpler with no concatenation
+##'   or other fancy features supported.
 ##'
 ##' @return Invisibly, a data.frame with columns `here` (the fileames
 ##'   as as copied into the running packet) and `there` (the filenames
@@ -336,7 +343,16 @@ static_orderly_dependency <- function(args) {
 ##'
 ##' @export
 orderly_shared_resource <- function(...) {
-  files <- validate_shared_resource(list(...), environment())
+  files <- validate_file_from_to(
+    list(...), parent.frame(),
+    name = "arguments to 'orderly_shared_resource'",
+    call = environment())
+
+  if (nrow(files) == 0) {
+    cli::cli_abort("'orderly_shared_resource' requires at least one argument",
+                   call = environment())
+  }
+
   ctx <- orderly_context(rlang::caller_env())
 
   files <- copy_shared_resource(ctx$root_src, ctx$path, ctx$config, files,
@@ -351,25 +367,6 @@ orderly_shared_resource <- function(...) {
   invisible(files)
 }
 
-
-validate_shared_resource <- function(args, call) {
-  if (length(args) == 0) {
-    cli::cli_abort("'orderly_shared_resource' requires at least one argument",
-                   call = call)
-  }
-  assert_named(args, unique = TRUE, call = environment())
-  is_invalid <- !vlapply(args, function(x) is.character(x) && length(x) == 1)
-  if (any(is_invalid)) {
-    cli::cli_abort(
-      sprintf(
-        "Invalid shared resource %s: entries must be strings",
-        paste(squote(names(args)[is_invalid]), collapse = ", ")),
-      call = call)
-  }
-  list_to_character(args)
-}
-
-
 copy_shared_resource <- function(path_root, path_dest, config, files, call) {
   shared_dir <- "shared"
   shared_path <- file.path(path_root, shared_dir)
@@ -379,8 +376,8 @@ copy_shared_resource <- function(path_root, path_dest, config, files, call) {
       shared_dir))
   }
 
-  here <- names(files)
-  there <- unname(files)
+  here <- files$here
+  there <- files$there
 
   assert_file_exists_relative(there, workdir = shared_path,
                               name = "Shared resource file", call = call)
@@ -405,7 +402,7 @@ copy_shared_resource <- function(path_root, path_dest, config, files, call) {
 
 
 static_orderly_shared_resource <- function(args) {
-  unlist(lapply(args, static_character_vector, TRUE), FALSE, TRUE)
+  fill_missing_names(unlist(lapply(args, static_string), FALSE, TRUE))
 }
 
 

R/outpack_misc.R

@@ -85,20 +85,16 @@ validate_file_from_to <- function(x, envir,
     x <- list_to_character(x)
   }
 
-  if (is.character(x)) {
-    to <- names(x) %||% x
-    from <- unname(x)
-    if (any(i <- !nzchar(to))) {
-      to[i] <- from[i]
-    }
-  } else {
+  if (!is.character(x)) {
     cli::cli_abort(
       c(sprintf("Unexpected object type for '%s'", name),
         x = sprintf("Given object of class %s", collapseq(class(x))),
         i = "Expected a (named) character vector"),
       call = call)
   }
 
+  to <- names(fill_missing_names(x))
+  from <- unname(x)
   to_value <- string_interpolate_simple(to, envir, call)
 
   if (any(duplicated(to_value))) {

R/util.R

@@ -644,3 +644,13 @@ is_testing <- function() {
   # https://github.com/r-lib/testthat/blob/fe50a22/R/test-env.R#L20
   identical(Sys.getenv("TESTTHAT"), "true")
 }
+
+#' Given a character vector, missing names are filled using the value.
+fill_missing_names <- function(x) {
+  if (is.null(names(x))) {
+    names(x) <- x
+  } else if (any(i <- !nzchar(names(x)))) {
+    names(x)[i] <- x[i]
+  }
+  x
+}

R/util_assert.R

@@ -44,18 +44,25 @@ assert_simple_scalar_atomic <- function(x, name = deparse(substitute(x)),
   invisible(x)
 }
 
+assert_unique_names <- function(x, name = deparse(substitute(x)),
+                                arg = name, call = NULL) {
+  if (any(duplicated(names(x)))) {
+      dups <- unique(names(x)[duplicated(names(x))])
+      cli::cli_abort(
+        c("'{name}' must have unique names",
+          i = "Found {length(dups)} duplicate{?s}: {collapseq(dups)}"),
+        call = call, arg = arg)
+  }
+}
+
 assert_named <- function(x, unique = FALSE, name = deparse(substitute(x)),
                          arg = name, call = NULL) {
   ## TODO: we get bad quotes here from static_orderly_parameters
   if (is.null(names(x))) {
     cli::cli_abort("'{name}' must be named", call = call, arg = arg)
   }
-  if (unique && any(duplicated(names(x)))) {
-    dups <- unique(names(x)[duplicated(names(x))])
-    cli::cli_abort(
-      c("'{name}' must have unique names",
-        i = "Found {length(dups)} duplicate{?s}: {collapseq(dups)}"),
-      call = call, arg = arg)
+  if (unique) {
+    assert_unique_names(x, name = name, arg = arg, call = call)
   }
 }
 

tests/testthat/examples/shared-shorthand/shared-shorthand.R

@@ -0,0 +1,7 @@
+orderly2::orderly_shared_resource("data.csv")
+orderly2::orderly_artefact("A graph of things", "mygraph.png")
+
+data <- read.csv("data.csv", stringsAsFactors = FALSE)
+png("mygraph.png")
+plot(data)
+dev.off()

tests/testthat/helper-orderly.R

@@ -36,9 +36,9 @@ copy_examples <- function(examples, path_src) {
   }
 
   fs::dir_create(path_src)
-  if (any(c("shared", "shared-dir") %in% examples)) {
+  if (any(c("shared", "shared-shorthand", "shared-dir") %in% examples)) {
     fs::dir_create(file.path(path_src, "shared"))
-    if ("shared" %in% examples) {
+    if (any(c("shared", "shared-shorthand") %in% examples)) {
       fs::file_copy(test_path("examples/explicit/data.csv"),
                     file.path(path_src, "shared"))
     }

tests/testthat/test-cleanup.R

@@ -153,6 +153,29 @@ test_that("can clean up shared resources", {
   expect_equal(status$delete, "shared_data.csv")
 })
 
+test_that("can clean up shared resources with shorthand syntax", {
+  path <- test_prepare_orderly_example("shared-shorthand")
+  path_src <- file.path(path, "src", "shared-shorthand")
+  file.create(file.path(path_src, "data.csv"))
+  status <- orderly_cleanup_status("shared-shorthand", root = path)
+
+  files <- c("data.csv", "shared-shorthand.R")
+  expect_setequal(rownames(status$role), files)
+  expect_equal(
+    status$role,
+    cbind(orderly = set_names(c(FALSE, TRUE), files),
+          resource = FALSE,
+          shared_resource = c(TRUE, FALSE),
+          dependency = FALSE,
+          artefact = FALSE))
+  expect_equal(
+    status$status,
+    cbind(source = set_names(c(FALSE, TRUE), files),
+          derived = c(TRUE, FALSE),
+          ignored = NA))
+  expect_equal(status$delete, "data.csv")
+})
+
 
 test_that("can clean up dependencies", {
   path <- test_prepare_orderly_example(c("data", "depends"))

tests/testthat/test-read.R

@@ -68,6 +68,12 @@ test_that("read dependency", {
   args <- list(name = NULL, query = "latest", files = c(x = "y"))
   expect_equal(static_orderly_dependency(args), args)
 
+  args <- list(name = NULL, query = "latest", files = c("x"))
+  expect_equal(static_orderly_dependency(args)$files, c(x = "x"))
+
+  args <- list(name = NULL, query = "latest", files = c("x", y = "z"))
+  expect_equal(static_orderly_dependency(args)$files, c(x = "x", y = "z"))
+
   expect_null(
     static_orderly_dependency(list(name = quote(a),
                                    query = "latest",
@@ -123,3 +129,13 @@ test_that("can parse expressions that might be interesting", {
     list(is_orderly = FALSE,
          expr = quote(f(a, b, c))))
 })
+
+test_that("read shared resource", {
+  expect_equal(static_orderly_shared_resource(list("a", "b")),
+               c(a = "a", b = "b"))
+
+  expect_equal(static_orderly_shared_resource(list(a = "x", "b")),
+               c(a = "x", b = "b"))
+
+  expect_null(static_orderly_shared_resource(list(quote(c("a", "b")))))
+})

tests/testthat/test-run.R

@@ -261,19 +261,56 @@ test_that("can run manually with shared resources", {
 })
 
 
+test_that("can run with shared resources using shorthand arguments", {
+  path <- test_prepare_orderly_example("shared-shorthand")
+  envir <- new.env()
+  id <- orderly_run_quietly("shared-shorthand", root = path, envir = envir)
+  expect_setequal(
+    dir(file.path(path, "archive", "shared-shorthand", id)),
+    c("data.csv", "mygraph.png", "shared-shorthand.R"))
+  meta <- orderly_metadata(id, root = path)
+  expect_equal(nrow(meta$custom$orderly$shared), 1)
+  expect_equal(meta$custom$orderly$shared,
+               data_frame(here = "data.csv", there = "data.csv"))
+  expect_equal(
+    meta$custom$orderly$role,
+    data_frame(path = c("shared-shorthand.R", "data.csv"),
+               role = c("orderly", "shared")))
+})
+
 test_that("can validate shared resource arguments", {
   expect_error(
-    validate_shared_resource(list(), NULL),
+    orderly_shared_resource(),
     "'orderly_shared_resource' requires at least one argument")
+
   expect_error(
-    validate_shared_resource(list(input = c("a", "b")), NULL),
-    "Invalid shared resource 'input': entries must be strings")
+    orderly_shared_resource(c("a", "b")),
+    "All elements of 'arguments to 'orderly_shared_resource'' must be strings")
   expect_error(
-    validate_shared_resource(list(a = 1, b = TRUE, c = "str"), NULL),
-    "Invalid shared resource 'a', 'b': entries must be strings")
-  expect_equal(
-    validate_shared_resource(list(a = "A", b = "B"), NULL),
-    c(a = "A", b = "B"))
+    orderly_shared_resource(a = 1, b = TRUE, c = "str"),
+    "All elements of 'arguments to 'orderly_shared_resource'' must be strings")
+  expect_error(
+    orderly_shared_resource(1, TRUE, "str"),
+    "All elements of 'arguments to 'orderly_shared_resource'' must be strings")
+  expect_error(
+    orderly_shared_resource(a = 1, TRUE, "str"),
+    "All elements of 'arguments to 'orderly_shared_resource'' must be strings")
+
+  expect_error(
+    orderly_shared_resource(a = "A", a = "B"),
+    paste("Every destination filename (in 'arguments to",
+          "'orderly_shared_resource'') must be unique"),
+    fixed = TRUE)
+  expect_error(
+    orderly_shared_resource("a", "a"),
+    paste("Every destination filename (in 'arguments to",
+          "'orderly_shared_resource'') must be unique"),
+    fixed = TRUE)
+  expect_error(
+    orderly_shared_resource("a", a = "B"),
+    paste("Every destination filename (in 'arguments to",
+          "'orderly_shared_resource'') must be unique"),
+    fixed = TRUE)
 })
 
 
@@ -1243,6 +1280,31 @@ test_that("can read about assigned shared resources", {
   expect_equal(res$shared_resource, c(shared_data = "data"))
 })
 
+test_that("can read about shared resources with shorthand syntax", {
+  path <- test_prepare_orderly_example("shared-shorthand")
+  path_src <- file.path(path, "src", "shared-shorthand")
+  code <- readLines(file.path(path_src, "shared-shorthand.R"))
+  code <- sub("orderly2::orderly_shared_resource",
+              "r <- orderly2::orderly_shared_resource",
+              code)
+  code <- c(code, 'saveRDS(r, "resources.rds")')
+  writeLines(code, file.path(path_src, "shared-shorthand.R"))
+
+  id <- orderly_run_quietly("shared-shorthand", root = path, envir = new.env())
+  r <- readRDS(file.path(path, "archive", "shared-shorthand",
+                         id, "resources.rds"))
+  expect_equal(r, data_frame(here = "data.csv", there = "data.csv"))
+
+  res <- withr::with_dir(
+    path_src,
+    withVisible(orderly_shared_resource("data.csv")))
+  expect_equal(res$visible, FALSE)
+  expect_equal(res$value, r)
+
+  res <- orderly_read(path_src)
+  expect_equal(res$shared_resource, c(data.csv = "data.csv"))
+})
+
 
 test_that("can read about dependencies", {
   path <- test_prepare_orderly_example(c("data", "depends"))

tests/testthat/test-util-assert.R

@@ -26,6 +26,14 @@ test_that("assert_simple_scalar_atomic", {
   expect_error(assert_simple_scalar_atomic(list(1)), "must be atomic")
 })
 
+test_that("assert_unique_names", {
+  expect_error(assert_unique_names(setNames(1:3, c("a", "a", "c"))),
+               "must have unique names")
+  expect_error(assert_unique_names(setNames(1:3, c("a", "c", "a"))),
+               "must have unique names")
+  expect_silent(assert_unique_names(setNames(1:3, c("a", "b", "c"))))
+})
+
 
 test_that("assert_named", {
   expect_error(assert_named(1), "must be named")

tests/testthat/test-util.R

@@ -334,3 +334,10 @@ test_that("read_string strips newlines", {
   result <- expect_silent(read_string(path))
   expect_equal(result, "12345678")
 })
+
+test_that("fill_missing_names works", {
+  expect_equal(fill_missing_names(NULL), NULL)
+  expect_equal(fill_missing_names(c("a", "b")), c(a = "a", b = "b"))
+  expect_equal(fill_missing_names(c("a", "a")), c(a = "a", a = "a"))
+  expect_equal(fill_missing_names(c(x = "a", "a")), c(x = "a", a = "a"))
+})

vignettes/introduction.Rmd

@@ -311,7 +311,7 @@ We can then write an orderly report `use_shared` that uses this shared file, wit
 ```{r, echo = FALSE, results = "asis"}
 fs::dir_create(file.path(path, "src", "use_shared"))
 writeLines(c(
-  'orderly2::orderly_shared_resource(data.csv = "data.csv")',
+  'orderly2::orderly_shared_resource("data.csv")',
   'orderly2::orderly_artefact("analysis", "analysis.png")',
   "",
   'd <- read.csv("data.csv")',