From dbd1e437430727a6017f9b21440e31d1cdfcbee8 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Fri, 31 Mar 2023 08:40:19 +0100 Subject: [PATCH 1/7] Most dependency support --- NAMESPACE | 1 + R/metadata.R | 70 +++++++++++++++++++++++ man/orderly_depends.Rd | 26 +++++++++ tests/testthat/examples/depends/orderly.R | 2 + tests/testthat/test-run.R | 31 ++++++++++ 5 files changed, 130 insertions(+) create mode 100644 man/orderly_depends.Rd create mode 100644 tests/testthat/examples/depends/orderly.R 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/metadata.R b/R/metadata.R index efda20e4..0c4b6455 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -120,6 +120,75 @@ 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) + if (length(use) == 0) { + stop("'use' must have length of at least 1") + } + if (is.null(names(use))) { + names(use) <- use + } else { + is_unnamed <- names(use) == "" + names(use)[is_unnamed] <- use[is_unnamed] + } + assert_named(use, unique = TRUE) + + p <- get_active_packet() + if (!is.null(p)) { + 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(name, query, use) { + ## TODO: do we want this to error in the case where 'name' is non-scalar? + name <- static_string(name) + use <- static_character_vector(use) + ## TODO: allow passing expressions directly in, that will be much nicer + 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 +202,7 @@ static_character_vector <- function(x) { } + static_eval <- function(fn, call) { if (is_call(call[[1]], "::")) { call[[1]] <- call[[1]][[3]] 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-run.R b/tests/testthat/test-run.R index b414e6d2..7768674f 100644 --- a/tests/testthat/test-run.R +++ b/tests/testthat/test-run.R @@ -135,3 +135,34 @@ 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", { + skip("needs work") + 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")) +}) From 3dce25078e888d5a86f78ba1a4a07b1bbdd6cb61 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Fri, 31 Mar 2023 08:59:49 +0100 Subject: [PATCH 2/7] Flesh out testing --- R/read.R | 6 +++++- R/util.R | 6 ++++++ tests/testthat/test-read.R | 22 +++++++++++++++++++++- tests/testthat/test-util.R | 15 +++++++++++++++ 4 files changed, 47 insertions(+), 2 deletions(-) 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/tests/testthat/test-read.R b/tests/testthat/test-read.R index 74678a69..68eba7b9 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,23 @@ 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", { + expect_equal( + static_orderly_depends("a", "latest", c(x = "y")), + list(name = "a", query = "latest", use = c(x = "y"))) + + expect_null(static_orderly_depends(quote(a), "latest", c(x = "y"))) + expect_null(static_orderly_depends("a", quote(latest), c(x = "y"))) + expect_null(static_orderly_depends("a", "latest", quote(use))) +}) 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")) +}) From e4c5c339ca1b8f989756b459f6b2016a11a0af35 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Tue, 4 Apr 2023 08:51:23 +0100 Subject: [PATCH 3/7] Enable working interactively --- DESCRIPTION | 2 +- R/interactive.R | 16 ++++++++++++++++ R/metadata.R | 17 +++++++++++++---- tests/testthat/test-run.R | 1 - 4 files changed, 30 insertions(+), 6 deletions(-) create mode 100644 R/interactive.R 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/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 0c4b6455..f7d70f48 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -122,7 +122,7 @@ static_orderly_artefact <- function(args) { ##' Declare a dependency on another packet ##' -##' @title Declare a dependency +##' @title Declare a dependency ##' ##' @param name The name of the packet to depend on ##' @@ -154,7 +154,15 @@ orderly_depends <- function(name, query, use) { assert_named(use, unique = TRUE) p <- get_active_packet() - if (!is.null(p)) { + 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) @@ -166,10 +174,11 @@ orderly_depends <- function(name, query, use) { static_orderly_depends <- function(name, query, use) { - ## TODO: do we want this to error in the case where 'name' is non-scalar? name <- static_string(name) use <- static_character_vector(use) - ## TODO: allow passing expressions directly in, that will be much nicer + ## 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) diff --git a/tests/testthat/test-run.R b/tests/testthat/test-run.R index 7768674f..06b32d52 100644 --- a/tests/testthat/test-run.R +++ b/tests/testthat/test-run.R @@ -155,7 +155,6 @@ test_that("Can run simple case with dependency", { test_that("Can run dependencies case without orderly", { - skip("needs work") path <- test_prepare_orderly_example(c("explicit", "depends")) env1 <- new.env() id1 <- orderly_run("explicit", root = path, envir = env1) From 4e10f9b1d27e35aef612e4ecdc099fe288e0f519 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Tue, 4 Apr 2023 09:03:09 +0100 Subject: [PATCH 4/7] Tidy up implementation --- R/metadata.R | 6 +++++- tests/testthat/test-read.R | 16 +++++++++++----- tests/testthat/test-run.R | 4 ++++ 3 files changed, 20 insertions(+), 6 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index f7d70f48..79104f95 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -173,7 +173,11 @@ orderly_depends <- function(name, query, use) { } -static_orderly_depends <- function(name, query, use) { +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 diff --git a/tests/testthat/test-read.R b/tests/testthat/test-read.R index 68eba7b9..24fd9793 100644 --- a/tests/testthat/test-read.R +++ b/tests/testthat/test-read.R @@ -46,11 +46,17 @@ test_that("Can read string from expressions", { test_that("read dependency", { - expect_equal( - static_orderly_depends("a", "latest", c(x = "y")), - list(name = "a", query = "latest", use = c(x = "y"))) - - expect_null(static_orderly_depends(quote(a), "latest", c(x = "y"))) + 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("a", quote(latest), c(x = "y"))) expect_null(static_orderly_depends("a", "latest", quote(use))) }) diff --git a/tests/testthat/test-run.R b/tests/testthat/test-run.R index 06b32d52..fb30c5fa 100644 --- a/tests/testthat/test-run.R +++ b/tests/testthat/test-run.R @@ -164,4 +164,8 @@ test_that("Can run dependencies case without orderly", { 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")))) }) From 7391cf86098cb15eaad5b719b48c0fb0de13efea Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Tue, 4 Apr 2023 17:17:57 +0100 Subject: [PATCH 5/7] Tidy up test --- tests/testthat/test-read.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-read.R b/tests/testthat/test-read.R index 24fd9793..b8bde223 100644 --- a/tests/testthat/test-read.R +++ b/tests/testthat/test-read.R @@ -57,6 +57,8 @@ test_that("read dependency", { static_orderly_depends(list(name = "a", query = quote(latest), use = c(x = "y")))) - expect_null(static_orderly_depends("a", quote(latest), c(x = "y"))) - expect_null(static_orderly_depends("a", "latest", quote(use))) + expect_null( + static_orderly_depends(list(name = "a", + query = "latest", + use = quote(use)))) }) From 16f38cfd6132ca0e9bc994b603e3a471d6cd7643 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Tue, 4 Apr 2023 17:20:52 +0100 Subject: [PATCH 6/7] Simplify --- R/metadata.R | 9 --------- 1 file changed, 9 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index 79104f95..1b2002e1 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -142,15 +142,6 @@ orderly_depends <- function(name, query, use) { assert_scalar_character(query) assert_character(use) - if (length(use) == 0) { - stop("'use' must have length of at least 1") - } - if (is.null(names(use))) { - names(use) <- use - } else { - is_unnamed <- names(use) == "" - names(use)[is_unnamed] <- use[is_unnamed] - } assert_named(use, unique = TRUE) p <- get_active_packet() From 155e3c30fc49105d6340903e908415245114a6fa Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Tue, 4 Apr 2023 17:25:41 +0100 Subject: [PATCH 7/7] Test for helper utility --- tests/testthat/test-interactive.R | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 tests/testthat/test-interactive.R 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") +})