Skip to content

Commit

Permalink
Merge pull request #97 from Appsilon/objects-in-strings
Browse files Browse the repository at this point in the history
Handle objects in {glue} string templates
  • Loading branch information
radbasa authored May 29, 2024
2 parents c46ee76 + db2730f commit c8a41d1
Show file tree
Hide file tree
Showing 17 changed files with 666 additions and 13 deletions.
8 changes: 4 additions & 4 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: box.linters
Title: Linters for 'box' Modules
Version: 0.9.0.9004
Version: 0.9.0.9005
Authors@R:
c(
person("Ricardo Rodrigo", "Basa", role = c("aut", "cre"), email = "[email protected]"),
Expand All @@ -23,7 +23,9 @@ Imports:
glue,
lintr (>= 3.0.0),
rlang,
xml2
stringr,
xml2,
xmlparsedata
Suggests:
box,
covr,
Expand All @@ -36,10 +38,8 @@ Suggests:
rhino,
shiny,
spelling,
stringr,
testthat (>= 3.0.0),
withr,
xmlparsedata
Config/testthat/edition: 3
Config/testthat/parallel: true
Language: en-US
1 change: 1 addition & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
# box.linters (development version)

* Added handler for `glue` string templates.
* Added box_mod_fun_exists_linter() to default linters
* [bug fix] box_trailing_commas_linter() now properly handles a #nolint for other linters
* [bug fix] `box_unused_att_pkg_fun_linter()` had issues with lists of functions. Linter function
Expand Down
7 changes: 5 additions & 2 deletions R/box_unused_attached_mod_linter.R
Original file line number Diff line number Diff line change
Expand Up @@ -82,6 +82,9 @@ box_unused_attached_mod_linter <- function() {
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)

all_calls_text <- c(function_calls$text, glue_object_calls)

unused_module <- lapply(attached_modules$xml, function(attached_module) {
module_text <- basename(lintr::get_r_string(attached_module))
Expand All @@ -93,7 +96,7 @@ box_unused_attached_mod_linter <- function() {
sep = "$"
)

functions_used <- length(intersect(func_list, function_calls$text))
functions_used <- length(intersect(func_list, all_calls_text))

if (functions_used == 0) {
lintr::xml_nodes_to_lints(
Expand All @@ -109,7 +112,7 @@ box_unused_attached_mod_linter <- function() {
module_text <- basename(lintr::get_r_string(attached_module))
module_text <- sub("\\[\\.\\.\\.\\]", "", module_text)
func_list <- attached_three_dots$nested[[module_text]]
functions_used <- length(intersect(func_list, function_calls$text))
functions_used <- length(intersect(func_list, all_calls_text))

if (functions_used == 0) {
lintr::xml_nodes_to_lints(
Expand Down
3 changes: 2 additions & 1 deletion R/box_unused_attached_mod_obj_linter.R
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,8 @@ box_unused_att_mod_obj_linter <- function() {
attached_functions_objects <- get_attached_mod_functions(xml)
function_calls <- get_function_calls(xml)
object_calls <- get_object_calls(xml)
all_object_calls_text <- c(function_calls$text, object_calls$text)
glue_object_calls <- get_objects_in_strings(xml)
all_object_calls_text <- c(function_calls$text, object_calls$text, glue_object_calls)

lapply(attached_functions_objects$xml, function(fun_obj_import) {
fun_obj_import_text <- xml2::xml_text(fun_obj_import)
Expand Down
5 changes: 4 additions & 1 deletion R/box_unused_attached_pkg_fun_linter.R
Original file line number Diff line number Diff line change
Expand Up @@ -69,12 +69,15 @@ box_unused_att_pkg_fun_linter <- function() {
FUN.VALUE = character(1)
)

glue_object_calls <- get_objects_in_strings(xml)
all_calls_text <- c(function_calls$text, glue_object_calls)

lapply(attached_functions$xml, function(fun_import) {
fun_import_text <- xml2::xml_text(fun_import)
fun_import_text <- gsub("[`'\"]", "", fun_import_text)
aliased_fun_import_text <- attached_functions$text[fun_import_text]

if (!aliased_fun_import_text %in% function_calls$text) {
if (!aliased_fun_import_text %in% all_calls_text) {
lintr::xml_nodes_to_lints(
fun_import,
source_expression = source_expression,
Expand Down
7 changes: 5 additions & 2 deletions R/box_unused_attached_pkg_linter.R
Original file line number Diff line number Diff line change
Expand Up @@ -80,6 +80,9 @@ box_unused_attached_pkg_linter <- function() {
attached_packages <- get_attached_packages(xml)
attached_three_dots <- get_attached_pkg_three_dots(xml)
function_calls <- get_function_calls(xml)
glue_object_calls <- get_objects_in_strings(xml)

all_calls_text <- c(function_calls$text, glue_object_calls)

unused_package <- lapply(attached_packages$xml, function(attached_package) {
package_text <- lintr::get_r_string(attached_package)
Expand All @@ -91,7 +94,7 @@ box_unused_attached_pkg_linter <- function() {
sep = "$"
)

functions_used <- length(intersect(func_list, function_calls$text))
functions_used <- length(intersect(func_list, all_calls_text))

if (functions_used == 0) {
lintr::xml_nodes_to_lints(
Expand All @@ -106,7 +109,7 @@ box_unused_attached_pkg_linter <- function() {
unused_three_dots <- lapply(attached_three_dots$xml, function(attached_package) {
package_text <- lintr::get_r_string(attached_package)
func_list <- attached_three_dots$nested[[package_text]]
functions_used <- length(intersect(func_list, function_calls$text))
functions_used <- length(intersect(func_list, all_calls_text))

if (functions_used == 0) {
lintr::xml_nodes_to_lints(
Expand Down
3 changes: 2 additions & 1 deletion R/box_usage_helper_functions.R
Original file line number Diff line number Diff line change
Expand Up @@ -109,12 +109,13 @@ get_object_calls <- function(xml) {

xpath_all_object_calls <- "
.//expr[
./SYMBOL and
not(
following-sibling::LEFT_ASSIGN or
following-sibling::EQ_ASSIGN
)
]
/SYMBOL"
"
xml_object_calls <- xml2::xml_find_all(xml_no_box_use, xpath_all_object_calls)
text <- xml2::xml_text(xml_object_calls, trim = TRUE)

Expand Down
41 changes: 41 additions & 0 deletions R/get_objects_in_strings.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,41 @@
#' Get objects used in `glue` string templates
#'
#' @description
#' In `glue`, all text between `{` and `}` is considered code. Literal braces are defined as
#' `{{` and `}}`. Text between double braces are not interpolated.
#'
#' @param xml An xml node list.
#' @return A character vector of object and function names found inside `glue` string templates.
#' @keywords internal
get_objects_in_strings <- function(xml) {
xpath_str_consts <- "
//expr/STR_CONST
"

all_strings <- extract_xml_and_text(xml, xpath_str_consts)
text_between_braces <- stringr::str_match_all(all_strings$text, "(\\{(?:\\{??[^\\{]*?\\}))")

tryCatch({
unlist(
lapply(text_between_braces, function(each_text) {
if (identical(each_text[, 2], character(0))) {
return(NULL)
}

parsed_code <- parse(text = each_text[, 2], keep.source = TRUE)
xml_parsed_code <- xml2::read_xml(xmlparsedata::xml_parse_data(parsed_code))
objects_called <- get_object_calls(xml_parsed_code)
functions_calls <- get_function_calls(xml_parsed_code)

return(
c(
objects_called$text,
functions_calls$text
)
)
})
)
}, error = function(e) {
return(NULL)
})
}
3 changes: 2 additions & 1 deletion R/unused_declared_object_linter.R
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,8 @@ unused_declared_object_linter <- function() {
exported_objects <- get_exported_objects(xml)
function_calls <- get_function_calls(xml)
object_calls <- get_object_calls(xml)
local_calls_text <- c(function_calls$text, object_calls$text)
glue_object_calls <- get_objects_in_strings(xml)
local_calls_text <- c(function_calls$text, object_calls$text, glue_object_calls)

lapply(fun_assignments$xml_nodes, function(fun_assign) {
fun_assign_text <- xml2::xml_text(fun_assign)
Expand Down
19 changes: 19 additions & 0 deletions man/get_objects_in_strings.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

145 changes: 145 additions & 0 deletions tests/testthat/test-box_unused_attached_mod_linter.R
Original file line number Diff line number Diff line change
Expand Up @@ -124,3 +124,148 @@ test_that("box_unused_mod_linter blocks unused three-dots attached packages", {
lintr::expect_lint(bad_box_usage, list(message = lint_message), linter)

})


# Glue compatibility

test_that("box_unused_attached_mod_linter skips objects used in glue string templates", {
linter <- box_unused_attached_mod_linter()

good_box_usage <- "box::use(
glue,
)
box::use(
path/to/module_b,
)
glue$glue(\"This {module_b$b_obj_a} should be parsed.\")
"

lintr::expect_lint(good_box_usage, NULL, linters = linter)
})

test_that("box_unused_attached_mod_linter skips functions used in glue string templates", {
linter <- box_unused_attached_mod_linter()

good_box_usage <- "box::use(
glue[glue],
)
box::use(
path/to/module_b,
)
glue(\"This {module_b$b_fun_a()} should be parsed.\")
"

lintr::expect_lint(good_box_usage, NULL, linters = linter)
})

test_that("box_unused_attached_mod_linter skips literal braces in glue string templates", {
linter <- box_unused_attached_mod_linter()
lint_message <- rex::rex("Attached module unused.")

bad_box_usage <- "box::use(
glue[glue],
)
box::use(
path/to/module_b,
)
glue(\"This {{module_b$b_obj_a}} should be parsed.\")
"

lintr::expect_lint(bad_box_usage, list(message = lint_message), linters = linter)
})

test_that("box_unused_attached_mod_linter blocks unused objects in glue string templates", {
linter <- box_unused_attached_mod_linter()
lint_message <- rex::rex("Attached module unused.")

bad_box_usage <- "box::use(
glue[glue],
)
box::use(
path/to/module_b,
)
glue(\"This does not have a parseable object.\")
"

lintr::expect_lint(bad_box_usage, list(message = lint_message), linters = linter)
})

# Glue compatibility three dots

test_that("box_unused_attached_mod_linter skips objects used in glue string templates", {
linter <- box_unused_attached_mod_linter()

good_box_usage <- "box::use(
glue[glue],
)
box::use(
path/to/module_b[...],
)
glue(\"This {b_obj_a} should be parsed.\")
"

lintr::expect_lint(good_box_usage, NULL, linters = linter)
})

test_that("box_unused_attached_mod_linter skips functions used in glue string templates", {
linter <- box_unused_attached_mod_linter()

good_box_usage <- "box::use(
glue[glue],
)
box::use(
path/to/module_b[...],
)
glue(\"This {b_fun_a()} should be parsed.\")
"

lintr::expect_lint(good_box_usage, NULL, linters = linter)
})

test_that("box_unused_attached_mod_linter skips literal braces in glue string templates", {
linter <- box_unused_attached_mod_linter()
lint_message <- rex::rex("Three-dots attached module unused.")

bad_box_usage <- "box::use(
glue[glue],
)
box::use(
path/to/module_b[...],
)
glue(\"This {{b_obj_a}} should be parsed.\")
"

lintr::expect_lint(bad_box_usage, list(message = lint_message), linters = linter)
})

test_that("box_unused_attached_mod_linter blocks unused objects in glue string templates", {
linter <- box_unused_attached_mod_linter()
lint_message <- rex::rex("Three-dots attached module unused.")

bad_box_usage <- "box::use(
glue[glue],
)
box::use(
path/to/module_b[...],
)
glue(\"This does not have a parseable object.\")
"

lintr::expect_lint(bad_box_usage, list(message = lint_message), linters = linter)
})
Loading

0 comments on commit c8a41d1

Please sign in to comment.