From 95533eee6443a4e1488a510670805874ce2fe630 Mon Sep 17 00:00:00 2001
From: Rich FitzJohn <r.fitzjohn@imperial.ac.uk>
Date: Wed, 24 Apr 2024 16:08:16 +0100
Subject: [PATCH] Allow initialising a project directory

---
 DESCRIPTION                |  2 +-
 R/root.R                   | 30 +++++++++++++++++++-----------
 man/orderly_init.Rd        |  6 +++++-
 tests/testthat/test-init.R | 25 +++++++++++++++++++++++++
 4 files changed, 50 insertions(+), 13 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 74c440e4..733ff5df 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: orderly2
 Title: Orderly Next Generation
-Version: 1.99.14
+Version: 1.99.15
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "rich.fitzjohn@gmail.com"),
              person("Robert", "Ashton", role = "aut"),
diff --git a/R/root.R b/R/root.R
index ba4f2879..87111d10 100644
--- a/R/root.R
+++ b/R/root.R
@@ -49,6 +49,9 @@
 ##'   location; if `TRUE` you will always have all the packets that
 ##'   you hold metadata about.
 ##'
+##' @param force Logical, indicating if we shold initialise orderly
+##'   even if the directory is not empty.
+##'
 ##' @return The full, normalised, path to the root,
 ##'   invisibly. Typically this is called only for its side effect.
 ##'
@@ -65,25 +68,30 @@
 orderly_init <- function(root = ".",
                          path_archive = "archive",
                          use_file_store = FALSE,
-                         require_complete_tree = FALSE) {
+                         require_complete_tree = FALSE,
+                         force = FALSE) {
   assert_scalar_character(root)
   has_orderly_config <- file.exists(file.path(root, "orderly_config.yml"))
   if (!has_orderly_config && file.exists(root)) {
     if (!is_directory(root)) {
       cli::cli_abort("'root' exists but is not a directory")
     }
-    if (!file.exists(file.path(root, ".outpack"))) {
-      ## We may need to relax this, but it's not really clear to me
-      ## how the user gets into this position; they have a bunch of
-      ## files there and they want to a root into it?
-      ##
-      ## One option is provide a boolean arg to proceed anyway in this
-      ## case, at the moment there's not a lot that can be done to
-      ## undo this situation.
-      if (length(dir(root, all.files = TRUE, no.. = TRUE)) > 0) {
+    if (!file.exists(file.path(root, ".outpack")) && !force) {
+      allowed <- c(".outpack",
+                   ".git", ".gitignore",
+                   ".Rhistory",
+                   "*.Rproj", ".Rproj.user")
+      contents <- dir(root, all.files = TRUE, no.. = TRUE)
+      m <- vapply(glob2rx(allowed), grepl, logical(length(contents)), contents)
+      if (!is.matrix(m)) { # exactly one file to compare
+        m <- rbind(m)
+      }
+      err <- contents[!apply(m, 1, any)]
+      if (length(err) > 0) {
         cli::cli_abort(c(
           "'root' exists but is not empty, or an outpack archive",
-          i = "Please have a chat with us if this is something you need to do"))
+          x = "Found existing file{?s}: {.file {err}}",
+          i = "Use 'force = TRUE' to initialise anyway"))
       }
     }
   }
diff --git a/man/orderly_init.Rd b/man/orderly_init.Rd
index 333bd509..a773c687 100644
--- a/man/orderly_init.Rd
+++ b/man/orderly_init.Rd
@@ -8,7 +8,8 @@ orderly_init(
   root = ".",
   path_archive = "archive",
   use_file_store = FALSE,
-  require_complete_tree = FALSE
+  require_complete_tree = FALSE,
+  force = FALSE
 )
 }
 \arguments{
@@ -35,6 +36,9 @@ always operates in recursive mode.  This is \code{FALSE} by default,
 but set to \code{TRUE} if you want your archive to behave well as a
 location; if \code{TRUE} you will always have all the packets that
 you hold metadata about.}
+
+\item{force}{Logical, indicating if we shold initialise orderly
+even if the directory is not empty.}
 }
 \value{
 The full, normalised, path to the root,
diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R
index 3a510bab..f47bdfa3 100644
--- a/tests/testthat/test-init.R
+++ b/tests/testthat/test-init.R
@@ -188,3 +188,28 @@ test_that("create root in wd by default", {
   expect_true(file.exists(file.path(path, ".outpack")))
   expect_true(file.exists(file.path(path, "orderly_config.yml")))
 })
+
+
+test_that("allow rstudio files to exist for init", {
+  tmp <- withr::local_tempdir()
+  file.create(file.path(tmp, "foo.Rproj"))
+  dir.create(file.path(tmp, ".Rproj.user"))
+  dir.create(file.path(tmp, ".git"))
+  file.create(file.path(tmp, ".Rhistory"))
+  file.create(file.path(tmp, ".gitignore"))
+
+  expect_no_error(orderly_init_quietly(tmp))
+  expect_true(file.exists(file.path(tmp, ".outpack")))
+  expect_true(file.exists(file.path(tmp, "orderly_config.yml")))
+})
+
+
+test_that("force initialisation of non-empty directory", {
+  tmp <- tempfile()
+  fs::dir_create(tmp)
+  on.exit(unlink(tmp, recursive = TRUE))
+  file.create(file.path(tmp, "file"))
+  expect_no_error(orderly_init_quietly(tmp, force = TRUE))
+  expect_true(file.exists(file.path(tmp, ".outpack")))
+  expect_true(file.exists(file.path(tmp, "orderly_config.yml")))
+})