Create friction to discourage creating a project in home directory

Motivated by #1336

Author: jennybc

R/create.R

@@ -44,7 +44,8 @@ create_package <- function(path,
   if (check_name) {
     check_package_name(name)
   }
-  check_not_nested(path_dir(path), name)
+  challenge_nested_project(path_dir(path), name)
+  challenge_home_directory(path)
 
   create_directory(path)
   local_project(path, force = TRUE)
@@ -75,7 +76,8 @@ create_project <- function(path,
                            open = rlang::is_interactive()) {
   path <- user_path_prep(path)
   name <- path_file(path_abs(path))
-  check_not_nested(path_dir(path), name)
+  challenge_nested_project(path_dir(path), name)
+  challenge_home_directory(path)
 
   create_directory(path)
   local_project(path, force = TRUE)
@@ -246,7 +248,7 @@ create_from_github <- function(repo_spec,
 
   destdir <- user_path_prep(destdir %||% conspicuous_place())
   check_path_is_directory(destdir)
-  check_not_nested(destdir, repo_name)
+  challenge_nested_project(destdir, repo_name)
   repo_path <- path(destdir, repo_name)
   create_directory(repo_path)
   check_directory_is_empty(repo_path)
@@ -309,7 +311,7 @@ create_from_github <- function(repo_spec,
 # creates a backdoor we can exploit in tests
 allow_nested_project <- function() FALSE
 
-check_not_nested <- function(path, name) {
+challenge_nested_project <- function(path, name) {
   if (!possibly_in_proj(path)) {
     return(invisible())
   }
@@ -331,3 +333,24 @@ check_not_nested <- function(path, name) {
   }
   invisible()
 }
+
+challenge_home_directory <- function(path) {
+  homes <- unique(c(path_home(), path_home_r()))
+  if (!path %in% homes) {
+    return(invisible())
+  }
+
+  qualification <- if (is_windows()) {
+    glue("a special directory, i.e. some applications regard it as ")
+  } else {
+    ""
+  }
+  ui_line("
+    {ui_path(path)} is {qualification}your home directory.
+    It is generally a bad idea to create a new project here.
+    You should probably create your new project in a subdirectory.")
+  if (ui_nope("Do you want to create anyway?")) {
+    ui_stop("Good move! Cancelling project creation.")
+  }
+  invisible()
+}

R/rstudio.R

@@ -170,7 +170,7 @@ rstudio_git_tickle <- function() {
 }
 
 rstudio_config_path <- function(...) {
-  if (.Platform$OS.type == "windows") {
+  if (is_windows()) {
     # https://github.com/r-lib/usethis/issues/1293
     base <- rappdirs::user_config_dir("RStudio", appauthor = NULL)
   } else {

R/utils.R

@@ -103,3 +103,7 @@ pluck_chr <- function(.x, ...) {
 pluck_int <- function(.x, ...) {
   as_integer(purrr::pluck(.x, ..., .default = NA))
 }
+
+is_windows <- function() {
+  .Platform$OS.type == "windows"
+}

tests/testthat/test-create.R

@@ -137,3 +137,14 @@ test_that("create_*() works w/ non-existing rel path, open = TRUE, not in RStudi
   expect_equal(path_wd(), out_path)
   expect_equal(proj_get(), out_path)
 })
+
+test_that("we discourage project creation in home directory", {
+  local_interactive(FALSE)
+  expect_usethis_error(create_package(path_home()), "create anyway")
+  expect_usethis_error(create_project(path_home()), "create anyway")
+
+  if (is_windows()) {
+    expect_usethis_error(create_package(path_home_r()), "create anyway")
+    expect_usethis_error(create_project(path_home_r()), "create anyway")
+  }
+})