diff --git a/DESCRIPTION b/DESCRIPTION index dc4ddc87..fa203067 100644 --- a/DESCRIPTION +++ b/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 = "rich.fitzjohn@gmail.com"), person("Robert", "Ashton", role = "aut"), @@ -22,6 +22,7 @@ Imports: jsonlite, openssl, rlang, + rstudioapi, withr, yaml Suggests: diff --git a/R/interactive.R b/R/interactive.R index e97200f6..e30a814b 100644 --- a/R/interactive.R +++ b/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, "../.."))) } diff --git a/R/util.R b/R/util.R index 0c9bdcdc..4178fb8b 100644 --- a/R/util.R +++ b/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") +} diff --git a/tests/testthat/test-interactive.R b/tests/testthat/test-interactive.R index 1fb86052..96315a70 100644 --- a/tests/testthat/test-interactive.R +++ b/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"')