Allow relative box module paths when box.path = NULL (#120)

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: box.linters
 Title: Linters for 'box' Modules
-Version: 0.9.1.9003
+Version: 0.9.1.9004
 Authors@R:
   c(
     person("Ricardo Rodrigo", "Basa", role = c("aut", "cre"), email = "[email protected]"),

NEWS.md

@@ -1,5 +1,6 @@
 # box.linters (development version)
 
+* [Bug fix] Allow relative box module paths (#110)
 * Less verbose `box_alphabetical_calls_linter()`. Reports only the first out-of-place function.
 * Added styling functions for `box::use()` calls.
 * [Bug fix] Allow multiple `box::use(pkg)` calls (#111)

R/box_mod_fun_exists_linter.R

@@ -46,7 +46,11 @@ box_mod_fun_exists_linter <- function() {
 
     xml <- source_expression$full_xml_parsed_content
 
-    mod_fun_not_exists <- check_attached_mod_funs(xml, xpath_module_functions)
+    working_dir <- get_module_working_dir(source_expression)
+
+    withr::with_dir(working_dir, {
+      mod_fun_not_exists <- check_attached_mod_funs(xml, xpath_module_functions)
+    })
 
     lapply(mod_fun_not_exists$xml, function(xml_node) {
       lintr::xml_nodes_to_lints(

R/box_module_usage_helper_functions.R

@@ -181,3 +181,14 @@ get_attached_mod_functions <- function(xml) {
     text = attached_functions$text
   )
 }
+
+#' @keywords internal
+get_module_working_dir <- function(source_expression) {
+  box_path <- getOption("box.path")
+  if (is.null(box_path)) {
+    working_dir <- fs::path_dir(source_expression$filename)
+  } else {
+    working_dir <- box_path
+  }
+  working_dir
+}

R/box_unused_attached_mod_linter.R

@@ -79,8 +79,12 @@ box_unused_attached_mod_linter <- function() {
 
     xml <- source_expression$full_xml_parsed_content
 
-    attached_modules <- get_attached_modules(xml)
-    attached_three_dots <- get_attached_mod_three_dots(xml)
+    working_dir <- get_module_working_dir(source_expression)
+
+    withr::with_dir(working_dir, {
+      attached_modules <- get_attached_modules(xml)
+      attached_three_dots <- get_attached_mod_three_dots(xml)
+    })
     function_calls <- get_function_calls(xml)
     glue_object_calls <- get_objects_in_strings(xml)
     possible_module_calls <- get_object_calls(xml)

R/box_unused_attached_mod_obj_linter.R

@@ -61,7 +61,11 @@ box_unused_att_mod_obj_linter <- function() {
 
     xml <- source_expression$full_xml_parsed_content
 
-    attached_functions_objects <- get_attached_mod_functions(xml)
+    working_dir <- get_module_working_dir(source_expression)
+
+    withr::with_dir(working_dir, {
+      attached_functions_objects <- get_attached_mod_functions(xml)
+    })
     function_calls <- get_function_calls(xml)
     object_calls <- get_object_calls(xml)
     glue_object_calls <- get_objects_in_strings(xml)

tests/testthat/mod/path/relative/module_d.R

@@ -0,0 +1,5 @@
+box::use(
+  ../to/module_a
+)
+
+module_a$a_fun_a()

tests/testthat/mod/path/relative/module_e.R

@@ -0,0 +1,5 @@
+box::use(
+  ../to/module_a[a_fun_a]
+)
+
+a_fun_a()

tests/testthat/mod/path/relative/module_f.R

@@ -0,0 +1,5 @@
+box::use(
+  ../to/module_a[not_exist]
+)
+
+a_fun_a()

tests/testthat/mod/path/relative/module_g.R

@@ -0,0 +1,3 @@
+box::use(
+  ../to/module_a
+)

tests/testthat/test-box_mod_fun_exists_linter.R

@@ -69,3 +69,34 @@ test_that("box_mod_fun_exists_linter blocks aliased functions that do not exist
 
   lintr::expect_lint(bad_box_usage, list(message = lint_message), linter)
 })
+
+test_that("box_mod_fun_exists_linter allows relative module paths", {
+  linter <- box_mod_fun_exists_linter()
+
+  withr::with_options(
+    list(
+      "box.path" = NULL
+    ), {
+      withr::with_dir(file.path(getwd(), "mod", "path", "relative"), {
+        expect_no_message(lintr::lint("module_d.R", linters = linter))
+      })
+    }
+  )
+})
+
+test_that("box_mod_fun_exists_linter blocks non-existing functions in relative module paths", {
+  linter <- box_mod_fun_exists_linter()
+  lint_message <- "Function not exported by module."
+  withr::with_options(
+    list(
+      "box.path" = NULL
+    ), {
+      withr::with_dir(file.path(getwd(), "mod", "path", "relative"), {
+        result <- lintr::lint("module_f.R", linters = linter)
+      })
+    }
+  )
+
+  expect_s3_class(result, "lints")
+  expect_equal(result[[1]]$message, lint_message)
+})

tests/testthat/test-box_unused_attached_mod_linter.R

@@ -270,6 +270,35 @@ test_that("box_unused_attached_mod_linter blocks unused objects in glue string t
   lintr::expect_lint(bad_box_usage, list(message = lint_message), linters = linter)
 })
 
+test_that("box_unused_attached_mod_linter works with relative paths", {
+  linter <- box_unused_attached_mod_linter()
+
+  withr::with_options(
+    list(
+      "box.path" = NULL
+    ),
+    withr::with_dir(file.path(getwd(), "mod", "path", "relative"), {
+      expect_no_message(lintr::lint("module_d.R", linters = linter))
+    })
+  )
+})
+
+test_that("box_unused_attached_mod_linter detects unused modules with relative paths", {
+  linter <- box_unused_attached_mod_linter()
+  lint_message <- "Attached module unused."
+
+  withr::with_options(
+    list(
+      "box.path" = NULL
+    ),
+    withr::with_dir(file.path(getwd(), "mod", "path", "relative"), {
+      result <- lintr::lint("module_g.R", linters = linter)
+    })
+  )
+
+  expect_s3_class(result, "lints")
+  expect_equal(result[[1]]$message, lint_message)
+})
 
 # Box test interfaces, not implementations
 

tests/testthat/test-box_unused_attached_mod_obj_linter.R

@@ -209,3 +209,38 @@ test_that("box_unused_att_mod_obj_linter blocks unused objects in glue string te
 
   lintr::expect_lint(bad_box_usage, list(message = lint_message), linters = linter)
 })
+
+test_that("box_unused_att_mod_obj_linter allows relative module paths", {
+  linter <- box_unused_att_mod_obj_linter()
+
+  withr::with_options(
+    list(
+      "box.path" = NULL
+    ), {
+      withr::with_dir(file.path(getwd(), "mod", "path", "relative"), {
+        code <- "box::use(../to/module_a[a_fun_a])
+        a_fun_a()
+        "
+        lintr::expect_lint(code, NULL, linters = linter)
+
+      })
+    }
+  )
+})
+
+test_that("box_unused_att_mod_obj_linter blocks unused functions from relative module paths", {
+  linter <- box_unused_att_mod_obj_linter()
+  lint_message <- rex::rex("Imported function/object unused.")
+
+  withr::with_options(
+    list(
+      "box.path" = NULL
+    ), {
+      withr::with_dir(file.path(getwd(), "mod", "path", "relative"), {
+        code <- "box::use(../to/module_a[a_fun_a])
+        "
+        lintr::expect_lint(code, list(message = lint_message), linters = linter)
+      })
+    }
+  )
+})