diff --git a/DESCRIPTION b/DESCRIPTION index 92a2fa76..44405753 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: orderly2 Title: Orderly Next Generation -Version: 1.99.45 +Version: 1.99.46 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), person("Robert", "Ashton", role = "aut"), diff --git a/R/interactive.R b/R/interactive.R index e30a814b..00ba070d 100644 --- a/R/interactive.R +++ b/R/interactive.R @@ -75,13 +75,16 @@ detect_orderly_interactive_path <- function( ##' ##' @title Set search options for interactive use ##' -##' @param options Optional control over locations, when used -##' with [orderly2::orderly_dependency]; see of Details section of -##' [orderly2::orderly_run]. +##' @inheritParams orderly_search_options ##' ##' @return Nothing, called for its side effects ##' @export -orderly_interactive_set_search_options <- function(options = NULL) { +orderly_interactive_set_search_options <- function(location = NULL, + allow_remote = NULL, + pull_metadata = FALSE) { + options <- build_search_options(location = location, + allow_remote = allow_remote, + pull_metadata = pull_metadata) .interactive$search_options <- options } diff --git a/R/location.R b/R/location.R index af93b619..c5544fc6 100644 --- a/R/location.R +++ b/R/location.R @@ -323,18 +323,6 @@ orderly_location_pull_metadata <- function(location = NULL, root = NULL) { ##' ##' @title Pull one or more packets from a location ##' -##' @param ... Arguments passed through to -##' [orderly2::orderly_search]. In the special case where the first -##' argument is a character vector of ids *and* there are no named -##' dot arguments, then we interpret this argument as a vector of -##' ids directly. Be careful here, your query may pull a lot of data -##' - in particular, passing `NULL` will match everything that every -##' remote has! -##' -##' @param options Options passed to [orderly2::orderly_search]. -##' The option `allow_remote` must be `TRUE` as otherwise no packet could -##' possibly be pulled, so an error is thrown if this is FALSE. -##' ##' @param recursive If non-NULL, a logical, indicating if we should ##' recursively pull all packets that are referenced by the packets ##' specified in `id`. This might copy a lot of data! If `NULL`, @@ -342,30 +330,37 @@ orderly_location_pull_metadata <- function(location = NULL, root = NULL) { ##' `require_complete_tree`. ##' ##' @inheritParams orderly_metadata +##' @inheritParams orderly_search +##' @inheritParams orderly_search_options ##' ##' @return Invisibly, the ids of packets that were pulled ##' @export -orderly_location_pull_packet <- function(..., options = NULL, recursive = NULL, +orderly_location_pull_packet <- function(expr, + name = NULL, + location = NULL, + pull_metadata = FALSE, + recursive = NULL, + options = NULL, root = NULL) { root <- root_open(root, require_orderly = FALSE) - options <- as_orderly_search_options(options, list(allow_remote = TRUE)) - if (!options$allow_remote) { - cli::cli_abort( - "If specifying 'options', 'allow_remote' must be TRUE", - i = "If FALSE, then we can't find a packet you don't already have :)") - } - if (dots_is_literal_id(...)) { - ids <- ..1 + compatibility_fix_options(options, "orderly_location_pull_packet") + + if (expr_is_literal_id(expr, name)) { + ids <- expr } else { - ids <- orderly_search(..., options = options, root = root) + ids <- orderly_search(expr, + name = name, + location = location, + allow_remote = TRUE, + pull_metadata = pull_metadata, + root = root) } - if (length(ids) == 0) { - if (options$allow_remote && !options$pull_metadata) { - pull_arg <- gsub(" ", "\u00a0", "options = list(pull_metadata = TRUE)") + if (length(ids) == 0 || (length(ids) == 1 && is.na(ids))) { + if (!pull_metadata) { hint <- c(i = paste("Did you forget to pull metadata? You can do this", - "by using the argument '{pull_arg}' in the call", - "to 'orderly_location_pull_packet()', or", + "by using the argument {.code pull_metadata = TRUE}", + "in the call to 'orderly_location_pull_packet()', or", "by running 'orderly_location_pull_metadata()'")) } else { hint <- NULL @@ -377,7 +372,7 @@ orderly_location_pull_packet <- function(..., options = NULL, recursive = NULL, hint)) } - plan <- location_build_pull_plan(ids, options$locations, recursive, root, + plan <- location_build_pull_plan(ids, location, recursive, root, call = environment()) if (plan$info$n_extra > 0) { diff --git a/R/metadata.R b/R/metadata.R index e6fb2d39..8b06c757 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -285,7 +285,12 @@ orderly_dependency <- function(name, query, files) { ctx <- orderly_context(rlang::caller_env()) subquery <- NULL query <- orderly_query(query, name = name, subquery = subquery) - search_options <- as_orderly_search_options(ctx$search_options) + search_options <- ctx$search_options %||% build_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 +298,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..f280fef2 100644 --- a/R/outpack_helpers.R +++ b/R/outpack_helpers.R @@ -72,43 +72,59 @@ ##' 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, options = NULL, + envir = parent.frame(), root = NULL) { root <- root_open(root, require_orderly = FALSE) + compatibility_fix_options(options, "orderly_copy_files") + ## Validate options here so we can refer to the computed value of + ## allow_remote later in error messages. + options <- build_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) + id <- orderly_search(expr, + name = name, + parameters = parameters, + location = options$location, + allow_remote = options$allow_remote, + pull_metadata = options$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, + location = options$location, + allow_remote = options$allow_remote, + envir = envir, root = root) cli::cli_abort( c("Query returned 0 results", i = "See 'rlang::last_error()$explanation' for details"), @@ -135,11 +151,11 @@ 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)")), + "{.code 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..404eb96e 100644 --- a/R/outpack_packet.R +++ b/R/outpack_packet.R @@ -162,7 +162,8 @@ outpack_packet_use_dependency <- function(packet, query, files, overwrite = TRUE) { packet <- check_current_packet(packet) query <- as_orderly_query(query, arg = "query") - search_options <- as_orderly_search_options(search_options) + search_options <- search_options %||% build_search_options() + assert_is(search_options, "orderly_search_options") if (!query$info$single) { stop(paste( @@ -174,12 +175,16 @@ outpack_packet_use_dependency <- function(packet, query, files, id <- orderly_search(query, parameters = packet$parameters, envir = envir, - options = search_options, + location = search_options$location, + allow_remote = search_options$allow_remote, + pull_metadata = search_options$pull_metadata, root = packet$root) if (is.na(id)) { explanation <- orderly_query_explain( query, parameters = packet$parameters, envir = envir, - options = search_options, root = packet$root) + location = search_options$location, + allow_remote = search_options$allow_remote, + root = packet$root) cli::cli_abort( c("Failed to find packet for query '{format(query)}'", i = "See 'rlang::last_error()$explanation' for details"), @@ -194,7 +199,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/R/outpack_tools.R b/R/outpack_tools.R index 7a2ae3f1..4f56c17d 100644 --- a/R/outpack_tools.R +++ b/R/outpack_tools.R @@ -182,27 +182,33 @@ ##' ##' @title Extract metadata from orderly2 packets ##' -##' @param ... Arguments passed through to -##' [orderly2::orderly_search]. In the special case where the first -##' argument is a character vector of ids *and* there are no named -##' dot arguments, then we interpret this argument as a vector of -##' ids directly. -##' ##' @param extract A character vector of columns to extract, possibly ##' named. See Details for the format. ##' ##' @inheritParams orderly_metadata +##' @inheritParams orderly_search +##' @inheritParams orderly_search_options ##' ##' @return A `data.frame`, the columns of which vary based on the ##' names of `extract`; see Details for more information. ##' ##' @export -orderly_metadata_extract <- function(..., extract = NULL, root = NULL) { +orderly_metadata_extract <- function(expr = NULL, name = NULL, location = NULL, + allow_remote = NULL, pull_metadata = FALSE, + extract = NULL, options = NULL, + root = NULL) { root <- root_open(root, require_orderly = FALSE) - if (dots_is_literal_id(...)) { - ids <- ..1 + compatibility_fix_options(options, "orderly_metadata_extract") + + if (expr_is_literal_id(expr, name)) { + ids <- expr } else { - ids <- orderly_search(..., root = root) + ids <- orderly_search(expr, + name = name, + location = location, + allow_remote = allow_remote, + pull_metadata = pull_metadata, + root = root) } extract <- parse_extract(extract, environment()) diff --git a/R/prune.R b/R/prune.R index 21536d5d..1ab05b06 100644 --- a/R/prune.R +++ b/R/prune.R @@ -29,7 +29,7 @@ orderly_prune_orphans <- function(root = NULL) { return(invisible(id)) } - idx <- new_query_index(root, orderly_search_options(location = local)) + idx <- new_query_index(root, build_search_options(location = local)) is_used <- lengths(lapply(id, idx$get_packet_uses, Inf)) > 0 if (any(is_used)) { cli::cli_alert_info( diff --git a/R/query.R b/R/query.R index 1be14753..7cba8dee 100644 --- a/R/query.R +++ b/R/query.R @@ -49,9 +49,10 @@ orderly_query <- function(expr, name = NULL, scope = NULL, subquery = NULL) { } -dots_is_literal_id <- function(...) { - ...length() == 1 && is.null(...names()) && is.character(..1) && - all(grepl(re_id, ..1)) +expr_is_literal_id <- function(expr, ...) { + all(vlapply(list(...), is.null)) && + is.character(expr) && + all(grepl(re_id, expr)) } diff --git a/R/query_explain.R b/R/query_explain.R index 9dff38ba..8c20d02b 100644 --- a/R/query_explain.R +++ b/R/query_explain.R @@ -6,6 +6,7 @@ ##' @title Explain a query ##' ##' @inheritParams orderly_search +##' @inheritParams orderly_search_options ##' ##' @return An object of class `orderly_query_explain`, which can be ##' inspected (contents subject to change) and which has a print @@ -16,12 +17,16 @@ orderly_query_explain <- function(expr, name = NULL, scope = NULL, subquery = NULL, parameters = NULL, envir = parent.frame(), - options = NULL, root = NULL) { + location = NULL, + allow_remote = NULL, + root = NULL) { root <- root_open(root, require_orderly = FALSE) query <- as_orderly_query(expr, name, scope, subquery) - options <- as_orderly_search_options(options) found <- orderly_search(query, parameters = parameters, envir = envir, - options = options, root = root) + location = location, + allow_remote = allow_remote, + pull_metadata = FALSE, + root = root) query_simplified <- query_simplify(query) ret <- list(found = found, n = length(stats::na.omit(found)), # latest() returns NA @@ -30,8 +35,13 @@ orderly_query_explain <- function(expr, name = NULL, scope = NULL, for (name in names(query_simplified$parts)) { expr <- query_simplified$parts[[name]] - found <- orderly_search(expr, parameters = parameters, envir = envir, - options = options, root = root) + found <- orderly_search(expr, + parameters = parameters, + envir = envir, + location = location, + allow_remote = allow_remote, + pull_metadata = FALSE, + root = root) ret$parts[[name]] <- list( name = name, str = deparse_query(expr, NULL, NULL), diff --git a/R/query_search.R b/R/query_search.R index 809c5c79..3312810b 100644 --- a/R/query_search.R +++ b/R/query_search.R @@ -15,13 +15,13 @@ ##' use the calling environment, but you can explicitly pass this in ##' if you want to control where this lookup happens. ##' -##' @param options Optionally, a [orderly2::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., `orderly2::orderly_search_options()`) -##' ##' @inheritParams orderly_metadata ##' @inheritParams orderly_query +##' @inheritParams orderly_search_options +##' +##' @param options **DEPRECATED**. Please don't use this any more, and +##' instead use the arguments `location`, `allow_remote` and +##' `pull_metadata` directly. ##' ##' @return A character vector of matching ids. In the case of no ##' match from a query returning a single value (e.g., `latest(...)` @@ -31,10 +31,15 @@ ##' @export orderly_search <- function(expr, name = NULL, scope = NULL, subquery = NULL, parameters = NULL, envir = parent.frame(), - options = NULL, root = NULL) { + location = NULL, allow_remote = NULL, + pull_metadata = FALSE, options = NULL, + root = NULL) { root <- root_open(root, require_orderly = FALSE) + compatibility_fix_options(options, "orderly_search") query <- as_orderly_query(expr, name, scope, subquery) - options <- as_orderly_search_options(options) + options <- build_search_options(location = location, + allow_remote = allow_remote, + pull_metadata = pull_metadata) validate_parameters(parameters, environment()) orderly_query_eval(query, parameters, envir, options, root, call = environment()) @@ -77,19 +82,47 @@ orderly_search <- function(expr, name = NULL, scope = NULL, subquery = NULL, orderly_search_options <- function(location = NULL, allow_remote = NULL, pull_metadata = FALSE) { - ## TODO: Later, we might allow something like "before" here too to - ## control searching against some previous time on a location. + cli::cli_warn( + c("Use of 'orderly_search_options' is deprecated", + i = paste("You should just pass these arguments directly into functions", + "that previously accepted 'options'")), + .frequency = "regularly", + .frequency_id = "orderly_search_options") + build_search_options(location, allow_remote, pull_metadata) +} + + +compatibility_fix_options <- function(options, name, + arg = deparse(substitute(options)), + env = parent.frame()) { + if (!is.null(options)) { + cli::cli_warn( + c("Use of '{arg}' in '{name}()' is deprecated and will be removed soon", + i = paste("Please pass the arguments to options ('location',", + "'allow_remote' and 'pull_metadata') directly to '{name}'"), + "!" = paste("If you have {.strong also} passed these options in", + "to your function I am about to silently overwrite them")), + .frequency = "regularly", + .frequency_id = paste0("orderly_use_options:", name), + call = env) + list2env(options, env) + } +} + + +build_search_options <- function(location = NULL, allow_remote = NULL, + pull_metadata = FALSE, call = parent.frame()) { if (!is.null(location)) { - assert_character(location) + assert_character(location, call = call) } has_remote_location <- !is.null(location) && length(setdiff(location, c("local", "orphan")) > 0) - assert_scalar_logical(pull_metadata) + assert_scalar_logical(pull_metadata, call = call) if (is.null(allow_remote)) { allow_remote <- has_remote_location || pull_metadata } else { - assert_scalar_logical(allow_remote) + assert_scalar_logical(allow_remote, call = call) } ret <- list(location = location, allow_remote = allow_remote, @@ -99,41 +132,6 @@ orderly_search_options <- function(location = NULL, } -as_orderly_search_options <- function(x, defaults = list(), - name = deparse(substitute(x))) { - if (!is.name(name)) { - name <- "options" - } - if (inherits(x, "orderly_search_options")) { - return(x) - } - if (is.null(x)) { - if (length(defaults) == 0) { - return(orderly_search_options()) - } - x <- list() - } - if (!is.list(x)) { - stop(sprintf( - "Expected '%s' to be an 'orderly_search_options' or a list of options", - name), - call. = FALSE) - } - err <- setdiff(names(x), names(formals(orderly_search_options))) - if (length(err) > 0) { - stop(sprintf("Invalid option passed to 'orderly_search_options': %s", - paste(squote(err), collapse = ", ")), - call. = FALSE) - } - for (i in names(defaults)) { - if (is.null(x[[i]])) { - x[[i]] <- defaults[[i]] - } - } - do.call(orderly_search_options, x) -} - - orderly_query_eval <- function(query, parameters, envir, options, root, call = NULL) { assert_is(query, "orderly_query", call = call) diff --git a/R/root.R b/R/root.R index d90be649..8e5c589a 100644 --- a/R/root.R +++ b/R/root.R @@ -82,7 +82,8 @@ orderly_init <- function(root = ".", ".vscode", ".Rhistory", ".RData", "*.Rproj", ".Rproj.user") contents <- dir(root, all.files = TRUE, no.. = TRUE) - m <- vapply(glob2rx(allowed), grepl, logical(length(contents)), contents) + m <- vapply(utils::glob2rx(allowed), grepl, logical(length(contents)), + contents) if (!is.matrix(m)) { # exactly one file to compare m <- rbind(m) } diff --git a/R/run.R b/R/run.R index 3bf15c40..b7af6c81 100644 --- a/R/run.R +++ b/R/run.R @@ -24,12 +24,10 @@ ##' network connection (but *not* pulling in the packets could mean ##' that your packet fails to run). ##' -##' To allow for control over this you can pass in an argument -##' `search_options`, which is a [orderly2::orderly_search_options] -##' object, and allows control over the names of the locations to -##' use, whether metadata should be refreshed before we pull -##' anything and if packets that are not currently downloaded should -##' be considered candidates. +##' To allow for control over this you can pass in an arguments to +##' control the names of the locations to use, whether metadata +##' should be refreshed before we pull anything and if packets that +##' are not currently downloaded should be considered candidates. ##' ##' This has no effect when running interactively, in which case you ##' can specify the search options (root specific) with @@ -37,19 +35,18 @@ ##' ##' @section Which packets might be selected from locations?: ##' -##' The `search_options` argument controls where outpack searches for -##' packets with the given query and if anything might be moved over -##' the network (or from one outpack archive to another). By default -##' everything is resolved locally only; that is we can only depend -##' on packets that are unpacked within our current archive. If you -##' pass a `search_options` argument that contains `allow_remote = -##' TRUE` (see [orderly2::orderly_search_options] then packets -##' that are known anywhere are candidates for using as dependencies -##' and *if needed* we will pull the resolved files from a remote -##' location. Note that even if the packet is not locally present -##' this might not be needed - if you have the same content anywhere -##' else in an unpacked packet we will reuse the same content -##' without re-fetching. +##' The arguments `location`, `allow_remote` and `pull_metadata` +##' control where outpack searches for packets with the given query +##' and if anything might be moved over the network (or from one +##' outpack archive to another). By default everything is resolved +##' locally only; that is we can only depend on packets that are +##' unpacked within our current archive. If you pass `allow_remote +##' = TRUE`, then packets that are known anywhere are candidates for +##' using as dependencies and *if needed* we will pull the resolved +##' files from a remote location. Note that even if the packet is +##' not locally present this might not be needed - if you have the +##' same content anywhere else in an unpacked packet we will reuse +##' the same content without re-fetching. ##' ##' If `pull_metadata = TRUE`, then we will refresh location metadata ##' before pulling, and the `location` argument controls which @@ -58,8 +55,7 @@ ##' @section Equivalence to the old `use_draft` option: ##' ##' The above location handling generalises orderly (v1)'s old -##' `use_draft` option, in terms of the `location` argument to -##' orderly2::orderly_search_options`: +##' `use_draft` option, in terms of the new `location` argument: ##' ##' * `use_draft = TRUE` is `location = "local"` ##' * `use_draft = FALSE` is `location = c(...)` where you should provide @@ -72,7 +68,7 @@ ##' as they currently exist on production right now with the options: ##' ##' ``` -##' location = "production", pull_metadata = TRUE, require_unpacked = FALSE +##' location = "production", pull_metadata = TRUE ##' ``` ##' ##' which updates your current metadata from production, then runs @@ -127,9 +123,11 @@ ##' @param echo Optional logical to control printing output from ##' `source()` to the console. ##' -##' @param search_options Optional control over locations, when used -##' with [orderly2::orderly_dependency]; converted into a -##' [orderly2::orderly_search_options] object, see Details. +##' @inheritParams orderly_search +##' +##' @param search_options **DEPRECATED**. Please don't use this any +##' more, and instead use the arguments `location`, `allow_remote` +##' and `pull_metadata` directly. ##' ##' @param root The path to the root directory, or `NULL` (the ##' default) to search for one from the current working @@ -153,10 +151,13 @@ ##' # and we can query the metadata: ##' orderly2::orderly_metadata_extract(name = "data", root = path) orderly_run <- function(name, parameters = NULL, envir = NULL, echo = TRUE, - search_options = NULL, root = NULL) { + location = NULL, allow_remote = NULL, + pull_metadata = FALSE, search_options = NULL, + root = NULL) { env_root_src <- Sys.getenv("ORDERLY_SRC_ROOT", NA_character_) root <- root_open(root, require_orderly = is.na(env_root_src), call = environment()) + compatibility_fix_options(search_options, "orderly_run") if (is.na(env_root_src)) { root_src <- root$path @@ -175,6 +176,10 @@ orderly_run <- function(name, parameters = NULL, envir = NULL, echo = TRUE, parameters <- check_parameters(parameters, dat$parameters, environment()) orderly_validate(dat, src) + search_options <- build_search_options(location = location, + allow_remote = allow_remote, + pull_metadata = pull_metadata) + id <- outpack_id() path <- file.path(root_src, "draft", name, id) fs::dir_create(path) diff --git a/R/validate.R b/R/validate.R index c1ff459c..3f1aa861 100644 --- a/R/validate.R +++ b/R/validate.R @@ -29,21 +29,19 @@ ##' ##' @title Validate unpacked packets. ##' -##' @param ... Either arguments that a search can be constructed from -##' (useful options here include `name = "something"`), a character -##' vector of ids, or leave empty to validate everything. -##' ##' @param action The action to take on finding an invalid packet. See ##' Details. ##' ##' @inheritParams orderly_metadata +##' @inheritParams orderly_search +##' @inheritParams orderly_search_options ##' ##' @return Invisibly, a character vector of repaired (or invalid) ##' packets. ##' ##' @export -orderly_validate_archive <- function(..., action = "inform", - root = NULL) { +orderly_validate_archive <- function(expr = NULL, name = NULL, + action = "inform", root = NULL) { root <- root_open(root, require_orderly = FALSE) action <- match_value(action, c("inform", "orphan", "delete", "repair"), call = environment()) @@ -52,11 +50,15 @@ orderly_validate_archive <- function(..., action = "inform", cli::cli_abort("You have no archive to validate") } - if (dots_is_literal_id(...)) { - ids <- ..1 + if (expr_is_literal_id(expr, name)) { + ids <- expr } else { - options <- orderly_search_options(location = local) - ids <- orderly_search(..., options = options, root = root) + ids <- orderly_search(expr, + name = name, + location = "local", + allow_remote = FALSE, + pull_metadata = FALSE, + root = root) } cache <- new.env(parent = emptyenv()) diff --git a/man/orderly_copy_files.Rd b/man/orderly_copy_files.Rd index beb7279c..bc8e9abe 100644 --- a/man/orderly_copy_files.Rd +++ b/man/orderly_copy_files.Rd @@ -5,17 +5,22 @@ \title{Copy files from a packet} \usage{ orderly_copy_files( - ..., + expr, files, dest, overwrite = TRUE, - envir = parent.frame(), + name = NULL, + location = NULL, + allow_remote = NULL, + pull_metadata = FALSE, + parameters = NULL, options = NULL, + envir = parent.frame(), 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 +56,43 @@ 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 is \code{NULL}. This is +\code{TRUE} if remote locations are listed explicitly as a character +vector in the \code{location} argument, or if you have specified +\code{pull_metadata = TRUE}, 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{options}{\strong{DEPRECATED}. Please don't use this any more, and +instead use the arguments \code{location}, \code{allow_remote} and +\code{pull_metadata} directly.} + \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/man/orderly_interactive_set_search_options.Rd b/man/orderly_interactive_set_search_options.Rd index 621e4c51..02290ba6 100644 --- a/man/orderly_interactive_set_search_options.Rd +++ b/man/orderly_interactive_set_search_options.Rd @@ -4,12 +4,33 @@ \alias{orderly_interactive_set_search_options} \title{Set search options for interactive use} \usage{ -orderly_interactive_set_search_options(options = NULL) +orderly_interactive_set_search_options( + location = NULL, + allow_remote = NULL, + pull_metadata = FALSE +) } \arguments{ -\item{options}{Optional control over locations, when used -with \link{orderly_dependency}; see of Details section of -\link{orderly_run}.} +\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 is \code{NULL}. This is +\code{TRUE} if remote locations are listed explicitly as a character +vector in the \code{location} argument, or if you have specified +\code{pull_metadata = TRUE}, 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.} } \value{ Nothing, called for its side effects diff --git a/man/orderly_location_pull_packet.Rd b/man/orderly_location_pull_packet.Rd index 00b9448f..cc2a1f18 100644 --- a/man/orderly_location_pull_packet.Rd +++ b/man/orderly_location_pull_packet.Rd @@ -5,26 +5,33 @@ \title{Pull one or more packets from a location} \usage{ orderly_location_pull_packet( - ..., - options = NULL, + expr, + name = NULL, + location = NULL, + pull_metadata = FALSE, recursive = NULL, + options = NULL, root = NULL ) } \arguments{ -\item{...}{Arguments passed through to -\link{orderly_search}. In the special case where the first -argument is a character vector of ids \emph{and} there are no named -dot arguments, then we interpret this argument as a vector of -ids directly. Be careful here, your query may pull a lot of data -\itemize{ -\item in particular, passing \code{NULL} will match everything that every -remote has! -}} +\item{expr}{The query expression. A \code{NULL} expression matches everything.} + +\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{options}{Options passed to \link{orderly_search}. -The option \code{allow_remote} must be \code{TRUE} as otherwise no packet could -possibly be pulled, so an error is thrown if this is FALSE.} +\item{location}{Optional vector of locations to pull from. We +might in future expand this to allow wildcards or exceptions.} + +\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{recursive}{If non-NULL, a logical, indicating if we should recursively pull all packets that are referenced by the packets @@ -32,6 +39,10 @@ specified in \code{id}. This might copy a lot of data! If \code{NULL}, we default to the value given by the the configuration option \code{require_complete_tree}.} +\item{options}{\strong{DEPRECATED}. Please don't use this any more, and +instead use the arguments \code{location}, \code{allow_remote} and +\code{pull_metadata} directly.} + \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/man/orderly_metadata_extract.Rd b/man/orderly_metadata_extract.Rd index 31f9f8ca..0d7dbed1 100644 --- a/man/orderly_metadata_extract.Rd +++ b/man/orderly_metadata_extract.Rd @@ -4,18 +4,52 @@ \alias{orderly_metadata_extract} \title{Extract metadata from orderly2 packets} \usage{ -orderly_metadata_extract(..., extract = NULL, root = NULL) +orderly_metadata_extract( + expr = NULL, + name = NULL, + location = NULL, + allow_remote = NULL, + pull_metadata = FALSE, + extract = NULL, + options = NULL, + root = NULL +) } \arguments{ -\item{...}{Arguments passed through to -\link{orderly_search}. In the special case where the first -argument is a character vector of ids \emph{and} there are no named -dot arguments, then we interpret this argument as a vector of -ids directly.} +\item{expr}{The query expression. A \code{NULL} expression matches everything.} + +\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 is \code{NULL}. This is +\code{TRUE} if remote locations are listed explicitly as a character +vector in the \code{location} argument, or if you have specified +\code{pull_metadata = TRUE}, 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{extract}{A character vector of columns to extract, possibly named. See Details for the format.} +\item{options}{\strong{DEPRECATED}. Please don't use this any more, and +instead use the arguments \code{location}, \code{allow_remote} and +\code{pull_metadata} directly.} + \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/man/orderly_query_explain.Rd b/man/orderly_query_explain.Rd index f75161fc..a1fb9a7b 100644 --- a/man/orderly_query_explain.Rd +++ b/man/orderly_query_explain.Rd @@ -11,7 +11,8 @@ orderly_query_explain( subquery = NULL, parameters = NULL, envir = parent.frame(), - options = NULL, + location = NULL, + allow_remote = NULL, root = NULL ) } @@ -36,10 +37,17 @@ 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{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 is \code{NULL}. This is +\code{TRUE} if remote locations are listed explicitly as a character +vector in the \code{location} argument, or if you have specified +\code{pull_metadata = TRUE}, otherwise \code{FALSE}.} \item{root}{The path to the root directory, or \code{NULL} (the default) to search for one from the current working diff --git a/man/orderly_run.Rd b/man/orderly_run.Rd index deec4b08..5173ee82 100644 --- a/man/orderly_run.Rd +++ b/man/orderly_run.Rd @@ -9,6 +9,9 @@ orderly_run( parameters = NULL, envir = NULL, echo = TRUE, + location = NULL, + allow_remote = NULL, + pull_metadata = FALSE, search_options = NULL, root = NULL ) @@ -29,9 +32,30 @@ may not always be what is wanted.} \item{echo}{Optional logical to control printing output from \code{source()} to the console.} -\item{search_options}{Optional control over locations, when used -with \link{orderly_dependency}; converted into a -\link{orderly_search_options} object, see Details.} +\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 is \code{NULL}. This is +\code{TRUE} if remote locations are listed explicitly as a character +vector in the \code{location} argument, or if you have specified +\code{pull_metadata = TRUE}, 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{search_options}{\strong{DEPRECATED}. Please don't use this any +more, and instead use the arguments \code{location}, \code{allow_remote} +and \code{pull_metadata} directly.} \item{root}{The path to the root directory, or \code{NULL} (the default) to search for one from the current working @@ -70,12 +94,10 @@ seconds to hours depending on their size and the speed of your network connection (but \emph{not} pulling in the packets could mean that your packet fails to run). -To allow for control over this you can pass in an argument -\code{search_options}, which is a \link{orderly_search_options} -object, and allows control over the names of the locations to -use, whether metadata should be refreshed before we pull -anything and if packets that are not currently downloaded should -be considered candidates. +To allow for control over this you can pass in an arguments to +control the names of the locations to use, whether metadata +should be refreshed before we pull anything and if packets that +are not currently downloaded should be considered candidates. This has no effect when running interactively, in which case you can specify the search options (root specific) with @@ -85,18 +107,17 @@ can specify the search options (root specific) with \section{Which packets might be selected from locations?}{ -The \code{search_options} argument controls where outpack searches for -packets with the given query and if anything might be moved over -the network (or from one outpack archive to another). By default -everything is resolved locally only; that is we can only depend -on packets that are unpacked within our current archive. If you -pass a \code{search_options} argument that contains \code{allow_remote = TRUE} (see \link{orderly_search_options} then packets -that are known anywhere are candidates for using as dependencies -and \emph{if needed} we will pull the resolved files from a remote -location. Note that even if the packet is not locally present -this might not be needed - if you have the same content anywhere -else in an unpacked packet we will reuse the same content -without re-fetching. +The arguments \code{location}, \code{allow_remote} and \code{pull_metadata} +control where outpack searches for packets with the given query +and if anything might be moved over the network (or from one +outpack archive to another). By default everything is resolved +locally only; that is we can only depend on packets that are +unpacked within our current archive. If you pass \code{allow_remote = TRUE}, then packets that are known anywhere are candidates for +using as dependencies and \emph{if needed} we will pull the resolved +files from a remote location. Note that even if the packet is +not locally present this might not be needed - if you have the +same content anywhere else in an unpacked packet we will reuse +the same content without re-fetching. If \code{pull_metadata = TRUE}, then we will refresh location metadata before pulling, and the \code{location} argument controls which @@ -107,8 +128,7 @@ locations are pulled from. The above location handling generalises orderly (v1)'s old -\code{use_draft} option, in terms of the \code{location} argument to -orderly2::orderly_search_options`: +\code{use_draft} option, in terms of the new \code{location} argument: \itemize{ \item \code{use_draft = TRUE} is \code{location = "local"} \item \code{use_draft = FALSE} is \code{location = c(...)} where you should provide @@ -121,7 +141,7 @@ all locations \emph{except} local default behaviour). In addition, you could resolve dependencies as they currently exist on production right now with the options: -\if{html}{\out{