diff --git a/R/metadata.R b/R/metadata.R index e6fb2d39..6784eb9f 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -286,6 +286,10 @@ orderly_dependency <- function(name, query, files) { subquery <- NULL query <- orderly_query(query, name = name, subquery = subquery) search_options <- as_orderly_search_options(ctx$search_options) + ## TODO: this separation of codepaths here is quite weird. We + ## should do the copy here and have the outpack function probably + ## just do the metadata update. The logic is otherwise fine I + ## think. if (ctx$is_active) { res <- outpack_packet_use_dependency(ctx$packet, query, files, search_options = search_options, @@ -293,9 +297,16 @@ orderly_dependency <- function(name, query, files) { overwrite = TRUE) } else { res <- orderly_copy_files( - query, files = files, dest = ctx$path, overwrite = TRUE, - parameters = ctx$parameters, options = search_options, - envir = ctx$envir, root = ctx$root) + query, + files = files, + dest = ctx$path, + overwrite = TRUE, + parameters = ctx$parameters, + location = search_options$location, + allow_remote = search_options$allow_remote, + pull_metadata = search_options$pull_metadata, + envir = ctx$envir, + root = ctx$root) } cli::cli_alert_info( diff --git a/R/outpack_helpers.R b/R/outpack_helpers.R index 31c14447..9bbad63b 100644 --- a/R/outpack_helpers.R +++ b/R/outpack_helpers.R @@ -72,43 +72,53 @@ ##' typically what you want, but set to `FALSE` if you would prefer ##' that an error be thrown if the destination file already exists. ##' -##' @param ... Additional arguments passed through to [orderly_search] -##' ##' @inheritParams orderly_search +##' @inheritParams orderly_search_options ##' @inheritParams orderly_metadata ##' ##' @return Nothing, invisibly. Primarily called for its side effect ##' of copying files from a packet into the directory `dest` ##' ##' @export -orderly_copy_files <- function(..., files, dest, overwrite = TRUE, - envir = parent.frame(), options = NULL, +orderly_copy_files <- function(expr, files, dest, overwrite = TRUE, + name = NULL, location = NULL, + allow_remote = NULL, pull_metadata = FALSE, + parameters = NULL, + envir = parent.frame(), root = NULL) { root <- root_open(root, require_orderly = FALSE) + options <- orderly_search_options(location = location, + allow_remote = allow_remote, + pull_metadata = pull_metadata) ## Validate files and dest early; it gives a better error where this ## was not provided with names. files <- validate_file_from_to(files, envir) assert_scalar_character(dest, call = environment()) - if (dots_is_literal_id(...)) { - id <- ..1 + if (expr_is_literal_id(expr, name)) { + id <- expr if (length(id) != 1) { - cli::cli_abort(sprintf( - "Expected a length 1 value for first argument if id (not %d)", - length(id))) + cli::cli_abort( + "Expected a length 1 value for 'expr' if id (not {length(id)})", + arg = expr) } } else { - id <- orderly_search(..., options = options, envir = envir, root = root) + ## TODO: we may drop options here + id <- orderly_search(expr, name = name, + options = options, + parameters = parameters, # TODO, bind these earlier? + # location = location, pull_metadata = pull_metadata, + root = root) if (length(id) > 1) { - cli::cli_abort(c( - sprintf("Query returned %d results, expected a single result", - length(id)), - i = "Did you forget latest()?")) + cli::cli_abort( + c("Query returned {length(id)} results, expected a single result", + i = "Did you forget latest()?")) } if (length(id) == 0 || is.na(id)) { - explanation <- orderly_query_explain(..., options = options, - envir = envir, root = root) + explanation <- orderly_query_explain( + expr, name = name, parameters = parameters, options = options, + envir = envir, root = root) cli::cli_abort( c("Query returned 0 results", i = "See 'rlang::last_error()$explanation' for details"), @@ -135,11 +145,10 @@ orderly_copy_files <- function(..., files, dest, overwrite = TRUE, c("Unable to copy files, due to {reason} packet {id}", i = "Consider '{cmd}' to remove this packet from consideration"), parent = e) - } else if (!as_orderly_search_options(options)$allow_remote) { + } else if (!options$allow_remote) { cli::cli_abort( c("Unable to copy files, as they are not available locally", - i = paste("To fetch from a location, try again with", - "options = list(allow_remote = TRUE)")), + i = "To fetch from a location, try again with allow_remote = TRUE"), parent = e) } copy_files_from_remote(id, plan$there, plan$here, dest, overwrite, root, diff --git a/R/outpack_packet.R b/R/outpack_packet.R index a65ecfee..791c73df 100644 --- a/R/outpack_packet.R +++ b/R/outpack_packet.R @@ -194,7 +194,9 @@ outpack_packet_use_dependency <- function(packet, query, files, } result <- orderly_copy_files(id, files = files, dest = packet$path, - options = search_options, + location = search_options$location, + allow_remote = search_options$allow_remote, + pull_metadata = search_options$pull_metadata, overwrite = overwrite, envir = envir, root = packet$root) diff --git a/man/orderly_copy_files.Rd b/man/orderly_copy_files.Rd index beb7279c..0bc68535 100644 --- a/man/orderly_copy_files.Rd +++ b/man/orderly_copy_files.Rd @@ -5,17 +5,21 @@ \title{Copy files from a packet} \usage{ orderly_copy_files( - ..., + expr, files, dest, overwrite = TRUE, + name = NULL, + location = NULL, + allow_remote = NULL, + pull_metadata = FALSE, + parameters = NULL, envir = parent.frame(), - options = NULL, root = NULL ) } \arguments{ -\item{...}{Additional arguments passed through to \link{orderly_search}} +\item{expr}{The query expression. A \code{NULL} expression matches everything.} \item{files}{Files to copy from the other packet. This can be (1) a character vector, in which case files are copied over without @@ -51,16 +55,38 @@ the destination filename by doing \verb{$\{x\}}.} typically what you want, but set to \code{FALSE} if you would prefer that an error be thrown if the destination file already exists.} +\item{name}{Optionally, the name of the packet to scope the query on. This +will be intersected with \code{scope} arg and is a shorthand way of running +\code{scope = list(name = "name")}} + +\item{location}{Optional vector of locations to pull from. We +might in future expand this to allow wildcards or exceptions.} + +\item{allow_remote}{Logical, indicating if we should allow packets +to be found that are not currently unpacked (i.e., are known +only to a location that we have metadata from). If this is +\code{TRUE}, then in conjunction with \link{orderly_dependency} +you might pull a large quantity of data. The default \code{NULL} is +\code{TRUE} if locations are listed explicitly as a character vector +in the \code{location} argument, otherwise \code{FALSE}.} + +\item{pull_metadata}{Logical, indicating if we should pull +metadata immediately before the search. If \code{location} is given, +then we will pass this through to +\link{orderly_location_pull_metadata} to filter locations +to update. If pulling many packets in sequence, you \emph{will} want +to update this option to \code{FALSE} after the first pull, otherwise +it will update the metadata between every packet, which will be +needlessly slow.} + +\item{parameters}{Optionally, a named list of parameters to substitute +into the query (using the \verb{this:} prefix)} + \item{envir}{Optionally, an environment to substitute into the query (using the \verb{environment:} prefix). The default here is to use the calling environment, but you can explicitly pass this in if you want to control where this lookup happens.} -\item{options}{Optionally, a \link{orderly_search_options} -object for controlling how the search is performed, and which -packets should be considered in scope. If not provided, default -options are used (i.e., \code{orderly2::orderly_search_options()})} - \item{root}{The path to the root directory, or \code{NULL} (the default) to search for one from the current working directory. This function does not require that the directory is diff --git a/tests/testthat/test-outpack-helpers.R b/tests/testthat/test-outpack-helpers.R index b6f7b5ec..999c0e93 100644 --- a/tests/testthat/test-outpack-helpers.R +++ b/tests/testthat/test-outpack-helpers.R @@ -32,7 +32,7 @@ test_that("can copy files from location, using store", { suppressMessages( orderly_copy_files(id, files = c("data.rds" = "data.rds"), dest = tmp, - options = list(allow_remote = TRUE), root = here)) + allow_remote = TRUE, root = here)) expect_equal(dir(tmp), "data.rds") meta <- orderly_metadata(id, root = there) @@ -57,7 +57,7 @@ test_that("can copy files from location, using archive", { suppressMessages( orderly_copy_files(id, files = c("data.rds" = "data.rds"), dest = tmp, - options = list(allow_remote = TRUE), root = here)) + allow_remote = TRUE, root = here)) expect_equal(dir(tmp), "data.rds") meta <- orderly_metadata(id, there) @@ -90,12 +90,12 @@ test_that("require a single id for search", { ids <- replicate(3, outpack_id()) expect_error( orderly_copy_files(ids, files = c(here = "there"), dest = dst, root = root), - "Expected a length 1 value for first argument if id (not 3)", + "Expected a length 1 value for 'expr' if id (not 3)", fixed = TRUE) expect_error( orderly_copy_files(character(), files = c(here = "there"), dest = dst, root = root), - "Expected a length 1 value for first argument if id (not 0)", + "Expected a length 1 value for 'expr' if id (not 0)", fixed = TRUE) })