Merge pull request #120 from mrc-ide/mrc-4956

Improve error message when using orderly interactively.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: orderly2
 Title: Orderly Next Generation
-Version: 1.99.10
+Version: 1.99.11
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "[email protected]"),
              person("Robert", "Ashton", role = "aut"),
@@ -22,6 +22,7 @@ Imports:
     jsonlite,
     openssl,
     rlang,
+    rstudioapi,
     withr,
     yaml
 Suggests:

R/interactive.R

@@ -1,16 +1,62 @@
+is_plausible_orderly_report <- function(path) {
+  path_split <- fs::path_split(path)[[1]]
+
+  length(path_split) > 2 &&
+    path_split[[length(path_split) - 1]] == "src" &&
+    file.exists(file.path(path, "../..", "orderly_config.yml"))
+}
+
+rstudio_get_current_active_editor_path <- function() {
+  # Avoid looking at the RStudio state when running tests inside of it.
+  if (!is_testing() && rstudioapi::isAvailable()) {
+    rstudioapi::getSourceEditorContext()$path
+  } else {
+    NULL
+  }
+}
+
 ## This is something that we might improve over time - it will likely
 ## be useful to have some sort of "register interactive" function
 ## which we could then just look up.
 ##
 ## I am not sure if we also want to allow working interactively from a
 ## draft directory too.
-detect_orderly_interactive_path <- function(path = getwd()) {
-  path_split <- fs::path_split(path)[[1]]
-  is_plausible <- length(path_split) > 2 &&
-    path_split[[length(path_split) - 1]] == "src" &&
-    file.exists(file.path(path, "../..", "orderly_config.yml"))
-  if (!is_plausible) {
-    stop(sprintf("Failed to detect orderly path at '%s'", path))
+detect_orderly_interactive_path <- function(
+  path = getwd(),
+  editor_path = rstudio_get_current_active_editor_path()) {
+  is_valid <- is_plausible_orderly_report(path)
+  suggested_wd <- NULL
+  if (!is.null(editor_path)) {
+    dir <- fs::path_dir(editor_path)
+    if (!paths_are_identical(dir, path) && is_plausible_orderly_report(dir)) {
+      suggested_wd <- dir
+    }
+  }
+
+  if (!is_plausible_orderly_report(path)) {
+    msg <- c("Working directory {.path {path}} is not a valid orderly report.")
+    if (!is.null(suggested_wd)) {
+      cli::cli_abort(c(msg, i = paste(
+        "Use {.code setwd({.str {suggested_wd}})} to set the working",
+        "directory to the report currently open in RStudio.")))
+    } else {
+      cli::cli_abort(msg)
+    }
+  }
+
+  if (!is.null(suggested_wd)) {
+    # For some reason, cli_warn has a different behaviour than cli_abort and
+    # doesn't make individual bullet points available in the condition object.
+    # The following mimicks cli_abort more closely, making testing easier.
+    # https://github.com/r-lib/cli/issues/666
+    msg <- c(
+      cli::format_inline(paste(
+        "Working directory {.path {path}} does not match the report currently",
+        "open in RStudio.")),
+      i = cli::format_inline(paste(
+        "Use {.code setwd({.str {suggested_wd}})}",
+        "to switch working directories.")))
+    rlang::warn(msg, use_cli_format = TRUE)
   }
   as.character(fs::path_norm(file.path(path, "../..")))
 }

R/util.R

@@ -632,3 +632,15 @@ saverds_atomic <- function(data, path, allow_fail = FALSE) {
       finally = unlink(tmp))
   }
 }
+
+
+paths_are_identical <- function(x, y) {
+  fs::path_norm(x) == fs::path_norm(y)
+}
+
+
+is_testing <- function() {
+  # Copied from testthat, to avoid having the package as a run-time dependency.
+  # https://github.com/r-lib/testthat/blob/fe50a22/R/test-env.R#L20
+  identical(Sys.getenv("TESTTHAT"), "true")
+}

tests/testthat/test-interactive.R

@@ -1,18 +1,99 @@
 test_that("can detect orderly directory", {
-  path <- test_prepare_orderly_example("explicit")
-  envir <- new.env()
-  id <- orderly_run_quietly("explicit", root = path, envir = envir)
+  root <- test_prepare_orderly_example("explicit")
+  detected_root <- detect_orderly_interactive_path(
+    file.path(root, "src", "explicit"))
+  expect_equal(detected_root, root)
+})
+
+test_that("errors when working directory is not report", {
+  root <- test_prepare_orderly_example("explicit")
 
   expect_error(
-    detect_orderly_interactive_path(path),
-    "Failed to detect orderly path at")
+    detect_orderly_interactive_path(root),
+    "Working directory .* is not a valid orderly report.")
+
   expect_error(
-    detect_orderly_interactive_path(file.path(path, "src")),
-    "Failed to detect orderly path at")
-  root <- detect_orderly_interactive_path(file.path(path, "src", "explicit"))
-  expect_equal(path, root)
+    detect_orderly_interactive_path(file.path(root, "src")),
+    "Working directory .* is not a valid orderly report.")
+})
+
+test_that("suggests changing working directory", {
+  root <- test_prepare_orderly_example(c("explicit", "implicit"))
+
+  e <- expect_error(detect_orderly_interactive_path(
+    path = file.path(root, "src"),
+    editor_path = file.path(root, "src", "implicit", "orderly.R")),
+    "Working directory .* is not a valid orderly report")
+  expect_match(e$body[[1]], paste(
+    "Use `setwd(.*)` to set the working directory",
+    "to the report currently open in RStudio"))
+
+  w <- expect_warning(detect_orderly_interactive_path(
+    path = file.path(root, "src", "explicit"),
+    editor_path = file.path(root, "src", "implicit", "orderly.R")),
+    "Working directory .* does not match the report currently open in RStudio")
+  expect_match(w$body[[1]], "Use `setwd(.*)` to switch working directories")
 })
 
+test_that("does not unnecessarily suggest changing working directory", {
+  root <- test_prepare_orderly_example("explicit")
+
+  # Editor path is already the current working directory
+  expect_no_warning(detect_orderly_interactive_path(
+    path = file.path(root, "src", "explicit"),
+    editor_path = file.path(root, "src", "explicit", "orderly.R")
+  ))
+
+  # Editor path is not an orderly report
+  expect_no_warning(detect_orderly_interactive_path(
+    path = file.path(root, "src", "explicit"),
+    editor_path = file.path(root, "orderly_config.yml")
+  ))
+
+  # Editor path is an unsaved file
+  expect_no_warning(detect_orderly_interactive_path(
+    path = file.path(root, "src", "explicit"),
+    editor_path = "Untitled"
+  ))
+})
+
+test_that("rstudio API is not called when unavailable", {
+  testthat::skip_if_not_installed("mockery")
+  mock_rstudio_available <- mockery::mock(FALSE)
+  mock_rstudio_context <- mockery::mock()
+  mockery::stub(
+    rstudio_get_current_active_editor_path,
+    "is_testing",
+    mockery::mock(FALSE))
+  mockery::stub(
+    rstudio_get_current_active_editor_path,
+    "rstudioapi::isAvailable",
+    mock_rstudio_available)
+  mockery::stub(
+    rstudio_get_current_active_editor_path,
+    "rstudioapi::getSourceEditorContext",
+    mockery::mock(FALSE))
+  expect_null(rstudio_get_current_active_editor_path())
+  mockery::expect_called(mock_rstudio_available, 1)
+  mockery::expect_called(mock_rstudio_context, 0)
+})
+
+test_that("rstudio API is used to find current editor path", {
+  testthat::skip_if_not_installed("mockery")
+  mockery::stub(
+    rstudio_get_current_active_editor_path,
+    "is_testing",
+    mockery::mock(FALSE))
+  mockery::stub(
+    rstudio_get_current_active_editor_path,
+    "rstudioapi::isAvailable",
+    mockery::mock(TRUE))
+  mockery::stub(
+    rstudio_get_current_active_editor_path,
+    "rstudioapi::getSourceEditorContext",
+    mockery::mock(list(path = "/path/to/file")))
+  expect_equal(rstudio_get_current_active_editor_path(), "/path/to/file")
+})
 
 test_that("can validate interactive parameters", {
   mock_readline <- mockery::mock("TRUE", "100", "1.23", '"string"')