diff --git a/DESCRIPTION b/DESCRIPTION index 1ec6e3ff..1cdd8d07 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: orderly2 Title: Orderly Next Generation -Version: 1.99.42 +Version: 1.99.43 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), person("Robert", "Ashton", role = "aut"), diff --git a/R/cleanup.R b/R/cleanup.R index 932d49b2..41026a37 100644 --- a/R/cleanup.R +++ b/R/cleanup.R @@ -65,9 +65,8 @@ ##' ##' # Do the actual deletion: ##' orderly2::orderly_cleanup("data", root = path) -orderly_cleanup <- function(name = NULL, dry_run = FALSE, root = NULL, - locate = TRUE) { - status <- orderly_cleanup_status(name, root, locate) +orderly_cleanup <- function(name = NULL, dry_run = FALSE, root = NULL) { + status <- orderly_cleanup_status(name, root) n <- length(status$delete) if (n == 0) { cli::cli_alert_success("Nothing to clean") @@ -93,7 +92,7 @@ orderly_cleanup <- function(name = NULL, dry_run = FALSE, root = NULL, ##' @export ##' @rdname orderly_cleanup -orderly_cleanup_status <- function(name = NULL, root = NULL, locate = TRUE) { +orderly_cleanup_status <- function(name = NULL, root = NULL) { p <- get_active_packet() is_active <- !is.null(p) if (is_active) { @@ -107,7 +106,7 @@ orderly_cleanup_status <- function(name = NULL, root = NULL, locate = TRUE) { root_path <- detect_orderly_interactive_path(path) name <- basename(path) } else { - root_path <- orderly_src_root(root, locate, call = environment()) + root_path <- orderly_src_root(root) if (is.null(name)) { ## This situation would be very odd, just disallow it cli::cli_abort("If 'root' is given explicitly, 'name' is required") diff --git a/R/context.R b/R/context.R index 77d49eb2..7ff98532 100644 --- a/R/context.R +++ b/R/context.R @@ -62,7 +62,7 @@ orderly_run_info <- function() { id <- ctx$packet$id %||% NA_character_ name <- ctx$name - root <- root_open(ctx$root, FALSE, TRUE, environment()) + root <- root_open(ctx$root, require_orderly = TRUE) deps <- ctx$packet$depends deps_n <- vnapply(deps, function(x) nrow(x$files)) diff --git a/R/gitignore.R b/R/gitignore.R index 0e5c3175..e6a46035 100644 --- a/R/gitignore.R +++ b/R/gitignore.R @@ -33,8 +33,8 @@ ##' ##' @return Nothing, called for its side effects ##' @export -orderly_gitignore_update <- function(name, root = NULL, locate = TRUE) { - root_path <- orderly_src_root(root, locate, call = environment()) +orderly_gitignore_update <- function(name, root = NULL) { + root_path <- orderly_src_root(root) do_orderly_gitignore_update(name, root_path, environment()) } diff --git a/R/graph.R b/R/graph.R index fa9b4fe7..06ade48f 100644 --- a/R/graph.R +++ b/R/graph.R @@ -1,7 +1,5 @@ -orderly_graph_packets <- function(from = NULL, to = NULL, - root = NULL, locate = FALSE) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) +orderly_graph_packets <- function(from = NULL, to = NULL, root = NULL) { + root <- root_open(root, require_orderly = FALSE) if (is.null(from) == is.null(to)) { cli::cli_abort("Exactly one of 'from' and 'to' must be given") } diff --git a/R/location.R b/R/location.R index c728e269..af93b619 100644 --- a/R/location.R +++ b/R/location.R @@ -79,9 +79,8 @@ ##' ##' @return Nothing ##' @export -orderly_location_add <- function(name, type, args, root = NULL, locate = TRUE) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) +orderly_location_add <- function(name, type, args, root = NULL) { + root <- root_open(root, require_orderly = FALSE) assert_scalar_character(name, call = environment()) if (name %in% location_reserved_name) { @@ -95,7 +94,7 @@ orderly_location_add <- function(name, type, args, root = NULL, locate = TRUE) { loc <- new_location_entry(name, type, args, call = environment()) if (type == "path") { assert_scalar_character(args$path, name = "path") - root_open(args$path, locate = FALSE, require_orderly = FALSE) + root_open(args$path, require_orderly = FALSE) } else if (type == "http") { assert_scalar_character(args$url, name = "url") } else if (type == "packit") { @@ -174,9 +173,8 @@ orderly_location_add_packit <- function(name, url, token = NULL, ##' ##' @return Nothing ##' @export -orderly_location_rename <- function(old, new, root = NULL, locate = TRUE) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) +orderly_location_rename <- function(old, new, root = NULL) { + root <- root_open(root, require_orderly = FALSE) assert_scalar_character(new, call = call) if (old %in% location_reserved_name) { @@ -205,9 +203,8 @@ orderly_location_rename <- function(old, new, root = NULL, locate = TRUE) { ##' ##' @return Nothing ##' @export -orderly_location_remove <- function(name, root = NULL, locate = TRUE) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) +orderly_location_remove <- function(name, root = NULL) { + root <- root_open(root, require_orderly = FALSE) if (name %in% location_reserved_name) { cli::cli_abort("Cannot remove default location '{name}'") @@ -261,9 +258,8 @@ orderly_location_remove <- function(name, root = NULL, locate = TRUE) { ##' locations listed here. ##' ##' @export -orderly_location_list <- function(verbose = FALSE, root = NULL, locate = TRUE) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) +orderly_location_list <- function(verbose = FALSE, root = NULL) { + root <- root_open(root, require_orderly = FALSE) if (verbose) { root$config$location } else { @@ -289,10 +285,8 @@ orderly_location_list <- function(verbose = FALSE, root = NULL, locate = TRUE) { ##' @return Nothing ##' ##' @export -orderly_location_pull_metadata <- function(location = NULL, root = NULL, - locate = TRUE) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) +orderly_location_pull_metadata <- function(location = NULL, root = NULL) { + root <- root_open(root, require_orderly = FALSE) location_name <- location_resolve_valid(location, root, include_local = FALSE, include_orphan = FALSE, @@ -352,9 +346,8 @@ orderly_location_pull_metadata <- function(location = NULL, root = NULL, ##' @return Invisibly, the ids of packets that were pulled ##' @export orderly_location_pull_packet <- function(..., options = NULL, recursive = NULL, - root = NULL, locate = TRUE) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) + 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( @@ -449,10 +442,8 @@ orderly_location_pull_packet <- function(..., options = NULL, recursive = NULL, ##' known on the other location). ##' ##' @export -orderly_location_push <- function(packet_id, location, root = NULL, - locate = TRUE) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) +orderly_location_push <- function(packet_id, location, root = NULL) { + root <- root_open(root, require_orderly = FALSE) location_name <- location_resolve_valid(location, root, include_local = FALSE, include_orphan = FALSE, diff --git a/R/location_path.R b/R/location_path.R index d548ebdf..3cb7ea30 100644 --- a/R/location_path.R +++ b/R/location_path.R @@ -7,7 +7,7 @@ orderly_location_path <- R6::R6Class( public = list( initialize = function(path) { - private$root <- root_open(path, locate = FALSE, require_orderly = FALSE) + private$root <- root_open(path, require_orderly = FALSE) }, list = function() { diff --git a/R/orderly.R b/R/orderly.R index 3d436168..67058364 100644 --- a/R/orderly.R +++ b/R/orderly.R @@ -17,8 +17,8 @@ ##' @examples ##' path <- orderly2::orderly_example("default") ##' orderly2::orderly_list_src(root = path) -orderly_list_src <- function(root = NULL, locate = TRUE) { - root_path <- orderly_src_root(root, locate) +orderly_list_src <- function(root = NULL) { + root_path <- orderly_src_root(root) if (!file.exists(file.path(root_path, "src"))) { return(character()) } @@ -51,9 +51,8 @@ orderly_list_src <- function(root = NULL, locate = TRUE) { ##' ##' @return Nothing, called for its side effects only ##' @export -orderly_new <- function(name, template = NULL, force = FALSE, - root = NULL, locate = TRUE) { - root <- root_open(root, locate, require_orderly = TRUE, call = environment()) +orderly_new <- function(name, template = NULL, force = FALSE, root = NULL) { + root <- root_open(root, require_orderly = TRUE) dest <- file.path(root$path, "src", name) existing_entrypoint_filename <- find_entrypoint_filename( dest, suppress_zero_files = TRUE diff --git a/R/outpack_checksum.R b/R/outpack_checksum.R index b213e35a..8c6b8f0b 100644 --- a/R/outpack_checksum.R +++ b/R/outpack_checksum.R @@ -2,7 +2,7 @@ ## present. It might have been intended for the R-backed server, now ## defunct? outpack_checksum <- function(hash_algorithm = NULL, root = NULL) { - root <- root_open(root, locate = TRUE, require_orderly = FALSE) + root <- root_open(root, require_orderly = FALSE) hash_algorithm <- hash_algorithm %||% root$config$core$hash_algorithm ## Don't use the index ever here; we want to always read this from diff --git a/R/outpack_config.R b/R/outpack_config.R index 90f783d5..e700441c 100644 --- a/R/outpack_config.R +++ b/R/outpack_config.R @@ -39,10 +39,8 @@ ##' core.path_archive = NULL, ##' root = path) ##' fs::dir_tree(path, all = TRUE) -orderly_config_set <- function(..., options = list(...), root = NULL, - locate = TRUE) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) +orderly_config_set <- function(..., options = list(...), root = NULL) { + root <- root_open(root, require_orderly = FALSE) if (!missing(options) && ...length() > 0) { stop("If 'options' is given, no dot arguments are allowed") } @@ -111,9 +109,8 @@ orderly_config_set <- function(..., options = list(...), root = NULL, ##' path <- withr::local_tempdir() ##' orderly2::orderly_init(path) ##' orderly2::orderly_config(path) -orderly_config <- function(root = NULL, locate = TRUE) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) +orderly_config <- function(root = NULL) { + root <- root_open(root, require_orderly = FALSE) root$config } diff --git a/R/outpack_hash.R b/R/outpack_hash.R index 438a2363..f5c0fb24 100644 --- a/R/outpack_hash.R +++ b/R/outpack_hash.R @@ -21,11 +21,9 @@ ##' @export ##' @examples ##' orderly2::orderly_hash_data("hello", "md5") -orderly_hash_file <- function(path, algorithm = NULL, root = NULL, - locate = TRUE) { +orderly_hash_file <- function(path, algorithm = NULL, root = NULL) { if (is.null(algorithm)) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) + root <- root_open(root, require_orderly = FALSE) algorithm <- root$config$core$hash_algorithm } hash_file(path, algorithm, call = environment()) @@ -35,11 +33,9 @@ orderly_hash_file <- function(path, algorithm = NULL, root = NULL, ##' @param data A string to hash ##' @export ##' @rdname orderly_hash -orderly_hash_data <- function(data, algorithm = NULL, root = NULL, - locate = TRUE) { +orderly_hash_data <- function(data, algorithm = NULL, root = NULL) { if (is.null(algorithm)) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) + root <- root_open(root, require_orderly = FALSE) algorithm <- root$config$core$hash_algorithm } hash_data(data, algorithm, call = call) diff --git a/R/outpack_helpers.R b/R/outpack_helpers.R index 167c8da9..99f3cf65 100644 --- a/R/outpack_helpers.R +++ b/R/outpack_helpers.R @@ -81,9 +81,8 @@ ##' @export orderly_copy_files <- function(..., files, dest, overwrite = TRUE, envir = parent.frame(), options = NULL, - root = NULL, locate = TRUE) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) + root = NULL) { + root <- root_open(root, require_orderly = FALSE) ## Validate files and dest early; it gives a better error where this ## was not provided with names. diff --git a/R/outpack_metadata.R b/R/outpack_metadata.R index 5666f440..8ae6f0b4 100644 --- a/R/outpack_metadata.R +++ b/R/outpack_metadata.R @@ -8,25 +8,18 @@ ##' this id is not known ##' ##' @param root The path to the root directory, or `NULL` (the -##' default) to search for one from the current working directory if -##' `locate` is `TRUE`. This function does not require that the -##' directory is configured for orderly, and can be any `outpack` -##' root (see [orderly2::orderly_init] for details). -##' -##' @param locate Logical, indicating if the root should be searched -##' for. If `TRUE`, then we looks in the directory given for `root` -##' (or the working directory if `NULL`) and then up through its -##' parents until it finds an `.outpack` directory or -##' `orderly_config.yml` +##' default) to search for one from the current working +##' directory. This function does not require that the directory is +##' configured for orderly, and can be any `outpack` root (see +##' [orderly2::orderly_init] for details). ##' ##' @return A list of metadata. See the outpack schema for details ##' (https://github.com/mrc-ide/outpack) ##' ##' @export -orderly_metadata <- function(id, root = NULL, locate = FALSE) { +orderly_metadata <- function(id, root = NULL) { validate_outpack_id(id, call = environment()) - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) + root <- root_open(root, require_orderly = FALSE) path_metadata <- file.path(root$path, ".outpack", "metadata", id) if (!file.exists(path_metadata)) { cli::cli_abort("Packet '{id}' not found in outpack index") diff --git a/R/outpack_packet.R b/R/outpack_packet.R index 31fe8f2c..986644f0 100644 --- a/R/outpack_packet.R +++ b/R/outpack_packet.R @@ -23,7 +23,7 @@ ##' @noRd outpack_packet_start <- function(path, name, parameters = NULL, id = NULL, root = NULL) { - root <- root_open(root, locate = FALSE, require_orderly = FALSE) + root <- root_open(root, require_orderly = FALSE) assert_scalar_character(name) assert_is_directory(path) diff --git a/R/outpack_tools.R b/R/outpack_tools.R index 1fe3dccb..7a2ae3f1 100644 --- a/R/outpack_tools.R +++ b/R/outpack_tools.R @@ -197,10 +197,8 @@ ##' names of `extract`; see Details for more information. ##' ##' @export -orderly_metadata_extract <- function(..., extract = NULL, root = NULL, - locate = TRUE) { - root <- root_open(root, locate = locate, require_orderly = FALSE, - call = environment()) +orderly_metadata_extract <- function(..., extract = NULL, root = NULL) { + root <- root_open(root, require_orderly = FALSE) if (dots_is_literal_id(...)) { ids <- ..1 } else { diff --git a/R/prune.R b/R/prune.R index 8b11343e..21536d5d 100644 --- a/R/prune.R +++ b/R/prune.R @@ -22,8 +22,8 @@ ##' ##' @return Invisibly, a character vector of orphaned packet ids ##' @export -orderly_prune_orphans <- function(root = NULL, locate = TRUE) { - root <- root_open(root, locate = TRUE, require_orderly = FALSE) +orderly_prune_orphans <- function(root = NULL) { + root <- root_open(root, require_orderly = FALSE) id <- root$index$location("orphan")$packet if (length(id) == 0) { return(invisible(id)) diff --git a/R/query_explain.R b/R/query_explain.R index dead25fc..38bf3967 100644 --- a/R/query_explain.R +++ b/R/query_explain.R @@ -16,7 +16,7 @@ orderly_query_explain <- function(..., parameters = NULL, envir = parent.frame(), options = NULL, root = NULL) { - root <- root_open(root, locate = TRUE, require_orderly = FALSE) + root <- root_open(root, require_orderly = FALSE) query <- as_orderly_query(...) options <- as_orderly_search_options(options) found <- orderly_search(query, parameters = parameters, envir = envir, diff --git a/R/query_index.R b/R/query_index.R index 3dae3a65..efc0dca2 100644 --- a/R/query_index.R +++ b/R/query_index.R @@ -84,7 +84,7 @@ query_index <- R6::R6Class( ## help with the pulling metadata issue (as we could then control only ## pulling once in a session). new_query_index <- function(root, options) { - root <- root_open(root, locate = FALSE, require_orderly = FALSE) + root <- root_open(root, require_orderly = FALSE) if (options$pull_metadata) { orderly_location_pull_metadata(options$location, root) diff --git a/R/query_search.R b/R/query_search.R index 4c29f0bb..d9f1d03e 100644 --- a/R/query_search.R +++ b/R/query_search.R @@ -33,7 +33,7 @@ ##' @export orderly_search <- function(..., parameters = NULL, envir = parent.frame(), options = NULL, root = NULL) { - root <- root_open(root, locate = TRUE, require_orderly = FALSE) + root <- root_open(root, require_orderly = FALSE) query <- as_orderly_query(...) options <- as_orderly_search_options(options) validate_parameters(parameters, environment()) diff --git a/R/root.R b/R/root.R index 6c55902f..b5d2b36f 100644 --- a/R/root.R +++ b/R/root.R @@ -101,7 +101,7 @@ orderly_init <- function(root = ".", path_outpack <- file.path(root, ".outpack") if (file.exists(path_outpack)) { - root <- root_open(root, locate = FALSE, require_orderly = FALSE) + root <- root_open(root, require_orderly = FALSE) root_validate_same_configuration(match.call(), config, root, environment()) } else { fs::dir_create(path_outpack) @@ -117,8 +117,7 @@ orderly_init <- function(root = ".", file.path(root$path, "orderly_config.yml")) } - root <- root_open(root, locate = FALSE, require_orderly = TRUE, - call = environment()) + root <- root_open(root, require_orderly = TRUE) invisible(root$path) } @@ -140,24 +139,17 @@ empty_config_contents <- function() { ## * also check that the outpack and orderly path are compatibible ## (this is actually quite hard to get right, but should be done ## before anything is created I think) -root_open <- function(path, locate, require_orderly = FALSE, call = NULL) { - if (is.null(call)) { - call <- environment() - } +root_open <- function(path, require_orderly, call = parent.frame()) { if (inherits(path, "outpack_root")) { if (!require_orderly || !is.null(path$config$orderly)) { return(path) } ## This is going to error, but the error later will do. path <- path$path - locate <- FALSE - } - if (is.null(path)) { - path <- getwd() } - assert_scalar_character(path) - assert_is_directory(path) + locate <- is.null(path) if (locate) { + path <- getwd() path_outpack <- find_file_descend(".outpack", path) path_orderly <- find_file_descend("orderly_config.yml", path) has_outpack <- !is.null(path_outpack) @@ -174,10 +166,13 @@ root_open <- function(path, locate, require_orderly = FALSE, call = NULL) { i = "{names(order)[[2]]} was found at '{order[[2]]}'", x = paste("{names(order)[[2]]} is nested within {names(order)[[1]]}", "at {fs::path_rel(order[[2]], order[[1]])}"), - i = "How did you even do this? Please let us know!")) + i = "How did you even do this? Please let us know!"), + call = call) } path_open <- path_outpack } else { + assert_scalar_character(path, call = call) + assert_is_directory(path, call = call) has_outpack <- file.exists(file.path(path, ".outpack")) has_orderly <- file.exists(file.path(path, "orderly_config.yml")) path_open <- path @@ -211,7 +206,8 @@ root_open <- function(path, locate, require_orderly = FALSE, call = NULL) { "outpack root, but does not contain 'orderly_config.yml' so", "cannot be used as an orderly root"), i = 'Please run orderly2::orderly_init("{path}") to initialise', - i = "See ?orderly_init for more arguments to this function")) + i = "See ?orderly_init for more arguments to this function"), + call = call) } root_check_git(root, call) @@ -220,7 +216,7 @@ root_open <- function(path, locate, require_orderly = FALSE, call = NULL) { } -orderly_src_root <- function(path, locate, call = NULL) { +orderly_src_root <- function(path, locate = TRUE, call = parent.frame()) { if (inherits(path, "outpack_root")) { path <- path$path locate <- FALSE diff --git a/R/run.R b/R/run.R index 5614f5d6..3bf15c40 100644 --- a/R/run.R +++ b/R/run.R @@ -132,16 +132,11 @@ ##' [orderly2::orderly_search_options] object, see Details. ##' ##' @param root The path to the root directory, or `NULL` (the -##' default) to search for one from the current working directory if -##' `locate` is `TRUE`. This function **does** require that the -##' directory is configured for orderly, and not just outpack (see +##' default) to search for one from the current working +##' directory. This function **does** require that the directory is +##' configured for orderly, and not just outpack (see ##' [orderly2::orderly_init] for details). ##' -##' @param locate Logical, indicating if the configuration should be -##' searched for. If `TRUE` and `config` is not given, -##' then orderly looks in the working directory and up through its -##' parents until it finds an `.outpack` directory -##' ##' @return The id of the created report (a string) ##' ##' @export @@ -158,15 +153,15 @@ ##' # 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, locate = TRUE) { + search_options = NULL, root = NULL) { env_root_src <- Sys.getenv("ORDERLY_SRC_ROOT", NA_character_) - root <- root_open(root, locate, require_orderly = is.na(env_root_src), + root <- root_open(root, require_orderly = is.na(env_root_src), call = environment()) if (is.na(env_root_src)) { root_src <- root$path } else { - root_src <- orderly_src_root(env_root_src, locate, call = environment()) + root_src <- orderly_src_root(env_root_src) } name <- validate_orderly_directory(name, root_src, environment()) @@ -544,7 +539,7 @@ validate_orderly_directory <- function(name, root_path, call) { sprintf("Did not find orderly report '%s'", name), x = detail ) - near <- near_match(name, orderly_list_src(root_path, FALSE)) + near <- near_match(name, orderly_list_src(root_path)) if (length(near) > 0) { hint <- sprintf("Did you mean %s", paste(squote(near), collapse = ", ")) diff --git a/R/validate.R b/R/validate.R index c675e324..c1ff459c 100644 --- a/R/validate.R +++ b/R/validate.R @@ -43,8 +43,8 @@ ##' ##' @export orderly_validate_archive <- function(..., action = "inform", - root = NULL, locate = TRUE) { - root <- root_open(root, locate = TRUE, require_orderly = FALSE) + root = NULL) { + root <- root_open(root, require_orderly = FALSE) action <- match_value(action, c("inform", "orphan", "delete", "repair"), call = environment()) diff --git a/man/orderly_cleanup.Rd b/man/orderly_cleanup.Rd index 60312aa6..b6ebb33a 100644 --- a/man/orderly_cleanup.Rd +++ b/man/orderly_cleanup.Rd @@ -5,9 +5,9 @@ \alias{orderly_cleanup_status} \title{Clean up source directory} \usage{ -orderly_cleanup(name = NULL, dry_run = FALSE, root = NULL, locate = TRUE) +orderly_cleanup(name = NULL, dry_run = FALSE, root = NULL) -orderly_cleanup_status(name = NULL, root = NULL, locate = TRUE) +orderly_cleanup_status(name = NULL, root = NULL) } \arguments{ \item{name}{Name of the report directory to clean (i.e., we look @@ -18,15 +18,10 @@ anything, but instead just print information about what we would do} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function \strong{does} require that the -directory is configured for orderly, and not just outpack (see +default) to search for one from the current working +directory. This function \strong{does} require that the directory is +configured for orderly, and not just outpack (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the configuration should be -searched for. If \code{TRUE} and \code{config} is not given, -then orderly looks in the working directory and up through its -parents until it finds an \code{.outpack} directory} } \value{ An (currently unstable) object of class diff --git a/man/orderly_config.Rd b/man/orderly_config.Rd index 2c7fdc2e..a0c5fbc8 100644 --- a/man/orderly_config.Rd +++ b/man/orderly_config.Rd @@ -4,20 +4,14 @@ \alias{orderly_config} \title{Read configuration} \usage{ -orderly_config(root = NULL, locate = TRUE) +orderly_config(root = NULL) } \arguments{ \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ A list of configuration options: diff --git a/man/orderly_config_set.Rd b/man/orderly_config_set.Rd index 26095a24..24fa53ba 100644 --- a/man/orderly_config_set.Rd +++ b/man/orderly_config_set.Rd @@ -4,7 +4,7 @@ \alias{orderly_config_set} \title{Set configuration options} \usage{ -orderly_config_set(..., options = list(...), root = NULL, locate = TRUE) +orderly_config_set(..., options = list(...), root = NULL) } \arguments{ \item{...}{Named options to set (e.g., pass the argument @@ -14,16 +14,10 @@ orderly_config_set(..., options = list(...), root = NULL, locate = TRUE) named options here (e.g., \code{list(core.require_complete_tree = TRUE)}). This interface is typically easier to program against.} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ Nothing diff --git a/man/orderly_copy_files.Rd b/man/orderly_copy_files.Rd index 8415d195..49254b5a 100644 --- a/man/orderly_copy_files.Rd +++ b/man/orderly_copy_files.Rd @@ -11,8 +11,7 @@ orderly_copy_files( overwrite = TRUE, envir = parent.frame(), options = NULL, - root = NULL, - locate = TRUE + root = NULL ) } \arguments{ @@ -64,16 +63,10 @@ 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 if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ Nothing, invisibly. Primarily called for its side effect diff --git a/man/orderly_gitignore_update.Rd b/man/orderly_gitignore_update.Rd index babf6d08..bf100678 100644 --- a/man/orderly_gitignore_update.Rd +++ b/man/orderly_gitignore_update.Rd @@ -4,22 +4,17 @@ \alias{orderly_gitignore_update} \title{Update a gitignore file} \usage{ -orderly_gitignore_update(name, root = NULL, locate = TRUE) +orderly_gitignore_update(name, root = NULL) } \arguments{ \item{name}{The name of the gitignore file to update, or the string "(root)"} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function \strong{does} require that the -directory is configured for orderly, and not just outpack (see +default) to search for one from the current working +directory. This function \strong{does} require that the directory is +configured for orderly, and not just outpack (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the configuration should be -searched for. If \code{TRUE} and \code{config} is not given, -then orderly looks in the working directory and up through its -parents until it finds an \code{.outpack} directory} } \value{ Nothing, called for its side effects diff --git a/man/orderly_hash.Rd b/man/orderly_hash.Rd index bca58576..e16d232a 100644 --- a/man/orderly_hash.Rd +++ b/man/orderly_hash.Rd @@ -5,9 +5,9 @@ \alias{orderly_hash_data} \title{Compute a hash} \usage{ -orderly_hash_file(path, algorithm = NULL, root = NULL, locate = TRUE) +orderly_hash_file(path, algorithm = NULL, root = NULL) -orderly_hash_data(data, algorithm = NULL, root = NULL, locate = TRUE) +orderly_hash_data(data, algorithm = NULL, root = NULL) } \arguments{ \item{path}{The name of the file to hash} @@ -16,16 +16,10 @@ orderly_hash_data(data, algorithm = NULL, root = NULL, locate = TRUE) in the orderly root.} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} \item{data}{A string to hash} } diff --git a/man/orderly_list_src.Rd b/man/orderly_list_src.Rd index 9ccde3b9..214e0439 100644 --- a/man/orderly_list_src.Rd +++ b/man/orderly_list_src.Rd @@ -4,19 +4,14 @@ \alias{orderly_list_src} \title{List source reports} \usage{ -orderly_list_src(root = NULL, locate = TRUE) +orderly_list_src(root = NULL) } \arguments{ \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function \strong{does} require that the -directory is configured for orderly, and not just outpack (see +default) to search for one from the current working +directory. This function \strong{does} require that the directory is +configured for orderly, and not just outpack (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the configuration should be -searched for. If \code{TRUE} and \code{config} is not given, -then orderly looks in the working directory and up through its -parents until it finds an \code{.outpack} directory} } \value{ A character vector of names of source reports, suitable diff --git a/man/orderly_location_add.Rd b/man/orderly_location_add.Rd index d25c1762..82be47b9 100644 --- a/man/orderly_location_add.Rd +++ b/man/orderly_location_add.Rd @@ -7,7 +7,7 @@ \alias{orderly_location_add_packit} \title{Add a new location} \usage{ -orderly_location_add(name, type, args, root = NULL, locate = TRUE) +orderly_location_add(name, type, args, root = NULL) orderly_location_add_path(name, path, root = NULL) @@ -34,16 +34,10 @@ API).} will vary depending on the type used, see Details.} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} \item{path}{The path to the other archive root. This should generally be an absolute path, or the behaviour of outpack will diff --git a/man/orderly_location_list.Rd b/man/orderly_location_list.Rd index 9768c838..12c535b9 100644 --- a/man/orderly_location_list.Rd +++ b/man/orderly_location_list.Rd @@ -4,23 +4,17 @@ \alias{orderly_location_list} \title{List known pack locations} \usage{ -orderly_location_list(verbose = FALSE, root = NULL, locate = TRUE) +orderly_location_list(verbose = FALSE, root = NULL) } \arguments{ \item{verbose}{Logical, indicating if we should return a data.frame that includes more information about the location.} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ Depending on the value of \code{verbose}: diff --git a/man/orderly_location_pull_metadata.Rd b/man/orderly_location_pull_metadata.Rd index c65cd2d0..9a403c2f 100644 --- a/man/orderly_location_pull_metadata.Rd +++ b/man/orderly_location_pull_metadata.Rd @@ -4,7 +4,7 @@ \alias{orderly_location_pull_metadata} \title{Pull metadata from a location} \usage{ -orderly_location_pull_metadata(location = NULL, root = NULL, locate = TRUE) +orderly_location_pull_metadata(location = NULL, root = NULL) } \arguments{ \item{location}{The name of a location to pull from (see @@ -14,16 +14,10 @@ locations are always up to date and pulling metadata from them does nothing.} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ Nothing diff --git a/man/orderly_location_pull_packet.Rd b/man/orderly_location_pull_packet.Rd index 11ee2fa0..00b9448f 100644 --- a/man/orderly_location_pull_packet.Rd +++ b/man/orderly_location_pull_packet.Rd @@ -8,8 +8,7 @@ orderly_location_pull_packet( ..., options = NULL, recursive = NULL, - root = NULL, - locate = TRUE + root = NULL ) } \arguments{ @@ -34,16 +33,10 @@ we default to the value given by the the configuration option \code{require_complete_tree}.} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ Invisibly, the ids of packets that were pulled diff --git a/man/orderly_location_push.Rd b/man/orderly_location_push.Rd index 0c48cc17..1fd7abef 100644 --- a/man/orderly_location_push.Rd +++ b/man/orderly_location_push.Rd @@ -4,7 +4,7 @@ \alias{orderly_location_push} \title{Push tree to location} \usage{ -orderly_location_push(packet_id, location, root = NULL, locate = TRUE) +orderly_location_push(packet_id, location, root = NULL) } \arguments{ \item{packet_id}{One or more packets to push to the server} @@ -13,16 +13,10 @@ orderly_location_push(packet_id, location, root = NULL, locate = TRUE) \link{orderly_location_list} for possible values).} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ Invisibly, details on the information that was actually diff --git a/man/orderly_location_remove.Rd b/man/orderly_location_remove.Rd index 1d691c9a..7ab6f3b3 100644 --- a/man/orderly_location_remove.Rd +++ b/man/orderly_location_remove.Rd @@ -4,23 +4,17 @@ \alias{orderly_location_remove} \title{Remove a location} \usage{ -orderly_location_remove(name, root = NULL, locate = TRUE) +orderly_location_remove(name, root = NULL) } \arguments{ \item{name}{The short name of the location. Cannot remove \code{local} or \code{orphan}} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ Nothing diff --git a/man/orderly_location_rename.Rd b/man/orderly_location_rename.Rd index 5840c28f..0821b2dd 100644 --- a/man/orderly_location_rename.Rd +++ b/man/orderly_location_rename.Rd @@ -4,7 +4,7 @@ \alias{orderly_location_rename} \title{Rename a location} \usage{ -orderly_location_rename(old, new, root = NULL, locate = TRUE) +orderly_location_rename(old, new, root = NULL) } \arguments{ \item{old}{The current short name of the location. @@ -14,16 +14,10 @@ Cannot rename \code{local} or \code{orphan}} Cannot be one of \code{local} or \code{orphan}} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ Nothing diff --git a/man/orderly_metadata.Rd b/man/orderly_metadata.Rd index 1b18a4e5..074aa02d 100644 --- a/man/orderly_metadata.Rd +++ b/man/orderly_metadata.Rd @@ -4,23 +4,17 @@ \alias{orderly_metadata} \title{Read outpack metadata} \usage{ -orderly_metadata(id, root = NULL, locate = FALSE) +orderly_metadata(id, root = NULL) } \arguments{ \item{id}{The id to fetch metadata for. An error will be thrown if this id is not known} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ A list of metadata. See the outpack schema for details diff --git a/man/orderly_metadata_extract.Rd b/man/orderly_metadata_extract.Rd index 7727f5a6..31f9f8ca 100644 --- a/man/orderly_metadata_extract.Rd +++ b/man/orderly_metadata_extract.Rd @@ -4,7 +4,7 @@ \alias{orderly_metadata_extract} \title{Extract metadata from orderly2 packets} \usage{ -orderly_metadata_extract(..., extract = NULL, root = NULL, locate = TRUE) +orderly_metadata_extract(..., extract = NULL, root = NULL) } \arguments{ \item{...}{Arguments passed through to @@ -17,16 +17,10 @@ ids directly.} named. See Details for the format.} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ A \code{data.frame}, the columns of which vary based on the diff --git a/man/orderly_new.Rd b/man/orderly_new.Rd index 5cc18e1c..16261c7a 100644 --- a/man/orderly_new.Rd +++ b/man/orderly_new.Rd @@ -4,7 +4,7 @@ \alias{orderly_new} \title{Create a new report} \usage{ -orderly_new(name, template = NULL, force = FALSE, root = NULL, locate = TRUE) +orderly_new(name, template = NULL, force = FALSE, root = NULL) } \arguments{ \item{name}{The name of the report} @@ -20,15 +20,10 @@ created the directory and some files first but want help creating the orderly file.} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function \strong{does} require that the -directory is configured for orderly, and not just outpack (see +default) to search for one from the current working +directory. This function \strong{does} require that the directory is +configured for orderly, and not just outpack (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the configuration should be -searched for. If \code{TRUE} and \code{config} is not given, -then orderly looks in the working directory and up through its -parents until it finds an \code{.outpack} directory} } \value{ Nothing, called for its side effects only diff --git a/man/orderly_prune_orphans.Rd b/man/orderly_prune_orphans.Rd index 94daa1e2..f3af521d 100644 --- a/man/orderly_prune_orphans.Rd +++ b/man/orderly_prune_orphans.Rd @@ -4,20 +4,14 @@ \alias{orderly_prune_orphans} \title{Prune orphan packet metadata} \usage{ -orderly_prune_orphans(root = NULL, locate = TRUE) +orderly_prune_orphans(root = NULL) } \arguments{ \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ Invisibly, a character vector of orphaned packet ids diff --git a/man/orderly_query_explain.Rd b/man/orderly_query_explain.Rd index 84b1c28d..20fd0a12 100644 --- a/man/orderly_query_explain.Rd +++ b/man/orderly_query_explain.Rd @@ -30,10 +30,10 @@ 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 if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ An object of class \code{orderly_query_explain}, which can be diff --git a/man/orderly_run.Rd b/man/orderly_run.Rd index d12f30e9..deec4b08 100644 --- a/man/orderly_run.Rd +++ b/man/orderly_run.Rd @@ -10,8 +10,7 @@ orderly_run( envir = NULL, echo = TRUE, search_options = NULL, - root = NULL, - locate = TRUE + root = NULL ) } \arguments{ @@ -35,15 +34,10 @@ with \link{orderly_dependency}; converted into a \link{orderly_search_options} object, see Details.} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function \strong{does} require that the -directory is configured for orderly, and not just outpack (see +default) to search for one from the current working +directory. This function \strong{does} require that the directory is +configured for orderly, and not just outpack (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the configuration should be -searched for. If \code{TRUE} and \code{config} is not given, -then orderly looks in the working directory and up through its -parents until it finds an \code{.outpack} directory} } \value{ The id of the created report (a string) diff --git a/man/orderly_search.Rd b/man/orderly_search.Rd index 439c30e3..c6b99f92 100644 --- a/man/orderly_search.Rd +++ b/man/orderly_search.Rd @@ -30,10 +30,10 @@ 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 if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ A character vector of matching ids. In the case of no diff --git a/man/orderly_validate_archive.Rd b/man/orderly_validate_archive.Rd index 335c3e32..614e5f75 100644 --- a/man/orderly_validate_archive.Rd +++ b/man/orderly_validate_archive.Rd @@ -4,7 +4,7 @@ \alias{orderly_validate_archive} \title{Validate unpacked packets.} \usage{ -orderly_validate_archive(..., action = "inform", root = NULL, locate = TRUE) +orderly_validate_archive(..., action = "inform", root = NULL) } \arguments{ \item{...}{Either arguments that a search can be constructed from @@ -15,16 +15,10 @@ vector of ids, or leave empty to validate everything.} Details.} \item{root}{The path to the root directory, or \code{NULL} (the -default) to search for one from the current working directory if -\code{locate} is \code{TRUE}. This function does not require that the -directory is configured for orderly, and can be any \code{outpack} -root (see \link{orderly_init} for details).} - -\item{locate}{Logical, indicating if the root should be searched -for. If \code{TRUE}, then we looks in the directory given for \code{root} -(or the working directory if \code{NULL}) and then up through its -parents until it finds an \code{.outpack} directory or -\code{orderly_config.yml}} +default) to search for one from the current working +directory. This function does not require that the directory is +configured for orderly, and can be any \code{outpack} root (see +\link{orderly_init} for details).} } \value{ Invisibly, a character vector of repaired (or invalid) diff --git a/tests/testthat/helper-outpack.R b/tests/testthat/helper-outpack.R index 98789a09..948395eb 100644 --- a/tests/testthat/helper-outpack.R +++ b/tests/testthat/helper-outpack.R @@ -101,7 +101,7 @@ create_temporary_root <- function(...) { path <- tempfile() withr::defer_parent(fs::dir_delete(path)) suppressMessages(orderly_init(path, ...)) - root_open(path, locate = FALSE, require_orderly = FALSE) + root_open(path, require_orderly = FALSE) } diff --git a/tests/testthat/test-cleanup.R b/tests/testthat/test-cleanup.R index 75036ed0..0c4fb9aa 100644 --- a/tests/testthat/test-cleanup.R +++ b/tests/testthat/test-cleanup.R @@ -12,7 +12,7 @@ test_that("can cleanup explicit things quite well", { c("name", "root", "path", "role", "status", "delete", "unknown")) expect_equal(status$name, "explicit") expect_equal(normalise_path(status$root), - normalise_path(root_open(path, FALSE, FALSE)$path)) + normalise_path(root_open(path, require_orderly = FALSE)$path)) expect_equal(normalise_path(status$path), normalise_path(file.path(status$root, "src", status$name))) paths <- c("data.csv", "explicit.R", "mygraph.png") diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index dd854848..fa11cffe 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -14,7 +14,7 @@ test_that("Can initialise a new orderly root", { res <- orderly_init_quietly(tmp) expect_true(file.exists(tmp)) expect_identical(normalise_path(res), normalise_path(tmp)) - root <- root_open(tmp, FALSE, TRUE) + root <- root_open(tmp, require_orderly = TRUE) expect_s3_class(root, "outpack_root") expect_equal(root$config$orderly, list(minimum_orderly_version = numeric_version("1.99.0"))) @@ -34,7 +34,7 @@ test_that("can turn an outpack root into an orderly one", { outpack_init_no_orderly(tmp) orderly_init_quietly(tmp) - root2 <- root_open(tmp, FALSE, FALSE) + root2 <- root_open(tmp, require_orderly = FALSE) expect_equal(root2$config$orderly, list(minimum_orderly_version = numeric_version("1.99.0"))) expect_s3_class(root2, "outpack_root") @@ -58,7 +58,7 @@ test_that("can initialise a repo with orderly but no .outpack directory", { i = "See ?orderly_init for more arguments to this function")) withr::with_dir(parent, orderly_init_quietly(base)) - root <- root_open(path, FALSE, TRUE) + root <- root_open(path, require_orderly = TRUE) expect_true(is_directory(file.path(path, ".outpack"))) id <- withr::with_dir(parent, @@ -152,7 +152,7 @@ test_that("inform about weirdly nested roots: orderly in outpack", { fs::dir_create(p) file.create(file.path(p, "orderly_config.yml")) err <- expect_error( - withr::with_dir(p, root_open(".", TRUE, TRUE)), + withr::with_dir(p, root_open(NULL, require_orderly = TRUE)), "Found incorrectly nested orderly and outpack directories") path_msg <- normalise_path(root$path) @@ -171,7 +171,7 @@ test_that("inform about weirdly nested roots: orderly in outpack", { p <- file.path(tmp, "a", "b") root2 <- outpack_init_no_orderly(p) err <- expect_error( - withr::with_dir(p, root_open(".", TRUE, TRUE)), + withr::with_dir(p, root_open(NULL, require_orderly = TRUE)), "Found incorrectly nested orderly and outpack directories") expect_equal( err$body, diff --git a/tests/testthat/test-location.R b/tests/testthat/test-location.R index e66ef24a..b0a0c531 100644 --- a/tests/testthat/test-location.R +++ b/tests/testthat/test-location.R @@ -207,16 +207,16 @@ test_that("re-adding a location de-orphans packets", { expect_message(orderly_location_remove("b", root = root$a), "Orphaning 2 packets") - expect_equal(nrow(root_open(root$a, FALSE)$index$location(orphan)), 2) + expect_equal(nrow(root_open(root$a)$index$location(orphan)), 2) expect_message(orderly_location_remove("c", root = root$a), "Orphaning 3 packets") - expect_equal(nrow(root_open(root$a, FALSE)$index$location(orphan)), 5) + expect_equal(nrow(root_open(root$a)$index$location(orphan)), 5) orderly_location_add_path("b", path = root$b, root = root$a) expect_message(orderly_location_pull_metadata(root = root$a), "De-orphaning 2 packets") - expect_equal(nrow(root_open(root$a, FALSE)$index$location(orphan)), 3) + expect_equal(nrow(root_open(root$a)$index$location(orphan)), 3) }) diff --git a/tests/testthat/test-outpack-hash.R b/tests/testthat/test-outpack-hash.R index 3fe184d2..f3bdb9d3 100644 --- a/tests/testthat/test-outpack-hash.R +++ b/tests/testthat/test-outpack-hash.R @@ -52,13 +52,11 @@ test_that("can use user-facing hash functions", { expect_equal(orderly_hash_data(str, "md5"), hash_data(str, "md5")) expect_equal(orderly_hash_data(str, root = root), hash_data(str, "sha256")) - expect_equal(orderly_hash_data(str, root = path), hash_data(str, "sha256")) expect_equal(withr::with_dir(path, orderly_hash_data(str)), hash_data(str, "sha256")) expect_equal(orderly_hash_file(tmp, "md5"), hash_file(tmp, "md5")) expect_equal(orderly_hash_file(tmp, root = root), hash_file(tmp, "sha256")) - expect_equal(orderly_hash_file(tmp, root = path), hash_file(tmp, "sha256")) expect_equal(withr::with_dir(path, orderly_hash_file(tmp)), hash_file(tmp, "sha256")) }) diff --git a/tests/testthat/test-outpack-root.R b/tests/testthat/test-outpack-root.R index 734c19f0..2a975177 100644 --- a/tests/testthat/test-outpack-root.R +++ b/tests/testthat/test-outpack-root.R @@ -20,24 +20,21 @@ test_that("Can locate an outpack root", { path <- root$path p <- file.path(path, "a", "b", "c") fs::dir_create(p) - expect_equal( - root_open(p, locate = TRUE, require_orderly = FALSE)$path, - root_open(path, locate = FALSE, require_orderly = FALSE)$path) expect_equal( withr::with_dir( p, - root_open(".", locate = TRUE, require_orderly = FALSE)$path), - root_open(path, locate = FALSE, require_orderly = FALSE)$path) + root_open(NULL, require_orderly = FALSE)$path), + root_open(path, require_orderly = FALSE)$path) expect_identical( - root_open(root, locate = FALSE, require_orderly = FALSE), root) + root_open(root, require_orderly = FALSE), root) }) test_that("root_open errors if it reaches toplevel", { - path <- temp_file() - fs::dir_create(path) + path <- withr::local_tempdir() expect_error( - root_open(path, locate = TRUE, require_orderly = FALSE), + withr::with_dir(path, + root_open(NULL, require_orderly = FALSE)), "Did not find existing orderly (or outpack) root in", fixed = TRUE) }) @@ -47,16 +44,16 @@ test_that("root_open does not recurse if locate = FALSE", { root <- create_temporary_root() path <- root$path expect_identical( - root_open(root, locate = FALSE, require_orderly = FALSE), + root_open(root, require_orderly = FALSE), root) expect_equal( - root_open(path, locate = FALSE, require_orderly = FALSE)$path, + root_open(path, require_orderly = FALSE)$path, path) p <- file.path(path, "a", "b", "c") fs::dir_create(p) expect_error( - root_open(p, locate = FALSE, require_orderly = FALSE), + root_open(p, require_orderly = FALSE), "Did not find existing orderly (or outpack) root in", fixed = TRUE) }) @@ -90,7 +87,7 @@ test_that("can find appropriate root if in working directory with path NULL", { root <- create_temporary_root() res <- withr::with_dir( root$path, - root_open(NULL, locate = TRUE, require_orderly = FALSE)) + root_open(NULL, require_orderly = FALSE)) expect_equal(res$path, root$path) }) diff --git a/tests/testthat/test-plugin.R b/tests/testthat/test-plugin.R index f894df73..5b81c21a 100644 --- a/tests/testthat/test-plugin.R +++ b/tests/testthat/test-plugin.R @@ -60,7 +60,7 @@ test_that("Can use custom deserialiser plugin", { meta <- orderly_metadata(id, root = path) - root <- root_open(path, locate = FALSE, require_orderly = FALSE) + root <- root_open(path, require_orderly = FALSE) meta <- orderly_metadata(id, root = root) expect_s3_class(meta$custom$example.random, "data.frame") expect_equal(meta$custom$example.random, diff --git a/tests/testthat/test-root.R b/tests/testthat/test-root.R index d1ff24df..4b83f4b9 100644 --- a/tests/testthat/test-root.R +++ b/tests/testthat/test-root.R @@ -24,7 +24,7 @@ test_that("error of opening an outpack root that is not an orderly root", { root <- outpack_init_no_orderly(tmp) err <- expect_error( - withr::with_dir(tmp, root_open(".", FALSE, TRUE)), + withr::with_dir(tmp, root_open(".", require_orderly = TRUE)), "Did not find 'orderly_config.yml' in '.", fixed = TRUE) expect_equal( @@ -41,13 +41,16 @@ test_that("pass back a root", { path_outpack <- withr::local_tempfile() root_outpack <- outpack_init_no_orderly(path_outpack) path_orderly <- test_prepare_orderly_example(character()) - root_orderly <- root_open(path_orderly, FALSE, TRUE) - - expect_identical(root_open(root_orderly, FALSE, FALSE), root_orderly) - expect_identical(root_open(root_orderly, FALSE, TRUE), root_orderly) - expect_identical(root_open(root_outpack, FALSE, FALSE), root_outpack) + root_orderly <- root_open(path_orderly, require_orderly = TRUE) + + expect_identical(root_open(root_orderly, require_orderly = FALSE), + root_orderly) + expect_identical(root_open(root_orderly, require_orderly = TRUE), + root_orderly) + expect_identical(root_open(root_outpack, require_orderly = FALSE), + root_outpack) expect_error( - root_open(root_outpack, FALSE, TRUE), + root_open(root_outpack, require_orderly = TRUE), sprintf("Did not find 'orderly_config.yml' in '%s'", root_outpack$path)) }) @@ -149,7 +152,7 @@ test_that("can identify a plain source root", { test_that("can identify a plain source root from a full root", { path <- test_prepare_orderly_example("explicit") - root <- root_open(path, FALSE) + root <- root_open(path) expect_equal(orderly_src_root(root$path, FALSE), root$path) expect_equal(orderly_src_root(root, FALSE), root$path) }) diff --git a/tests/testthat/test-run.R b/tests/testthat/test-run.R index 9641fc7b..9bb22d2c 100644 --- a/tests/testthat/test-run.R +++ b/tests/testthat/test-run.R @@ -983,7 +983,7 @@ test_that("nice error if running nonexistant report", { test_that("validation of orderly directories", { path <- test_prepare_orderly_example(character()) - root <- root_open(path, FALSE, TRUE) + root <- root_open(path, require_orderly = TRUE) nms <- sprintf("example_%s", letters[1:8]) fs::dir_create(file.path(path, "src", nms)) file.create(file.path(path, "src", nms, sprintf("%s.R", nms))) @@ -1039,7 +1039,7 @@ test_that("validation of orderly directories", { test_that("strip extraneous path components from orderly path", { path <- test_prepare_orderly_example(character()) - root <- root_open(path, FALSE, TRUE) + root <- root_open(path, require_orderly = TRUE) fs::dir_create(file.path(path, "src", "example_a")) file.create(file.path(path, "src", "example_a", "example_a.R"))