From 7e319299836bba58604fa1d01000f59c5efbe79c Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Wed, 23 Oct 2024 12:17:29 +0100 Subject: [PATCH] Tidy up passing of relative paths for locations --- R/location.R | 39 +++++++++++++++++++---- man/orderly_location_add.Rd | 15 +++++++-- tests/testthat/test-location-path.R | 48 +++++++++++++++++++++++++++++ tests/testthat/test-location.R | 8 +++-- 4 files changed, 98 insertions(+), 12 deletions(-) diff --git a/R/location.R b/R/location.R index 9ca308ca..4000fbd4 100644 --- a/R/location.R +++ b/R/location.R @@ -96,6 +96,21 @@ orderly_location_add <- function(name, type, args, verify = TRUE, root = NULL) { if (type == "path") { assert_scalar_character(args$path, name = "path") + if (!fs::is_absolute_path(args$path)) { + ## This only happens where the current working directory is not + ## the same as the root. + root_error <- !file.exists(file.path(root$path, args$path)) && + file.exists(args$path) + if (root_error) { + root_fix <- as.character(fs::path_rel(args$path, root$path)) + cli::cli_abort( + c("'path' must be given relative to the orderly root", + x = paste("You have provided the relative path '{args$path}',", + "which exists, but does not exist relatively to", + "'{root$path}', the root of your orderly archive"), + i = "Consider passing '{root_fix}' instead")) + } + } } else if (type == "http") { assert_scalar_character(args$url, name = "url") } else if (type == "packit") { @@ -114,7 +129,7 @@ orderly_location_add <- function(name, type, args, verify = TRUE, root = NULL) { if (verify) { cli_alert_info("Testing location") - location_driver_create(type, args)$verify() + location_driver_create(type, args, root)$verify() cli_alert_success("Location configured successfully") } @@ -129,9 +144,18 @@ orderly_location_add <- function(name, type, args, verify = TRUE, root = NULL) { ##' @rdname orderly_location_add ##' -##' @param path The path to the other archive root. This should -##' generally be an absolute path, or the behaviour of outpack will -##' be unreliable. +##' @param path The path to the other archive root. This can be a +##' relative or absolute path, with different tradeoffs. If you use +##' an absolute path, then this location will typically work well on +##' this machine, but it may behave poorly when the location is +##' found on a shared drive **and** when you use your orderly root +##' from more than one system. This setup is common when using an +##' HPC system. If you use a relative path, then we will interpret +##' it **relative to your orderly root** and not the directory that +##' you evaluate this command from. Typically your path should +##' include leading dots (e.g. `../../somewhere/else`) as you should +##' not nest orderly projects. This approach should work fine on +##' shared filesystems. ##' ##' @export orderly_location_add_path <- function(name, path, verify = TRUE, root = NULL) { @@ -496,16 +520,19 @@ location_driver <- function(location_name, root) { i <- match(location_name, root$config$location$name) type <- root$config$location$type[[i]] args <- root$config$location$args[[i]] - location_driver_create(type, args) + location_driver_create(type, args, root) } -location_driver_create <- function(type, args) { +location_driver_create <- function(type, args, root) { location <- switch(type, path = orderly_location_path$new, http = orderly_location_http$new, packit = orderly_location_packit, custom = orderly_location_custom) + ## Set the workdir to the orderly root so that paths are interpreted + ## relative to the root. + withr::local_dir(root$path) do.call(location, args) } diff --git a/man/orderly_location_add.Rd b/man/orderly_location_add.Rd index 609aa3f1..6800476c 100644 --- a/man/orderly_location_add.Rd +++ b/man/orderly_location_add.Rd @@ -43,9 +43,18 @@ 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 -be unreliable.} +\item{path}{The path to the other archive root. This can be a +relative or absolute path, with different tradeoffs. If you use +an absolute path, then this location will typically work well on +this machine, but it may behave poorly when the location is +found on a shared drive \strong{and} when you use your orderly root +from more than one system. This setup is common when using an +HPC system. If you use a relative path, then we will interpret +it \strong{relative to your orderly root} and not the directory that +you evaluate this command from. Typically your path should +include leading dots (e.g. \verb{../../somewhere/else}) as you should +not nest orderly projects. This approach should work fine on +shared filesystems.} \item{url}{The location of the server, including protocol, for example \verb{http://example.com:8080}} diff --git a/tests/testthat/test-location-path.R b/tests/testthat/test-location-path.R index dabc4729..107e51c4 100644 --- a/tests/testthat/test-location-path.R +++ b/tests/testthat/test-location-path.R @@ -359,3 +359,51 @@ test_that("Fail to push sensibly if files have been changed", { suppressMessages(orderly_location_push(ids[[4]], "server", client)), "Did not find suitable file, can't push this packet") }) + + +test_that("allow relative paths in path locations", { + tmp <- withr::local_tempdir() + a <- suppressMessages(orderly_init(file.path(tmp, "a"))) + b <- suppressMessages(orderly_init(file.path(tmp, "b"))) + ids <- vcapply(1:3, function(i) create_random_packet(b)) + withr::with_dir(a, orderly_location_add_path("b", path = "../b")) + orderly_location_pull_metadata(root = a) + expect_equal(orderly_search(root = a, location = "b"), ids) +}) + + +test_that("allow weird absolute paths in path locations", { + tmp <- withr::local_tempdir() + nms <- letters[1:3] + root <- suppressMessages( + set_names(lapply(nms, function(x) orderly_init(file.path(tmp, x))), nms)) + + withr::with_dir( + tmp, orderly_location_add_path("b", path = "../b", root = "a")) + expect_equal( + orderly_location_list(verbose = TRUE, root = root$a)$args[[2]]$path, + "../b") + + fs::dir_create(file.path(root$a, "some/deep/path")) + withr::with_dir( + file.path(root$a, "some/deep/path"), + orderly_location_add_path("c", path = "../c")) + expect_equal( + orderly_location_list(verbose = TRUE, root = root$a)$args[[3]]$path, + "../c") +}) + + +test_that("provide hint when wrong relative path given", { + tmp <- withr::local_tempdir() + nms <- letters[1:3] + root <- suppressMessages( + set_names(lapply(nms, function(x) orderly_init(file.path(tmp, x))), nms)) + + err <- expect_error( + withr::with_dir( + tmp, orderly_location_add_path("b", path = "b", root = "a")), + "'path' must be given relative to the orderly root") + expect_equal(err$body[[2]], + "Consider passing '../b' instead") +}) diff --git a/tests/testthat/test-location.R b/tests/testthat/test-location.R index b0f2baa4..73c91b4a 100644 --- a/tests/testthat/test-location.R +++ b/tests/testthat/test-location.R @@ -850,7 +850,8 @@ test_that("can add a packit location", { list("packit", list(url = "https://example.com", token = "abc123", - save_token = FALSE))) + save_token = FALSE), + root)) }) test_that("can add a packit location without a token", { @@ -873,7 +874,8 @@ test_that("can add a packit location without a token", { expect_equal( mockery::mock_args(mock_driver)[[1]], list("packit", - list(url = "https://example.com", token = NULL, save_token = TRUE))) + list(url = "https://example.com", token = NULL, save_token = TRUE), + root)) }) test_that("cope with trailing slash in url if needed", { @@ -947,7 +949,7 @@ test_that("can add a custom outpack location", { expect_equal(location_driver(loc$name, root), "value") mockery::expect_called(mock_orderly_location_driver_create, 1) expect_equal(mockery::mock_args(mock_orderly_location_driver_create)[[1]], - list("custom", list(driver = "foo::bar", a = 1, b = 2))) + list("custom", list(driver = "foo::bar", a = 1, b = 2), root)) })