diff --git a/DESCRIPTION b/DESCRIPTION index 34a8ef3d..06e6efef 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -18,7 +18,7 @@ Imports: fs, jsonlite, orderly, - outpack, + outpack (>= 0.2.4), withr, yaml Suggests: diff --git a/NAMESPACE b/NAMESPACE index c4f628d5..34a04593 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/interactive.R b/R/interactive.R new file mode 100644 index 00000000..c580e9a9 --- /dev/null +++ b/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) +} diff --git a/R/metadata.R b/R/metadata.R index efda20e4..1b2002e1 100644 --- a/R/metadata.R +++ b/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]] diff --git a/R/read.R b/R/read.R index 774055ed..83b071e9 100644 --- a/R/read.R +++ b/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 } diff --git a/R/util.R b/R/util.R index 1bf53ce7..1f7f7bfb 100644 --- a/R/util.R +++ b/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] +} diff --git a/man/orderly_depends.Rd b/man/orderly_depends.Rd new file mode 100644 index 00000000..a4a634b2 --- /dev/null +++ b/man/orderly_depends.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/metadata.R +\name{orderly_depends} +\alias{orderly_depends} +\title{Declare a dependency} +\usage{ +orderly_depends(name, query, use) +} +\arguments{ +\item{name}{The name of the packet to depend on} + +\item{query}{The query to search for; often this will simply be +the string \code{latest}, indicating the most recent version. You may +want a more complex query here though.} + +\item{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 +\code{there.csv} and copy it over as \code{here.csv}.} +} +\value{ +Undefined +} +\description{ +Declare a dependency on another packet +} diff --git a/tests/testthat/examples/depends/orderly.R b/tests/testthat/examples/depends/orderly.R new file mode 100644 index 00000000..ab6700b0 --- /dev/null +++ b/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") diff --git a/tests/testthat/test-interactive.R b/tests/testthat/test-interactive.R new file mode 100644 index 00000000..5aaa5c69 --- /dev/null +++ b/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") +}) diff --git a/tests/testthat/test-read.R b/tests/testthat/test-read.R index 74678a69..b8bde223 100644 --- a/tests/testthat/test-read.R +++ b/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)))) +}) diff --git a/tests/testthat/test-run.R b/tests/testthat/test-run.R index b414e6d2..fb30c5fa 100644 --- a/tests/testthat/test-run.R +++ b/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")))) +}) diff --git a/tests/testthat/test-util.R b/tests/testthat/test-util.R index 8f4ffdd1..f9503a3e 100644 --- a/tests/testthat/test-util.R +++ b/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")) +})