Merge pull request #5 from mrc-ide/deps

Basic support for dependencies

DESCRIPTION

@@ -18,7 +18,7 @@ Imports:
     fs,
     jsonlite,
     orderly,
-    outpack,
+    outpack (>= 0.2.4),
     withr,
     yaml
 Suggests:

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(orderly_artefact)
+export(orderly_depends)
 export(orderly_parameters)
 export(orderly_resource)
 export(orderly_run)

R/interactive.R

@@ -0,0 +1,16 @@
+## This is something that we might improve over time - it will likely
+## be useful to have some sort of "register interactive" function
+## which we could then just look up.
+##
+## I am not sure if we also want to allow working interactively from a
+## draft directory too.
+detect_orderly_interactive_path <- function(path = getwd()) {
+  path_split <- fs::path_split(path)[[1]]
+  is_plausible <- length(path_split) > 2 &&
+    path_split[[length(path_split) - 1]] == "src" &&
+    file.exists(file.path(path, "../..", "orderly_config.yml"))
+  if (!is_plausible) {
+    stop(sprintf("Failed to detect orderly path at '%s'", path))
+  }
+  orderly_root(file.path(path, "../.."), FALSE)
+}

R/metadata.R

@@ -120,6 +120,79 @@ static_orderly_artefact <- function(args) {
 }
 
 
+##' Declare a dependency on another packet
+##'
+##' @title Declare a dependency
+##'
+##' @param name The name of the packet to depend on
+##'
+##' @param query The query to search for; often this will simply be
+##'   the string `latest`, indicating the most recent version. You may
+##'   want a more complex query here though.
+##'
+##' @param use A named character vector of filenames to copy from the
+##'   upstream packet. The name corresponds to the destination name,
+##'   so c(here.csv = "there.csv") will take the upstream file
+##'   `there.csv` and copy it over as `here.csv`.
+##'
+##' @return Undefined
+##' @export
+orderly_depends <- function(name, query, use) {
+  assert_scalar_character(name)
+  assert_scalar_character(query)
+
+  assert_character(use)
+  assert_named(use, unique = TRUE)
+
+  p <- get_active_packet()
+  if (is.null(p)) {
+    path <- getwd()
+    root <- detect_orderly_interactive_path(path)
+    env <- parent.frame()
+    id <- outpack::outpack_query(query, env, name = name,
+                                 require_unpacked = TRUE,
+                                 root = root$outpack)
+    outpack::outpack_copy_files(id, use, path, root$outpack)
+  } else {
+    id <- outpack::outpack_query(query, p$parameters, name = name,
+                                 require_unpacked = TRUE,
+                                 root = p$root)
+    outpack::outpack_packet_use_dependency(id, use, p)
+  }
+
+  invisible()
+}
+
+
+static_orderly_depends <- function(args) {
+  name <- args$name
+  query <- args$query
+  use <- args$use
+
+  name <- static_string(name)
+  use <- static_character_vector(use)
+  ## TODO: allow passing expressions directly in, that will be much
+  ## nicer, but possibly needs some care as we do want a consistent
+  ## approach to NSE here
+  query <- static_string(query)
+  if (is.null(name) || is.null(use) || is.null(query)) {
+    return(NULL)
+  }
+  list(name = name, query = query, use = use)
+}
+
+
+static_string <- function(x) {
+  if (is.character(x)) {
+    x
+  } else if (is_call(x, "c") && length(x) == 2 && is.character(x[[2]])) {
+    x[[2]]
+  } else {
+    NULL
+  }
+}
+
+
 static_character_vector <- function(x) {
   if (is.character(x)) {
     x
@@ -133,6 +206,7 @@ static_character_vector <- function(x) {
 }
 
 
+
 static_eval <- function(fn, call) {
   if (is_call(call[[1]], "::")) {
     call[[1]] <- call[[1]][[3]]

R/read.R

@@ -12,7 +12,8 @@ orderly_read_r <- function(path) {
 
   check <- list(orderly_parameters = static_orderly_parameters,
                 orderly_resource = static_orderly_resource,
-                orderly_artefact = static_orderly_artefact)
+                orderly_artefact = static_orderly_artefact,
+                orderly_depends = static_orderly_depends)
   dat <- set_names(rep(list(NULL), length(check)), names(check))
 
   for (e in exprs) {
@@ -49,6 +50,9 @@ orderly_read_r <- function(path) {
   if (length(dat$artefact) > 0) {
     ret$artefacts <- dat$artefact
   }
+  if (length(dat$depends) > 0) {
+    ret$depends <- drop_null(dat$depends, empty = NULL)
+  }
 
   ret
 }

R/util.R

@@ -62,3 +62,9 @@ data_frame <- function(...) {
 squote <- function(x) {
   sprintf("'%s'", x)
 }
+
+
+drop_null <- function(x, empty) {
+  i <- vlapply(x, is.null)
+  if (all(i)) empty else x[!i]
+}

tests/testthat/examples/depends/orderly.R

@@ -0,0 +1,2 @@
+orderly3::orderly_depends("explicit", "latest", c(graph.png = "mygraph.png"))
+orderly3::orderly_artefact("Final plot", "graph.png")

tests/testthat/test-interactive.R

@@ -0,0 +1,14 @@
+test_that("can detect orderly directory", {
+  path <- test_prepare_orderly_example("explicit")
+  env <- new.env()
+  id <- orderly_run("explicit", root = path, envir = env)
+
+  expect_error(
+    detect_orderly_interactive_path(path),
+    "Failed to detect orderly path at")
+  expect_error(
+    detect_orderly_interactive_path(file.path(path, "src")),
+    "Failed to detect orderly path at")
+  root <- detect_orderly_interactive_path(file.path(path, "src", "explicit"))
+  expect_s3_class(root, "orderly_root")
+})

tests/testthat/test-read.R

@@ -19,7 +19,7 @@ test_that("Skip over computed resources", {
 })
 
 
-test_that("Can read string literals from expressions", {
+test_that("Can read string vector literals from expressions", {
   expect_equal(static_character_vector(quote("x")), "x")
   expect_equal(static_character_vector(quote(c("x"))), "x")
   expect_equal(static_character_vector(quote(c("x", "y"))), c("x", "y"))
@@ -34,3 +34,31 @@ test_that("Can read string literals from expressions", {
   expect_null(static_character_vector(quote(c("x", c("y", b)))))
   expect_null(static_character_vector(quote(c(a, c("x", "y")))))
 })
+
+
+test_that("Can read string from expressions", {
+  expect_equal(static_string(quote("x")), "x")
+  expect_equal(static_string(quote(c("x"))), "x")
+
+  expect_null(static_string(quote(a)))
+  expect_null(static_string(quote(c(a))))
+})
+
+
+test_that("read dependency", {
+  args <- list(name = "a", query = "latest", use = c(x = "y"))
+  expect_equal(static_orderly_depends(args), args)
+
+  expect_null(
+    static_orderly_depends(list(name = quote(a),
+                                query = "latest",
+                                use = c(x = "y"))))
+  expect_null(
+    static_orderly_depends(list(name = "a",
+                                query = quote(latest),
+                                use = c(x = "y"))))
+  expect_null(
+    static_orderly_depends(list(name = "a",
+                                query = "latest",
+                                use = quote(use))))
+})

tests/testthat/test-run.R

@@ -135,3 +135,37 @@ test_that("can run orderly with parameters, without orderly", {
   expect_true(file.exists(path_rds))
   expect_equal(readRDS(path_rds), list(a = 10, b = 2, c = 30))
 })
+
+
+test_that("Can run simple case with dependency", {
+  path <- test_prepare_orderly_example(c("explicit", "depends"))
+  env1 <- new.env()
+  id1 <- orderly_run("explicit", root = path, envir = env1)
+  env2 <- new.env()
+  id2 <- orderly_run("depends", root = path, envir = env2)
+
+  path1 <- file.path(path, "archive", "explicit", id1)
+  path2 <- file.path(path, "archive", "depends", id2)
+
+  expect_true(file.exists(file.path(path2, "graph.png")))
+  expect_equal(
+    unname(tools::md5sum(file.path(path2, "graph.png"))),
+    unname(tools::md5sum(file.path(path1, "mygraph.png"))))
+})
+
+
+test_that("Can run dependencies case without orderly", {
+  path <- test_prepare_orderly_example(c("explicit", "depends"))
+  env1 <- new.env()
+  id1 <- orderly_run("explicit", root = path, envir = env1)
+
+  env2 <- new.env()
+  path_src <- file.path(path, "src", "depends")
+  withr::with_dir(path_src,
+                  sys.source("orderly.R", env2))
+  expect_setequal(dir(path_src), c("orderly.R", "graph.png"))
+  expect_equal(
+    unname(tools::md5sum(file.path(path_src, "graph.png"))),
+    unname(tools::md5sum(file.path(path, "archive", "explicit", id1,
+                                   "mygraph.png"))))
+})

tests/testthat/test-util.R

@@ -4,3 +4,18 @@ test_that("null-or-value works", {
   expect_equal(NULL %||% NULL, NULL)
   expect_equal(NULL %||% 2, 2)
 })
+
+
+test_that("drop null can return corner case", {
+  expect_null(drop_null(list(), NULL))
+  expect_null(drop_null(list(NULL), NULL))
+  expect_null(drop_null(list(NULL, NULL), NULL))
+  expect_equal(drop_null(list(NULL, NULL), list()), list())
+})
+
+
+test_that("drop_null can filter list", {
+  expect_equal(drop_null(list("x", NULL)), list("x"))
+  expect_equal(drop_null(list("x", "y")), list("x", "y"))
+  expect_equal(drop_null(list("x", NULL, "y")), list("x", "y"))
+})