Merge pull request #108 from mrc-ide/mrc-4624

Allow for the two root types to be referenced separately

R/cleanup.R

@@ -104,18 +104,16 @@ orderly_cleanup_status <- function(name = NULL, root = NULL, locate = TRUE) {
 
   if (is.null(name) && is.null(root)) {
     path <- getwd()
-    root <- detect_orderly_interactive_path(path)$path
+    root_path <- detect_orderly_interactive_path(path)
     name <- basename(path)
   } else {
-    root <- root_open(root, locate = locate, require_orderly = TRUE,
-                      call = environment())
+    root_path <- orderly_src_root(root, locate, call = environment())
     if (is.null(name)) {
       ## This situation would be very odd, just disallow it
       cli::cli_abort("If 'root' is given explicitly, 'name' is required")
     }
-    name <- validate_orderly_directory(name, root, environment())
-    path <- file.path(root$path, "src", name)
-    root <- root$path
+    name <- validate_orderly_directory(name, root_path, environment())
+    path <- file.path(root_path, "src", name)
   }
 
   info <- orderly_read(path)
@@ -164,7 +162,7 @@ orderly_cleanup_status <- function(name = NULL, root = NULL, locate = TRUE) {
   unknown <- files[!is_source & !to_delete]
 
   structure(list(name = name,
-                 root = root,
+                 root = root_path,
                  path = path,
                  role = role,
                  status = status,

R/context.R

@@ -4,6 +4,7 @@ orderly_context <- function(envir) {
   if (is_active) {
     path <- p$path
     root <- p$root$path
+    root_src <- p$orderly2$root
     config <- p$orderly2$config
     envir <- p$orderly2$envir
     src <- p$orderly2$src
@@ -13,19 +14,19 @@ orderly_context <- function(envir) {
     search_options <- p$orderly2$search_options
   } else {
     path <- getwd()
-    root <- detect_orderly_interactive_path(path)$path
-    config <- root_open(root,
-                        locate = FALSE,
-                        require_orderly = TRUE)$config$orderly
+    root_src <- detect_orderly_interactive_path(path)
+    root <- root_src # for now at least
+    config <- orderly_config_read(root)
     src <- path
     parameters <- current_orderly_parameters(src, envir)
     name <- basename(path)
     id <- NA_character_
     search_options <- .interactive$search_options
   }
   list(is_active = is_active, path = path, config = config, envir = envir,
-       root = root, src = src, name = name, id = id, parameters = parameters,
-       search_options = search_options, packet = p)
+       root = root, root_src = root_src, src = src, name = name,
+       id = id, parameters = parameters, search_options = search_options,
+       packet = p)
 }
 
 

R/gitignore.R

@@ -34,41 +34,45 @@
 ##' @return Nothing, called for its side effects
 ##' @export
 orderly_gitignore_update <- function(name, root = NULL, locate = TRUE) {
-  root <- root_open(root, locate, require_orderly = TRUE, call = environment())
-  do_orderly_gitignore_update(name, root, environment())
+  root_path <- orderly_src_root(root, locate, call = environment())
+  do_orderly_gitignore_update(name, root_path, environment())
 }
 
 ## Separate inned function that avoids opening the root, we need this
 ## to break a circular dependency as we sometimes call this function
 ## while openning the root.
-do_orderly_gitignore_update <- function(name, root, call) {
+do_orderly_gitignore_update <- function(name, root_path, call) {
   assert_scalar_character(name)
 
   if (name == "(root)") {
     path <- ".gitignore"
-    value <- gitignore_content_root(root)
+    value <- gitignore_content_root(root_path)
   } else {
-    name <- validate_orderly_directory(name, root, call)
+    name <- validate_orderly_directory(name, root_path, call)
     path <- file.path("src", name, ".gitignore")
-    value <- gitignore_content_src(name, root)
+    value <- gitignore_content_src(name, root_path)
   }
 
-  if (gitignore_update_file(root$path, path, value)) {
+  if (gitignore_update_file(root_path, path, value)) {
     cli::cli_alert_success("Wrote '{path}'")
   }
   invisible(TRUE)
 }
 
-gitignore_content_root <- function(root) {
+gitignore_content_root <- function(root_path) {
+  path_archive <- NULL
+  if (file.exists(file.path(root_path, ".outpack", "config.json"))) {
+    path_archive <- config_read(root_path)$core$path_archive
+  }
   c(".outpack",
     "orderly_envir.yml",
     "draft",
-    root$config$core$path_archive)
+    path_archive)
 }
 
 
-gitignore_content_src <- function(name, root) {
-  dat <- orderly_read_r(file.path(root$path, "src", name, "orderly.R"))
+gitignore_content_src <- function(name, root_path) {
+  dat <- orderly_read_r(file.path(root_path, "src", name, "orderly.R"))
 
   ignore_deps <- unlist(lapply(dat$dependency, function(x) names(x$files)))
   ignore_artefacts <- unlist(lapply(dat$artefacts, "[[", "files"))
@@ -89,7 +93,7 @@ gitignore_markers <- c(
   "# ---^^^--- added by orderly ---^^^----------------")
 
 
-gitignore_update_contents <- function(content_old, value, path, root) {
+gitignore_update_contents <- function(content_old, value, path, root_path) {
   if (!any(gitignore_markers %in% content_old)) {
     if (length(content_old) > 0) {
       content_old <- c(content_old, "")
@@ -106,7 +110,7 @@ gitignore_update_contents <- function(content_old, value, path, root) {
   if (err) {
     cli::cli_abort(c(
       "Can't edit '{path}', markers are corrupted",
-      i = "(within orderly root '{root}')",
+      i = "(within orderly root '{root_path}')",
       i = "Please see ?orderly_gitignore_update for more details"))
   }
 
@@ -117,11 +121,11 @@ gitignore_update_contents <- function(content_old, value, path, root) {
 }
 
 
-gitignore_update_file <- function(root, path, value) {
-  path_full <- file.path(root, path)
+gitignore_update_file <- function(root_path, path, value) {
+  path_full <- file.path(root_path, path)
   gitignore_exists <- file.exists(path_full)
   content_old <- if (gitignore_exists) readLines(path_full) else character()
-  content_new <- gitignore_update_contents(content_old, value, path, root)
+  content_new <- gitignore_update_contents(content_old, value, path, root_path)
   if (identical(content_old, content_new)) {
     return(FALSE)
   }

R/interactive.R

@@ -12,8 +12,7 @@ detect_orderly_interactive_path <- function(path = getwd()) {
   if (!is_plausible) {
     stop(sprintf("Failed to detect orderly path at '%s'", path))
   }
-  root_path <- as.character(fs::path_norm(file.path(path, "../..")))
-  root_open(root_path, locate = FALSE, require_orderly = TRUE)
+  as.character(fs::path_norm(file.path(path, "../..")))
 }
 
 

R/location.R

@@ -358,7 +358,7 @@ orderly_location_pull_packet <- function(..., options = NULL, recursive = NULL,
 ##' @export
 orderly_location_push <- function(packet_id, location, root = NULL,
                                   locate = TRUE) {
-  root <- root_open(root, locate = locate, require_orderly = TRUE,
+  root <- root_open(root, locate = locate, require_orderly = FALSE,
                     call = environment())
   location_name <- location_resolve_valid(location, root,
                                           include_local = FALSE,

R/metadata.R

@@ -321,7 +321,7 @@ orderly_shared_resource <- function(...) {
   files <- validate_shared_resource(list(...), environment())
   ctx <- orderly_context(rlang::caller_env())
 
-  files <- copy_shared_resource(ctx$root, ctx$path, ctx$config, files)
+  files <- copy_shared_resource(ctx$root_src, ctx$path, ctx$config, files)
   if (ctx$is_active) {
     outpack_packet_file_mark(ctx$packet, files$here, "immutable")
     ctx$packet$orderly2$shared_resources <-

R/orderly.R

@@ -16,11 +16,10 @@
 ##' path <- orderly2::orderly_example("default")
 ##' orderly2::orderly_list_src(root = path)
 orderly_list_src <- function(root = NULL, locate = TRUE) {
-  root <- root_open(root, locate = locate, require_orderly = TRUE,
-                    call = environment())
-  if (!file.exists(file.path(root$path, "src"))) {
+  root_path <- orderly_src_root(root, locate)
+  if (!file.exists(file.path(root_path, "src"))) {
     return(character())
   }
-  pos <- fs::dir_ls(file.path(root$path, "src"), type = "directory")
+  pos <- fs::dir_ls(file.path(root_path, "src"), type = "directory")
   basename(pos)[file_exists(file.path(pos, "orderly.R"))]
 }

R/root.R

@@ -206,6 +206,32 @@ root_open <- function(path, locate, require_orderly = FALSE, call = NULL) {
 }
 
 
+orderly_src_root <- function(path, locate, call = NULL) {
+  if (inherits(path, "outpack_root")) {
+    path <- path$path
+    locate <- FALSE
+  }
+  if (is.null(path)) {
+    path <- getwd()
+  }
+  assert_scalar_character(path)
+  assert_is_directory(path)
+
+  limit <- if (locate) "/" else path
+  path_root <- find_file_descend("orderly_config.yml", path, limit)
+  if (is.null(path_root)) {
+    cli::cli_abort(
+      c(sprintf(
+        "Did not find existing orderly source root in '%s'", path),
+        i = "Expected to find file 'orderly_config.yml'",
+        i = if (locate) "Looked in parents of this path without success"),
+      call = call)
+  }
+
+  path_root
+}
+
+
 ## This is pretty unpleasant, but does the trick.
 root_validate_same_configuration <- function(args, config, root, call) {
   argmap <- list(
@@ -275,7 +301,7 @@ root_check_git <- function(root, call) {
     }
   }
 
-  do_orderly_gitignore_update("(root)", root)
+  do_orderly_gitignore_update("(root)", root$path)
 
   fs::dir_create(dirname(path_ok))
   fs::file_create(path_ok)

R/run.R

@@ -81,6 +81,29 @@
 ##'   functionality was never available in orderly version 1, though
 ##'   we had intended to support it.
 ##'
+##' @section Running with a source tree separate from outpack root:
+##'
+##' Sometimes it is useful to run things from a different place on
+##'   disk to your outpack root. We know of two cases where this has
+##'   come up:
+##'
+##' * when running reports within a runner on a server, we make a
+##'   clean clone of the source tree at a particular git reference
+##'   into a new temporary directory and then run the report there,
+##'   but have it insert into an orderly repo at a fixed and
+##'   non-temporary location.
+##' * we have a user for whom it is more convenient torun their report
+##'   on a hard drive but store the archive and metadata on a (larger)
+##'   shared drive.
+##'
+##' In the first instance, we have a source path at `<src>` which
+##'   contains the file `orderly_config.yml` and the directory `src/`
+##'   with our source reports, and a separate path `<root>` which
+##'   contains the directory `.outpack/` with all the metadata - it
+##'   may also have an unpacked archive, and a `.git/` directory
+##'   depending on the configuration. (Later this will make more sense
+##'   once we support a "bare" outpack layout.)
+##'
 ##' @title Run a report
 ##'
 ##' @param name Name of the report to run. Any leading `./` `src/` or
@@ -113,6 +136,12 @@
 ##'   then orderly looks in the working directory and up through its
 ##'   parents until it finds an `.outpack` directory
 ##'
+##' @param root_src Separately, the root of the orderly source tree,
+##'   if separate from the outpack root (given as `root`). This is
+##'   intended for running reports in situations where the source tree
+##'   is kept in a different place to the outpack root; see Details
+##'   for more information.
+##'
 ##' @return The id of the created report (a string)
 ##'
 ##' @export
@@ -129,20 +158,30 @@
 ##' # 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) {
-  root <- root_open(root, locate, require_orderly = TRUE, call = environment())
-  name <- validate_orderly_directory(name, root, environment())
+                        search_options = NULL, root = NULL, locate = TRUE,
+                        root_src = NULL) {
+  if (is.null(root_src)) {
+    root <- root_open(root, locate, require_orderly = TRUE,
+                      call = environment())
+    root_src <- root$path
+  } else {
+    root <- root_open(root, locate, require_orderly = FALSE,
+                      call = environment())
+    root_src <- orderly_src_root(root_src, locate, call = environment())
+  }
+
+  name <- validate_orderly_directory(name, root_src, environment())
 
   envir <- envir %||% .GlobalEnv
   assert_is(envir, "environment")
 
-  src <- file.path(root$path, "src", name)
+  src <- file.path(root_src, "src", name)
   dat <- orderly_read(src)
   parameters <- check_parameters(parameters, dat$parameters, environment())
   orderly_validate(dat, src)
 
   id <- outpack_id()
-  path <- file.path(root$path, "draft", name, id)
+  path <- file.path(root_src, "draft", name, id)
   fs::dir_create(path)
 
   ## Slightly peculiar formulation here; we're going to use 'path' as
@@ -164,8 +203,8 @@ orderly_run <- function(name, parameters = NULL, envir = NULL, echo = TRUE,
                             id = id, root = root)
   outpack_packet_file_mark(p, "orderly.R", "immutable")
   p$orderly2 <- list(config = root$config$orderly, envir = envir, src = src,
-                     strict = dat$strict, inputs_info = inputs_info,
-                     search_options = search_options)
+                     root = root_src, strict = dat$strict,
+                     inputs_info = inputs_info, search_options = search_options)
   current[[path]] <- p
   on.exit(current[[path]] <- NULL, add = TRUE, after = TRUE)
   if (!is.null(parameters)) {
@@ -487,13 +526,13 @@ orderly_packet_add_metadata <- function(p) {
 }
 
 
-validate_orderly_directory <- function(name, root, call) {
+validate_orderly_directory <- function(name, root_path, call) {
   assert_scalar_character(name)
 
   re <- "^(./)*(src/)?(.+?)/?$"
   name <- sub(re, "\\3", name)
-  if (!file_exists(file.path(root$path, "src", name, "orderly.R"))) {
-    src <- file.path(root$path, "src", name)
+  if (!file_exists(file.path(root_path, "src", name, "orderly.R"))) {
+    src <- file.path(root_path, "src", name)
     err <- sprintf("Did not find orderly report '%s'", name)
     if (!file_exists(src)) {
       detail <- sprintf("The path 'src/%s' does not exist", name)
@@ -507,14 +546,14 @@ validate_orderly_directory <- function(name, root, call) {
         name)
     }
     err <- c(err, x = detail)
-    near <- near_match(name, orderly_list_src(root, FALSE))
+    near <- near_match(name, orderly_list_src(root_path, FALSE))
     if (length(near) > 0) {
       hint <- sprintf("Did you mean %s",
                       paste(squote(near), collapse = ", "))
       err <- c(err, i = hint)
     }
     err <- c(err, i = sprintf("Looked relative to orderly root at '%s'",
-                              root$path))
+                              root_path))
     cli::cli_abort(err, call = call)
   }