Clean up generated files from source directory

DESCRIPTION

@@ -34,6 +34,7 @@ Suggests:
     testthat (>= 3.0.0)
 Config/testthat/edition: 3
 Remotes:
-  ropensci/jsonvalidate
+  ropensci/jsonvalidate,
+  r-lib/gert
 VignetteBuilder: knitr
 Language: en-GB

NAMESPACE

@@ -2,6 +2,8 @@
 
 S3method(format,outpack_query)
 export(orderly_artefact)
+export(orderly_cleanup)
+export(orderly_cleanup_status)
 export(orderly_dependency)
 export(orderly_description)
 export(orderly_global_resource)

R/cleanup.R

@@ -0,0 +1,119 @@
+##' Find, and delete, file that were generated by running a report.
+##' Until you're comfortable with what this will do, you are strongly
+##' recommended to run `orderly_cleanup_status` first to see what will
+##' be deleted.
+##'
+##' After file deletion, we look through and remove all empty
+##' directories; orderly2 has similar semantics here to git where
+##' directories are never directly tracked.
+##'
+##' For recent `gert` (not yet on CRAN) we will ask git if files are
+##' ignored; if ignored then they are good candidates for deletion! We
+##' encourage you to keep a per-report `.gitignore` that lists files
+##' that will copy into the source directory, and then we can use that
+##' same information to clean up these files after generation.
+##' Importantly, even if a file matches an ignore rule but has been
+##' committed to your repository, it will no longer match the ignore
+##' rule.
+##'
+##' @section Notes for user of orderly1:
+##'
+##' In orderly1 this function has quite different semantics, because
+##'   the full set of possible files is always knowable from the yaml
+##'   file. So there, we start from the point of view of the list of
+##'   files then compare that with the directory.
+##'
+##' @title Clean up source directory
+##'
+##' @param name Name of the report directory to clean (i.e., we look
+##'   at `src/<name>` relative to your orderly root
+##'
+##' @inheritParams orderly_run
+##'
+##' @return An (currently unstable) object of class
+##'   `orderly_cleanup_status` within which the element `delete`
+##'   indicates files that would be deleted (for
+##'   `orderly_cleanup_status`) or that were deleted (for
+##'   `orderly_cleanup`)
+##'
+##' @export
+orderly_cleanup <- function(name = NULL, root = NULL, locate = TRUE) {
+  status <- orderly_cleanup_status(name, root, locate)
+  if (length(status$delete) > 0) {
+    withr::with_dir(status$path, fs::file_delete(status$delete))
+  }
+  delete_empty_directories(status$path)
+  invisible(status)
+}
+
+
+##' @export
+##' @rdname orderly_cleanup
+orderly_cleanup_status <- function(name = NULL, root = NULL, locate = TRUE) {
+  p <- get_active_packet()
+  is_active <- !is.null(p)
+  if (is_active) {
+    cli::cli_abort(
+      "Don't call 'orderly2::orderly_cleanup_status()' from a running packet",
+      i = "The orderly_cleanup* functions are for interactive use only")
+  }
+
+  if (is.null(name)) {
+    path <- getwd()
+    root <- detect_orderly_interactive_path(path)$path
+    name <- basename(path)
+  } else {
+    root <- orderly_root(root, locate)
+    validate_orderly_directory(name, root, environment())
+    path <- file.path(root$path, "src", name)
+    root <- root$path
+  }
+
+  info <- orderly_read(path)
+  files <- withr::with_dir(
+    path,
+    dir(all.files = TRUE, recursive = TRUE, no.. = TRUE))
+
+  ## Slightly tricky construction here as we need to match all files
+  ## that are present as directory entries; this is explicit only for
+  ## dependencies, but we need to work it out ourselves for the rest.
+  matches_path <- function(x, path, add_slash = TRUE) {
+    path_dir <- if (add_slash) with_trailing_slash(path) else path
+    x %in% path |
+      row_any(vapply(path_dir, function(p) string_starts_with(p, x),
+                     logical(length(x))))
+  }
+  nms_resource <- info$resources
+  nms_artefact <- unlist(lapply(info$artefacts, "[[", "files"))
+  nms_dependency <- unlist(lapply(info$dependency, function(x) names(x$use)))
+  nms_global_resource <- names(info$global_resource)
+
+  role <- cbind(orderly = files == "orderly.R",
+                resource = matches_path(files, nms_resource),
+                global_resource = matches_path(files, nms_global_resource),
+                dependency = matches_path(files, nms_dependency, FALSE),
+                artefact = matches_path(files, nms_artefact))
+  rownames(role) <- files
+
+  v_source <- c("orderly", "resource")
+  v_derived <- c("global_resource", "dependency", "artefact")
+
+  is_source <- row_any(role[, v_source, drop = FALSE])
+  is_derived <- !is_source & row_any(role[, v_derived, drop = FALSE])
+  is_ignored <- path_is_git_ignored(file.path("src", name, files), path)
+  status <- cbind(source = is_source,
+                  derived = is_derived,
+                  ignored = is_ignored)
+  rownames(status) <- files
+
+  to_delete <- (is_derived | (!is.na(is_ignored) & is_ignored)) & !is_source
+  delete <- files[to_delete]
+
+  structure(list(name = name,
+                 root = root,
+                 path = path,
+                 role = role,
+                 status = status,
+                 delete = delete),
+            class = "orderly_cleanup_status")
+}

R/interactive.R

@@ -34,12 +34,8 @@ detect_orderly_interactive_path <- function(path = getwd()) {
 ##'   with [orderly2::orderly_dependency]; see of Details section of
 ##'   [orderly2::orderly_run].
 ##'
-##' @inheritParams orderly_run
-##'
 ##' @return Nothing, called for its side effects
 ##' @export
-orderly_interactive_set_search_options <- function(options = NULL,
-                                                   root = NULL,
-                                                   locate = TRUE) {
+orderly_interactive_set_search_options <- function(options = NULL) {
   .interactive$search_options <- options
 }

R/metadata.R

@@ -283,10 +283,7 @@ static_orderly_dependency <- function(args) {
   use <- args$use
 
   name <- static_string(name)
-
-  ## TODO: this is no longer ok, it might not easily be computable
-  ## really; see mrc-4398
-  use <- static_character_vector(use)
+  use <- static_character_vector(use, TRUE)
   ## TODO: allow passing expressions directly in, that will be much
   ## nicer, but possibly needs some care as we do want a consistent
   ## approach to NSE here
@@ -378,7 +375,7 @@ copy_global <- function(path_root, path_dest, config, files) {
 
 
 static_orderly_global_resource <- function(args) {
-  list(files = static_character_vector(args))
+  unlist(lapply(args, static_character_vector, TRUE), FALSE, TRUE)
 }
 
 
@@ -393,12 +390,12 @@ static_string <- function(x) {
 }
 
 
-static_character_vector <- function(x) {
+static_character_vector <- function(x, named) {
   if (is.character(x)) {
     x
   } else if (is_call(x, "c")) {
-    x <- lapply(x[-1], static_character_vector)
-    x <- if (all(vlapply(x, is.character))) unlist(x, FALSE, FALSE) else NULL
+    x <- lapply(x[-1], static_character_vector, named)
+    x <- if (all(vlapply(x, is.character))) unlist(x, FALSE, named) else NULL
   } else {
     x <- NULL
   }

R/outpack_misc.R

@@ -47,7 +47,7 @@ not_found_error <- function(message, data) {
 ## Also note that there might be 0, 1, or more urls depending on the
 ## way that the repo is configured; this feels ok really.
 git_info <- function(path) {
-  repo <- tryCatch(gert::git_open(path), error = function(e) NULL)
+  repo <- git_open(path)
   if (is.null(repo)) {
     return(NULL)
   }

R/outpack_root.R

@@ -422,7 +422,7 @@ validate_packet_has_file <- function(root, id, path) {
 
   ## Then, look to see if any of the missing ones are actually directories:
   msg <- path[!found]
-  found_if_dir <- vlapply(sub("(?<![/])$", "/", msg, perl = TRUE),
+  found_if_dir <- vlapply(with_trailing_slash(msg),
                           function(x) any(string_starts_with(x, files)),
                           USE.NAMES = FALSE)
 

R/read.R

@@ -87,6 +87,9 @@ orderly_read_r <- function(path) {
   if (length(dat$dependency) > 0) {
     ret$dependency <- drop_null(dat$dependency, empty = NULL)
   }
+  if (length(dat$global_resource) > 0) {
+    ret$global_resource <- unlist(dat$global_resource, FALSE, TRUE)
+  }
 
   ret
 }

R/util.R

@@ -480,3 +480,50 @@ string_interpolate_simple1 <- function(x, environment, call) {
 quote_braces <- function(x) {
   gsub("{", "{{", x, fixed = TRUE)
 }
+
+
+## Currently supported in gert 1.9000 (which is the 2.0
+## prerelease). Rather than depend on that version directly, requiring
+## people to install it from source or r-universe, just sniff for the
+## function we need, for now:
+gert_git_ignore_path_is_ignored <- function() {
+  tryCatch(getExportedValue("gert", "git_ignore_path_is_ignored"),
+             error = function(e) NULL)
+}
+
+
+git_open <- function(path) {
+  tryCatch(gert::git_open(path), error = function(e) NULL)
+}
+
+
+path_is_git_ignored <- function(path, root) {
+  repo <- git_open(root)
+  gert_fn <- gert_git_ignore_path_is_ignored()
+  if (is.null(repo) || is.null(gert_fn)) {
+    rep_len(NA, length(path))
+  } else {
+    gert_fn(path, repo)
+  }
+}
+
+
+row_any <- function(x) {
+  apply(x, 1, any)
+}
+
+
+delete_empty_directories <- function(path) {
+  paths <- fs::dir_ls(path, type = "directory", recurse = TRUE)
+  paths <- setdiff(paths[order(nchar(paths), decreasing = TRUE)], path)
+  for (p in paths) {
+    if (length(fs::dir_ls(p, all = TRUE)) == 0) {
+      fs::dir_delete(p)
+    }
+  }
+}
+
+
+with_trailing_slash <- function(x) {
+  sub("(?<![/])$", "/", x, perl = TRUE)
+}

tests/testthat/helper-orderly.R

@@ -91,3 +91,9 @@ skip_on_solaris <- function() {
 is_windows <- function() {
   tolower(Sys.info()[["sysname"]]) == "windows"
 }
+
+
+skip_if_older_gert <- function() {
+  testthat::skip_if(is.null(gert_git_ignore_path_is_ignored()),
+                    "older gert")
+}