From bf390de6a3f66c1827722fb81d8b2cb6aafeb004 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 1 Aug 2023 21:23:06 +0000 Subject: [PATCH 01/16] keyword_quote_linter for unnecessary quoting --- DESCRIPTION | 1 + NAMESPACE | 1 + R/keyword_quote_linter.R | 129 ++++++++++++ inst/lintr/linters.csv | 1 + man/consistency_linters.Rd | 1 + man/keyword_quote_linter.Rd | 24 +++ man/linters.Rd | 7 +- man/readability_linters.Rd | 1 + man/style_linters.Rd | 1 + tests/testthat/test-keyword_quote_linter.R | 232 +++++++++++++++++++++ 10 files changed, 395 insertions(+), 3 deletions(-) create mode 100644 R/keyword_quote_linter.R create mode 100644 man/keyword_quote_linter.Rd create mode 100644 tests/testthat/test-keyword_quote_linter.R diff --git a/DESCRIPTION b/DESCRIPTION index 0358b669f..d57706fa8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -113,6 +113,7 @@ Collate: 'inner_combine_linter.R' 'is_lint_level.R' 'is_numeric_linter.R' + 'keyword_quote_linter.R' 'lengths_linter.R' 'line_length_linter.R' 'lint.R' diff --git a/NAMESPACE b/NAMESPACE index 5caba4239..6347b954f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -77,6 +77,7 @@ export(infix_spaces_linter) export(inner_combine_linter) export(is_lint_level) export(is_numeric_linter) +export(keyword_quote_linter) export(lengths_linter) export(line_length_linter) export(lint) diff --git a/R/keyword_quote_linter.R b/R/keyword_quote_linter.R new file mode 100644 index 000000000..1937691d1 --- /dev/null +++ b/R/keyword_quote_linter.R @@ -0,0 +1,129 @@ +#' Block unnecessary quoting in calls +#' +#' Any valid symbol can be used as a keyword argument to an R function call. +#' Sometimes, it is necessary to quote (or backtick) an argument that is +#' not an otherwise valid symbol (e.g. creating a vector whose names have +#' spaces); besides this edge case, quoting should not be done. +#' +#' The most common source of violation for this is creating named vectors, +#' lists, or data.frame-alikes, but it can be observed in other calls as well. +#' +#' @evalRd rd_tags("keyword_quote_linter") +#' @seealso [linters] for a complete list of linters available in lintr. +#' @export +# TODO(michaelchirico): offer a stricter version of this that +# requires backticks to be used for non-syntactic names (i.e., not quotes). +# Here are the relevant xpaths: +# //expr[expr[SYMBOL_FUNCTION_CALL]]/SYMBOL_SUB[starts-with(text(), '`')] +# //expr[expr[SYMBOL_FUNCTION_CALL]]/STR_CONST[{is_quoted(text())}] +keyword_quote_linter <- function() { + # NB: xml2 uses xpath 1.0 which doesn't support matches() for regex, so we + # have to jump out of xpath to complete this lint. + # It's also a bit tough to get the escaping through R and then xpath to + # work as intended, hence the rather verbose declaration here. + quote_cond <- xp_or( + "starts-with(text(), '\"')", + "starts-with(text(), '`')", + 'starts-with(text(), "\'")' + ) + # SYMBOL_SUB for backticks, STR_CONST for quoted names + call_arg_xpath <- glue(" + //SYMBOL_FUNCTION_CALL + /parent::expr + /parent::expr + /*[(self::SYMBOL_SUB or self::STR_CONST) and {quote_cond}] + ") + + # also exclude $ or @, which are handled below + assignment_xpath <- " + (//EQ_ASSIGN | //LEFT_ASSIGN[text() != ':=']) + /preceding-sibling::expr[ + not(OP-DOLLAR or OP-AT) + and (STR_CONST or SYMBOL[starts-with(text(), '`')]) + ] + " + + extraction_xpath <- " + (//OP-DOLLAR | //OP-AT)/following-sibling::STR_CONST + | //OP-DOLLAR/following-sibling::SYMBOL[starts-with(text(), '`')] + | //OP-AT/following-sibling::SLOT[starts-with(text(), '`')] + " + + return(Linter(function(source_expression) { + if (!is_lint_level(source_expression, "expression")) { + return(list()) + } + + xml <- source_expression$xml_parsed_content + + call_arg_expr <- xml_find_all(xml, call_arg_xpath) + + invalid_call_quoting <- is_valid_r_name(get_r_string(call_arg_expr)) + + call_arg_lints <- xml_nodes_to_lints( + call_arg_expr[invalid_call_quoting], + source_expression = source_expression, + lint_message = "Only quote named arguments to functions if necessary, i.e., the name is not a valid R symbol (see ?make.names).", + type = "warning" + ) + + assignment_expr <- xml_find_all(xml, assignment_xpath) + + invalid_assignment_quoting <- is_valid_r_name(get_r_string(assignment_expr), no_quote = TRUE) + + assignment_lints <- xml_nodes_to_lints( + assignment_expr[invalid_assignment_quoting], + source_expression = source_expression, + lint_message = paste( + "Only quote targets of assignment if necessary, i.e., the name is not a valid R symbol (see ?make.names).", + "If necessary, use backticks to create non-syntactic names, not quotes." + ), + type = "warning" + ) + + extraction_expr <- xml_find_all(xml, extraction_xpath) + + invalid_extraction_quoting <- + is_valid_r_name(get_r_string(extraction_expr), no_quote = TRUE) + + extraction_expr <- extraction_expr[invalid_extraction_quoting] + extractor <- xml_find_chr(extraction_expr, "string(preceding-sibling::*[1])") + gen_extractor <- ifelse(extractor == "$", "[[", "slot()") + + extraction_lints <- xml_nodes_to_lints( + extraction_expr[invalid_extraction_quoting], + source_expression = source_expression, + lint_message = paste( + "Only quote targets of extraction with", extractor, "if necessary, i.e., the name is not a valid R symbol (see ?make.names).", + "If necessary, use backticks to create non-syntactic names, not quotes, or use", gen_extractor, "to extract by string." + ), + type = "warning" + ) + + return(c(call_arg_lints, assignment_lints, extraction_lints)) + })) +} + +# from ?Reserved +r_reserved_words <- c( + "if", "else", "repeat", "while", "function", "for", "in", "next", "break", + "TRUE", "FALSE", "NULL", "Inf", "NaN", "NA", + "NA_integer_", "NA_real_", "NA_complex_", "NA_character_" +) + +#' Check if a string could be assigned as an R variable. +#' +#' considered valid, i.e., anything wrapped in '' or "" is linted. +#' +#' See [make.names()] for the description of syntactically valid names in R. +#' we could also replace this with `make.names(x) == x` +#' @noRd +is_valid_r_name <- function(x, no_quote = FALSE) { + if (no_quote) { + bad_quote <- !startsWith(x, "`") + } else { + bad_quote <- FALSE + } + is_valid_symbol <- grepl("^([a-zA-Z][a-zA-Z0-9._]*|[.]|[.][a-zA-Z._][a-zA-Z0-9._]*)$", x) + return(bad_quote | (is_valid_symbol & !(x %in% r_reserved_words))) +} diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index e6bbebaed..79488335a 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -41,6 +41,7 @@ indentation_linter,style readability default configurable infix_spaces_linter,style readability default configurable inner_combine_linter,efficiency consistency readability is_numeric_linter,readability best_practices consistency +keyword_quote_linter,readability consistency style lengths_linter,efficiency readability best_practices line_length_linter,style readability default configurable literal_coercion_linter,best_practices consistency efficiency diff --git a/man/consistency_linters.Rd b/man/consistency_linters.Rd index 9a500bea1..7d4d401be 100644 --- a/man/consistency_linters.Rd +++ b/man/consistency_linters.Rd @@ -21,6 +21,7 @@ The following linters are tagged with 'consistency': \item{\code{\link{implicit_integer_linter}}} \item{\code{\link{inner_combine_linter}}} \item{\code{\link{is_numeric_linter}}} +\item{\code{\link{keyword_quote_linter}}} \item{\code{\link{literal_coercion_linter}}} \item{\code{\link{numeric_leading_zero_linter}}} \item{\code{\link{object_name_linter}}} diff --git a/man/keyword_quote_linter.Rd b/man/keyword_quote_linter.Rd new file mode 100644 index 000000000..7c24f6065 --- /dev/null +++ b/man/keyword_quote_linter.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/keyword_quote_linter.R +\name{keyword_quote_linter} +\alias{keyword_quote_linter} +\title{Block unnecessary quoting in calls} +\usage{ +keyword_quote_linter() +} +\description{ +Any valid symbol can be used as a keyword argument to an R function call. +Sometimes, it is necessary to quote (or backtick) an argument that is +not an otherwise valid symbol (e.g. creating a vector whose names have +spaces); besides this edge case, quoting should not be done. +} +\details{ +The most common source of violation for this is creating named vectors, +lists, or data.frame-alikes, but it can be observed in other calls as well. +} +\seealso{ +\link{linters} for a complete list of linters available in lintr. +} +\section{Tags}{ +\link[=consistency_linters]{consistency}, \link[=readability_linters]{readability}, \link[=style_linters]{style} +} diff --git a/man/linters.Rd b/man/linters.Rd index 8cce38cf6..c8dff4b90 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -20,16 +20,16 @@ The following tags exist: \item{\link[=best_practices_linters]{best_practices} (50 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (7 linters)} \item{\link[=configurable_linters]{configurable} (29 linters)} -\item{\link[=consistency_linters]{consistency} (18 linters)} +\item{\link[=consistency_linters]{consistency} (19 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (25 linters)} \item{\link[=deprecated_linters]{deprecated} (8 linters)} \item{\link[=efficiency_linters]{efficiency} (23 linters)} \item{\link[=executing_linters]{executing} (5 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} -\item{\link[=readability_linters]{readability} (47 linters)} +\item{\link[=readability_linters]{readability} (48 linters)} \item{\link[=robustness_linters]{robustness} (14 linters)} -\item{\link[=style_linters]{style} (34 linters)} +\item{\link[=style_linters]{style} (35 linters)} } } \section{Linters}{ @@ -75,6 +75,7 @@ The following linters exist: \item{\code{\link{infix_spaces_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{inner_combine_linter}} (tags: consistency, efficiency, readability)} \item{\code{\link{is_numeric_linter}} (tags: best_practices, consistency, readability)} +\item{\code{\link{keyword_quote_linter}} (tags: consistency, readability, style)} \item{\code{\link{lengths_linter}} (tags: best_practices, efficiency, readability)} \item{\code{\link{line_length_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{literal_coercion_linter}} (tags: best_practices, consistency, efficiency)} diff --git a/man/readability_linters.Rd b/man/readability_linters.Rd index d1f32efec..c1e730773 100644 --- a/man/readability_linters.Rd +++ b/man/readability_linters.Rd @@ -33,6 +33,7 @@ The following linters are tagged with 'readability': \item{\code{\link{infix_spaces_linter}}} \item{\code{\link{inner_combine_linter}}} \item{\code{\link{is_numeric_linter}}} +\item{\code{\link{keyword_quote_linter}}} \item{\code{\link{lengths_linter}}} \item{\code{\link{line_length_linter}}} \item{\code{\link{matrix_apply_linter}}} diff --git a/man/style_linters.Rd b/man/style_linters.Rd index 1c4e93c17..a0a7213fd 100644 --- a/man/style_linters.Rd +++ b/man/style_linters.Rd @@ -25,6 +25,7 @@ The following linters are tagged with 'style': \item{\code{\link{implicit_integer_linter}}} \item{\code{\link{indentation_linter}}} \item{\code{\link{infix_spaces_linter}}} +\item{\code{\link{keyword_quote_linter}}} \item{\code{\link{line_length_linter}}} \item{\code{\link{numeric_leading_zero_linter}}} \item{\code{\link{object_length_linter}}} diff --git a/tests/testthat/test-keyword_quote_linter.R b/tests/testthat/test-keyword_quote_linter.R new file mode 100644 index 000000000..36cf18e9b --- /dev/null +++ b/tests/testthat/test-keyword_quote_linter.R @@ -0,0 +1,232 @@ +test_that("keyword_quote_linter skips allowed usages", { + # main use case: c() + expect_lint("x <- c(1, 2, 4, 5)", NULL, keyword_quote_linter()) + expect_lint("x <- c(a = 1, 2)", NULL, keyword_quote_linter()) + expect_lint("x <- c(a = 1, b = 2)", NULL, keyword_quote_linter()) + expect_lint("y <- c(`a b` = 1, `c d` = 2)", NULL, keyword_quote_linter()) + expect_lint('y <- c("a b" = 1, "c d" = 2)', NULL, keyword_quote_linter()) + expect_lint("z <- c('a b' = 1, c = 2)", NULL, keyword_quote_linter()) + + # other use cases: switch() and list() + expect_lint("list(a = 1, b = list(c = 2))", NULL, keyword_quote_linter()) + expect_lint("list(`a b` = 1, c = 2:6)", NULL, keyword_quote_linter()) + + expect_lint("switch(x, a = 1, b = 2)", NULL, keyword_quote_linter()) + expect_lint( + "switch(x, `a b` = 1, c = 2:6)", + NULL, + keyword_quote_linter() + ) +}) + +test_that("keyword_quote_linter blocks simple disallowed usages", { + expect_lint( + 'c("a" = 1, b = 2)', + rex::rex("Only quote named arguments to functions"), + keyword_quote_linter() + ) + + expect_lint( + "c('a' = 1, 'b' = 2)", + list( + "Only quote named arguments to functions", + "Only quote named arguments to functions" + ), + keyword_quote_linter() + ) + + expect_lint( + "c(`a` = 1, b = list(`c` = 2))", + list( + "Only quote named arguments to functions", + "Only quote named arguments to functions" + ), + keyword_quote_linter() + ) + + expect_lint( + "switch(x, `a` = c('b' = list(\"c\" = 1)))", + list( + "Only quote named arguments to functions", + "Only quote named arguments to functions", + "Only quote named arguments to functions" + ), + keyword_quote_linter() + ) +}) + +test_that("keyword_quote_linter skips quoting on reserved words", { + expect_lint("c(`next` = 1, `while` = 2)", NULL, keyword_quote_linter()) + expect_lint( + "switch(x, `for` = 3, `TRUE` = 4)", + NULL, + keyword_quote_linter() + ) + expect_lint("list('NA' = 5, 'Inf' = 6)", NULL, keyword_quote_linter()) +}) + +test_that("keyword_quote_linter works on more common functions", { + expect_lint( + "data.frame('a' = 1)", + rex::rex("Only quote named arguments to functions"), + keyword_quote_linter() + ) + expect_lint( + "data.table('a' = 1)", + rex::rex("Only quote named arguments to functions"), + keyword_quote_linter() + ) + expect_lint( + "data.table::data.table('a' = 1)", + rex::rex("Only quote named arguments to functions"), + keyword_quote_linter() + ) + expect_lint( + "rbind('a' = 1)", + rex::rex("Only quote named arguments to functions"), + keyword_quote_linter() + ) + expect_lint( + "cbind('a' = 1)", + rex::rex("Only quote named arguments to functions"), + keyword_quote_linter() + ) +}) + +test_that("keyword_quote_linter finds blocked usages in any function call", { + expect_lint( + "foo('a' = 1)", + rex::rex("Only quote named arguments to functions"), + keyword_quote_linter() + ) +}) + +test_that("keyword_quote_linter blocks quoted assignment targets", { + expect_lint( + '"foo bar" <- 1', + rex::rex("Only quote targets of assignment if necessary"), + keyword_quote_linter() + ) + expect_lint( + "'foo bar' = 1", + rex::rex("Only quote targets of assignment if necessary"), + keyword_quote_linter() + ) + # valid choice: use backticks + expect_lint("`foo bar` = 1", NULL, keyword_quote_linter()) + + expect_lint( + '"foo" <- 1', + rex::rex("Only quote targets of assignment if necessary"), + keyword_quote_linter() + ) + expect_lint( + "'foo' = 1", + rex::rex("Only quote targets of assignment if necessary"), + keyword_quote_linter() + ) + expect_lint( + "`foo` = 1", + rex::rex("Only quote targets of assignment if necessary"), + keyword_quote_linter() + ) + + # don't include data.table assignments + expect_lint('DT[, "a" := 1]', NULL, keyword_quote_linter()) + expect_lint("DT[, 'a' := 1]", NULL, keyword_quote_linter()) + expect_lint("DT[, `a` := 1]", NULL, keyword_quote_linter()) + + # include common use cases: [<-/$ methods and infixes + expect_lint( + '"$.my_class" <- function(x, key) { }', + rex::rex("Only quote targets of assignment if necessary"), + keyword_quote_linter() + ) + expect_lint( + "'Setter[<-.my_class' = function(x, idx, value) { }", + rex::rex("Only quote targets of assignment if necessary"), + keyword_quote_linter() + ) + expect_lint( + '"%nin%" <- function(x, table) !x %in% table', + rex::rex("Only quote targets of assignment if necessary"), + keyword_quote_linter() + ) +}) + +test_that("keyword_quote_linter blocks quoted $, @ extractions", { + expect_lint( + 'x$"foo bar" <- 1', + rex::rex("Only quote targets of extraction with $ if necessary"), + keyword_quote_linter() + ) + expect_lint( + "x$'foo bar' = 1", + rex::rex("Only quote targets of extraction with $ if necessary"), + keyword_quote_linter() + ) + expect_lint( + 'x@"foo bar" <- 1', + rex::rex("Only quote targets of extraction with @ if necessary"), + keyword_quote_linter() + ) + expect_lint( + "x@'foo bar' = 1", + rex::rex("Only quote targets of extraction with @ if necessary"), + keyword_quote_linter() + ) + # valid choice: non-syntactic name with backticks + expect_lint("x@`foo bar` <- 1", NULL, keyword_quote_linter()) + expect_lint("x@`foo bar` = 1", NULL, keyword_quote_linter()) + + expect_lint( + 'x$"foo" <- 1', + rex::rex("Only quote targets of extraction with $ if necessary"), + keyword_quote_linter() + ) + expect_lint( + "x$'foo' = 1", + rex::rex("Only quote targets of extraction with $ if necessary"), + keyword_quote_linter() + ) + expect_lint( + 'x@"foo" <- 1', + rex::rex("Only quote targets of extraction with @ if necessary"), + keyword_quote_linter() + ) + expect_lint( + "x@'foo' = 1", + rex::rex("Only quote targets of extraction with @ if necessary"), + keyword_quote_linter() + ) + expect_lint( + "x@`foo` <- 1", + rex::rex("Only quote targets of extraction with @ if necessary"), + keyword_quote_linter() + ) + expect_lint( + "x@`foo` = 1", + rex::rex("Only quote targets of extraction with @ if necessary"), + keyword_quote_linter() + ) +}) + +test_that("multiple lints are generated correctly", { + expect_lint( + c( + "{", + " foo('a' = 1)", + " 'b' <- 2", + " x$'c'", + " y@'d'", + "}" + ), + list( + list(message = "Only quote named arguments"), + list(message = "Only quote targets of assignment"), + list(message = "Only quote targets of extraction with \\$"), + list(message = "Only quote targets of extraction with @") + ), + keyword_quote_linter() + ) +}) From 9b528d0f5a2c09687d690f6a1a35fe4d06b18958 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 1 Aug 2023 21:25:35 +0000 Subject: [PATCH 02/16] trim_some --- tests/testthat/test-keyword_quote_linter.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-keyword_quote_linter.R b/tests/testthat/test-keyword_quote_linter.R index 36cf18e9b..0aa7a42dc 100644 --- a/tests/testthat/test-keyword_quote_linter.R +++ b/tests/testthat/test-keyword_quote_linter.R @@ -213,14 +213,14 @@ test_that("keyword_quote_linter blocks quoted $, @ extractions", { test_that("multiple lints are generated correctly", { expect_lint( - c( - "{", - " foo('a' = 1)", - " 'b' <- 2", - " x$'c'", - " y@'d'", - "}" - ), + trim_some(' + { + foo("a" = 1) + "b" <- 2 + x$"c" + y@"d" + } + '), list( list(message = "Only quote named arguments"), list(message = "Only quote targets of assignment"), From 93e173eaa3aff85b59b97735734f0841283b76ea Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 1 Aug 2023 21:30:31 +0000 Subject: [PATCH 03/16] import glue --- NAMESPACE | 1 + R/lintr-package.R | 1 + 2 files changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 6347b954f..3535130f6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -143,6 +143,7 @@ export(with_id) export(xml_nodes_to_lints) export(yoda_test_linter) importFrom(cyclocomp,cyclocomp) +importFrom(glue,glue) importFrom(rex,character_class) importFrom(rex,re_matches) importFrom(rex,re_substitutes) diff --git a/R/lintr-package.R b/R/lintr-package.R index 7ee7a3115..cb46d5ad9 100644 --- a/R/lintr-package.R +++ b/R/lintr-package.R @@ -8,6 +8,7 @@ "_PACKAGE" ## lintr namespace: start +#' @importFrom glue glue #' @importFrom rex rex regex re_matches re_substitutes character_class #' @importFrom stats na.omit #' @importFrom utils capture.output head getParseData relist From d118360ae0a8737e227365bb1d015255620ae18d Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 1 Aug 2023 21:31:20 +0000 Subject: [PATCH 04/16] glue::glue -> glue --- R/indentation_linter.R | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/R/indentation_linter.R b/R/indentation_linter.R index 9f98a6e2d..9e68df9d2 100644 --- a/R/indentation_linter.R +++ b/R/indentation_linter.R @@ -142,16 +142,16 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al if (isTRUE(assignment_as_infix)) { suppressing_tokens <- c("LEFT_ASSIGN", "EQ_ASSIGN", "EQ_SUB", "EQ_FORMALS") - xp_suppress <- glue::glue("preceding-sibling::{suppressing_tokens}[{xp_last_on_line}]") + xp_suppress <- glue("preceding-sibling::{suppressing_tokens}[{xp_last_on_line}]") restoring_tokens <- c("expr[SYMBOL_FUNCTION_CALL]", "OP-LEFT-BRACE") - xp_restore <- glue::glue("preceding-sibling::{restoring_tokens}") + xp_restore <- glue("preceding-sibling::{restoring_tokens}") # match the first ancestor expr that is either # * a suppressing token (<- or =) or # * a restoring token (braces or a function call) # suppress the indent if the matched ancestor is a suppressing token - infix_condition <- glue::glue(" + infix_condition <- glue(" and not(ancestor::expr[{xp_or(c(xp_suppress, xp_restore))}][1][{xp_or(xp_suppress)}]) ") } else { @@ -162,10 +162,10 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al "number(", paste( c( - glue::glue("self::{paren_tokens_left}/following-sibling::{paren_tokens_right}/preceding-sibling::*[1]/@line2"), - glue::glue("self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))}] + glue("self::{paren_tokens_left}/following-sibling::{paren_tokens_right}/preceding-sibling::*[1]/@line2"), + glue("self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))}] /following-sibling::SYMBOL_FUNCTION_CALL/parent::expr/following-sibling::expr[1]/@line2"), - glue::glue("self::*[ + glue("self::*[ {xp_and(paste0('not(self::', paren_tokens_left, ')'))} and not(following-sibling::SYMBOL_FUNCTION_CALL) ]/following-sibling::*[not(self::COMMENT)][1]/@line2") @@ -177,13 +177,13 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al xp_indent_changes <- paste( c( - glue::glue("//{paren_tokens_left}[not(@line1 = following-sibling::expr[ + glue("//{paren_tokens_left}[not(@line1 = following-sibling::expr[ @line2 > @line1 and ({xp_or(paste0('descendant::', paren_tokens_left, '[', xp_last_on_line, ']'))}) ]/@line1)]"), - glue::glue("//{infix_tokens}[{xp_last_on_line}{infix_condition}]"), - glue::glue("//{no_paren_keywords}[{xp_last_on_line}]"), - glue::glue("//{keyword_tokens}/following-sibling::OP-RIGHT-PAREN[ + glue("//{infix_tokens}[{xp_last_on_line}{infix_condition}]"), + glue("//{no_paren_keywords}[{xp_last_on_line}]"), + glue("//{keyword_tokens}/following-sibling::OP-RIGHT-PAREN[ {xp_last_on_line} and not(following-sibling::expr[1][OP-LEFT-BRACE]) ]") @@ -338,7 +338,7 @@ build_indentation_style_tidy <- function() { " xp_suppress <- paste( - glue::glue(" + glue(" self::{paren_tokens_left}[ @line1 = following-sibling::{paren_tokens_right}/{xp_inner_expr}[position() = 1]/@line1 ]/following-sibling::{paren_tokens_right}[ @@ -350,10 +350,10 @@ build_indentation_style_tidy <- function() { xp_is_not_hanging <- paste( c( - glue::glue( + glue( "self::{paren_tokens_left}/following-sibling::{paren_tokens_right}[@line1 > preceding-sibling::*[1]/@line2]" ), - glue::glue("self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))} and {xp_last_on_line}]") + glue("self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))} and {xp_last_on_line}]") ), collapse = " | " ) @@ -378,11 +378,11 @@ build_indentation_style_always <- function() { xp_is_not_hanging <- paste( c( - glue::glue(" + glue(" self::{paren_tokens_left}[{xp_last_on_line}]/ following-sibling::{paren_tokens_right}[@line1 > preceding-sibling::*[1]/@line2] "), - glue::glue("self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))} and {xp_last_on_line}]") + glue("self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))} and {xp_last_on_line}]") ), collapse = " | " ) From 29f5e8c052bf42dc79c0b237ac13b176f79b98a1 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 1 Aug 2023 21:33:30 +0000 Subject: [PATCH 05/16] other glue functions --- NAMESPACE | 2 ++ R/any_duplicated_linter.R | 2 +- R/boolean_arithmetic_linter.R | 4 ++-- R/brace_linter.R | 8 ++++---- R/condition_message_linter.R | 2 +- R/conjunct_test_linter.R | 2 +- R/equals_na_linter.R | 2 +- R/exclude.R | 2 +- R/expect_comparison_linter.R | 2 +- R/expect_s3_class_linter.R | 2 +- R/expect_type_linter.R | 2 +- R/extraction_operator_linter.R | 2 +- R/fixed_regex_linter.R | 2 +- R/function_argument_linter.R | 2 +- R/ifelse_censor_linter.R | 2 +- R/implicit_assignment_linter.R | 2 +- R/infix_spaces_linter.R | 2 +- R/inner_combine_linter.R | 2 +- R/is_numeric_linter.R | 2 +- R/lengths_linter.R | 2 +- R/lintr-deprecated.R | 2 +- R/lintr-package.R | 2 +- R/literal_coercion_linter.R | 2 +- R/matrix_apply_linter.R | 8 ++++---- R/missing_argument_linter.R | 2 +- R/nested_ifelse_linter.R | 2 +- R/object_name_linter.R | 4 ++-- R/object_usage_linter.R | 6 +++--- R/paste_linter.R | 4 ++-- R/pipe_continuation_linter.R | 2 +- R/redundant_ifelse_linter.R | 4 ++-- R/regex_subset_linter.R | 4 ++-- R/routine_registration_linter.R | 2 +- R/seq_linter.R | 4 ++-- R/sort_linter.R | 2 +- R/spaces_inside_linter.R | 4 ++-- R/string_boundary_linter.R | 6 +++--- R/strings_as_factors_linter.R | 2 +- R/system_file_linter.R | 2 +- R/undesirable_function_linter.R | 4 ++-- R/unnecessary_concatenation_linter.R | 10 +++++----- R/unnecessary_lambda_linter.R | 8 ++++---- R/vector_logic_linter.R | 2 +- R/with.R | 4 ++-- R/yoda_test_linter.R | 4 ++-- man/object_usage_linter.Rd | 2 +- man/paste_linter.Rd | 2 +- 47 files changed, 75 insertions(+), 73 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 3535130f6..90f98e00d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -144,6 +144,8 @@ export(xml_nodes_to_lints) export(yoda_test_linter) importFrom(cyclocomp,cyclocomp) importFrom(glue,glue) +importFrom(glue,glue_collapse) +importFrom(glue,glue_data) importFrom(rex,character_class) importFrom(rex,re_matches) importFrom(rex,re_substitutes) diff --git a/R/any_duplicated_linter.R b/R/any_duplicated_linter.R index 2c432df63..64606478b 100644 --- a/R/any_duplicated_linter.R +++ b/R/any_duplicated_linter.R @@ -54,7 +54,7 @@ any_duplicated_linter <- function() { # the final parent::expr/expr gets us to the expr on the other side of EQ; # this lets us match on either side of EQ, where following-sibling # assumes we are before EQ, preceding-sibling assumes we are after EQ. - length_unique_xpath_parts <- glue::glue(" + length_unique_xpath_parts <- glue(" //{ c('EQ', 'NE', 'GT', 'LT') } /parent::expr /expr[ diff --git a/R/boolean_arithmetic_linter.R b/R/boolean_arithmetic_linter.R index acd80c290..2bbc7bb6f 100644 --- a/R/boolean_arithmetic_linter.R +++ b/R/boolean_arithmetic_linter.R @@ -34,7 +34,7 @@ boolean_arithmetic_linter <- function() { # TODO(#1581): extend to include all()-alike expressions zero_expr <- "(EQ or NE or GT or LE) and expr[NUM_CONST[text() = '0' or text() = '0L']]" one_expr <- "(LT or GE) and expr[NUM_CONST[text() = '1' or text() = '1L']]" - length_xpath <- glue::glue(" + length_xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'which' or text() = 'grep'] /parent::expr /parent::expr @@ -43,7 +43,7 @@ boolean_arithmetic_linter <- function() { and parent::expr[ ({zero_expr}) or ({one_expr})] ] ") - sum_xpath <- glue::glue(" + sum_xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'sum'] /parent::expr /parent::expr[ diff --git a/R/brace_linter.R b/R/brace_linter.R index 0444546a2..6822b78b4 100644 --- a/R/brace_linter.R +++ b/R/brace_linter.R @@ -75,7 +75,7 @@ brace_linter <- function(allow_single_line = FALSE) { )) # TODO (AshesITR): if c_style_braces is TRUE, invert the preceding-sibling condition - xp_open_curly <- glue::glue("//OP-LEFT-BRACE[ + xp_open_curly <- glue("//OP-LEFT-BRACE[ { xp_cond_open } and ( not(@line1 = parent::expr/preceding-sibling::*/@line2) @@ -85,7 +85,7 @@ brace_linter <- function(allow_single_line = FALSE) { xp_open_preceding <- "parent::expr/preceding-sibling::*[1][self::OP-RIGHT-PAREN or self::ELSE or self::REPEAT]" - xp_paren_brace <- glue::glue("//OP-LEFT-BRACE[ + xp_paren_brace <- glue("//OP-LEFT-BRACE[ @line1 = { xp_open_preceding }/@line1 and @col1 = { xp_open_preceding }/@col2 + 1 ]") @@ -110,7 +110,7 @@ brace_linter <- function(allow_single_line = FALSE) { )) # TODO (AshesITR): if c_style_braces is TRUE, skip the not(ELSE) condition - xp_closed_curly <- glue::glue("//OP-RIGHT-BRACE[ + xp_closed_curly <- glue("//OP-RIGHT-BRACE[ { xp_cond_closed } and ( (@line1 = preceding-sibling::*[1][not(self::OP-LEFT-BRACE)]/@line2) @@ -122,7 +122,7 @@ brace_linter <- function(allow_single_line = FALSE) { # need to (?) repeat previous_curly_path since != will return true if there is # no such node. ditto for approach with not(@line1 = ...). # TODO (AshesITR): if c_style_braces is TRUE, this needs to be @line2 + 1 - xp_else_same_line <- glue::glue("//ELSE[{xp_else_closed_curly} and @line1 != {xp_else_closed_curly}/@line2]") + xp_else_same_line <- glue("//ELSE[{xp_else_closed_curly} and @line1 != {xp_else_closed_curly}/@line2]") xp_function_brace <- "//FUNCTION/parent::expr[@line1 != @line2 and not(expr[OP-LEFT-BRACE])]" diff --git a/R/condition_message_linter.R b/R/condition_message_linter.R index 931c76af6..8ed70fc45 100644 --- a/R/condition_message_linter.R +++ b/R/condition_message_linter.R @@ -42,7 +42,7 @@ #' @export condition_message_linter <- function() { translators <- c("packageStartupMessage", "message", "warning", "stop") - xpath <- glue::glue(" + xpath <- glue(" //SYMBOL_FUNCTION_CALL[ {xp_text_in_table(translators)} ] /parent::expr /following-sibling::expr[ diff --git a/R/conjunct_test_linter.R b/R/conjunct_test_linter.R index 6c81f1ade..914fb29bb 100644 --- a/R/conjunct_test_linter.R +++ b/R/conjunct_test_linter.R @@ -48,7 +48,7 @@ conjunct_test_linter <- function(allow_named_stopifnot = TRUE) { /following-sibling::expr[1][AND2] " named_stopifnot_condition <- if (allow_named_stopifnot) "and not(preceding-sibling::*[1][self::EQ_SUB])" else "" - stopifnot_xpath <- glue::glue(" + stopifnot_xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'stopifnot'] /parent::expr /following-sibling::expr[1][AND2 {named_stopifnot_condition}] diff --git a/R/equals_na_linter.R b/R/equals_na_linter.R index fb36d3d94..f52112ac7 100644 --- a/R/equals_na_linter.R +++ b/R/equals_na_linter.R @@ -32,7 +32,7 @@ equals_na_linter <- function() { na_table <- xp_text_in_table(c("NA", "NA_integer_", "NA_real_", "NA_complex_", "NA_character_")) - xpath <- glue::glue(" + xpath <- glue(" //NUM_CONST[ {na_table} ] /parent::expr /parent::expr[EQ or NE] diff --git a/R/exclude.R b/R/exclude.R index 0dc3d0605..cf41704b4 100644 --- a/R/exclude.R +++ b/R/exclude.R @@ -181,7 +181,7 @@ add_exclusions <- function(exclusions, lines, linters_string, exclude_linter_sep bad <- excluded_linters[!matched] warning( "Could not find linter", if (length(bad) > 1L) "s" else "", " named ", - glue::glue_collapse(sQuote(bad), sep = ", ", last = " and "), + glue_collapse(sQuote(bad), sep = ", ", last = " and "), " in the list of active linters. Make sure the linter is uniquely identified by the given name or prefix." ) } diff --git a/R/expect_comparison_linter.R b/R/expect_comparison_linter.R index e5ae53f11..9f2bafc77 100644 --- a/R/expect_comparison_linter.R +++ b/R/expect_comparison_linter.R @@ -50,7 +50,7 @@ expect_comparison_linter <- function() { # != doesn't have a clean replacement comparator_nodes <- setdiff(as.list(infix_metadata$xml_tag[infix_metadata$comparator]), "NE") - xpath <- glue::glue(" + xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'expect_true'] /parent::expr /following-sibling::expr[ {xp_or(comparator_nodes)} ] diff --git a/R/expect_s3_class_linter.R b/R/expect_s3_class_linter.R index 3a71a25e4..04431992d 100644 --- a/R/expect_s3_class_linter.R +++ b/R/expect_s3_class_linter.R @@ -46,7 +46,7 @@ expect_s3_class_linter <- function() { /parent::expr[not(SYMBOL_SUB[text() = 'info' or text() = 'label' or text() = 'expected.label'])] " is_class_call <- xp_text_in_table(c(is_s3_class_calls, "inherits")) - expect_true_xpath <- glue::glue(" + expect_true_xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'expect_true'] /parent::expr /following-sibling::expr[1][expr[1][SYMBOL_FUNCTION_CALL[ {is_class_call} ]]] diff --git a/R/expect_type_linter.R b/R/expect_type_linter.R index 028403b70..b1465f441 100644 --- a/R/expect_type_linter.R +++ b/R/expect_type_linter.R @@ -37,7 +37,7 @@ expect_type_linter <- function() { ] /parent::expr[not(SYMBOL_SUB[text() = 'info' or text() = 'label' or text() = 'expected.label'])] " - expect_true_xpath <- glue::glue(" + expect_true_xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'expect_true'] /parent::expr /following-sibling::expr[1][expr[1][SYMBOL_FUNCTION_CALL[ {base_type_tests} ]]] diff --git a/R/extraction_operator_linter.R b/R/extraction_operator_linter.R index d59112da0..729116d6e 100644 --- a/R/extraction_operator_linter.R +++ b/R/extraction_operator_linter.R @@ -52,7 +52,7 @@ #' @export extraction_operator_linter <- function() { constant_nodes_in_brackets <- paste0("self::", c("expr", "OP-PLUS", "NUM_CONST", "STR_CONST")) - xpath <- glue::glue(" + xpath <- glue(" //OP-DOLLAR[not(preceding-sibling::expr[1]/SYMBOL[text() = 'self' or text() = '.self'])] | //OP-LEFT-BRACKET[ diff --git a/R/fixed_regex_linter.R b/R/fixed_regex_linter.R index 31edc57ea..aad6720d8 100644 --- a/R/fixed_regex_linter.R +++ b/R/fixed_regex_linter.R @@ -87,7 +87,7 @@ fixed_regex_linter <- function() { # NB: strsplit doesn't have an ignore.case argument # NB: we intentionally exclude cases like gsub(x, c("a" = "b")), where "b" is fixed - xpath <- glue::glue(" + xpath <- glue(" //SYMBOL_FUNCTION_CALL[ {pos_1_regex_funs} ] /parent::expr[ not(following-sibling::SYMBOL_SUB[ diff --git a/R/function_argument_linter.R b/R/function_argument_linter.R index 936a14fb0..70db8ab56 100644 --- a/R/function_argument_linter.R +++ b/R/function_argument_linter.R @@ -46,7 +46,7 @@ #' - #' @export function_argument_linter <- function() { - xpath <- paste(collapse = " | ", glue::glue(" + xpath <- paste(collapse = " | ", glue(" //{c('FUNCTION', 'OP-LAMBDA')} /following-sibling::EQ_FORMALS[1] /following-sibling::SYMBOL_FORMALS[ diff --git a/R/ifelse_censor_linter.R b/R/ifelse_censor_linter.R index 46488507d..dbe725c6b 100644 --- a/R/ifelse_censor_linter.R +++ b/R/ifelse_censor_linter.R @@ -35,7 +35,7 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export ifelse_censor_linter <- function() { - xpath <- glue::glue(" + xpath <- glue(" //SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ] /parent::expr /following-sibling::expr[ diff --git a/R/implicit_assignment_linter.R b/R/implicit_assignment_linter.R index b68fba71f..b025b8c70 100644 --- a/R/implicit_assignment_linter.R +++ b/R/implicit_assignment_linter.R @@ -41,7 +41,7 @@ implicit_assignment_linter <- function(except = c("bquote", "expression", "expr" if (length(except) > 0L) { exceptions <- xp_text_in_table(except) - xpath_exceptions <- glue::glue(" + xpath_exceptions <- glue(" //SYMBOL_FUNCTION_CALL[ not({exceptions}) ]") } else { xpath_exceptions <- " diff --git a/R/infix_spaces_linter.R b/R/infix_spaces_linter.R index 23113ca34..fcdce9e5b 100644 --- a/R/infix_spaces_linter.R +++ b/R/infix_spaces_linter.R @@ -146,7 +146,7 @@ infix_spaces_linter <- function(exclude_operators = NULL, allow_multiple_spaces # of the foo(a=1) case, where the tree is # NB: position() > 1 for the unary case, e.g. x[-1] # NB: the last not() disables lints inside box::use() declarations - xpath <- glue::glue("//*[ + xpath <- glue("//*[ ({xp_or(paste0('self::', infix_tokens))}) and position() > 1 and ( diff --git a/R/inner_combine_linter.R b/R/inner_combine_linter.R index 607e61bbe..86673ff6a 100644 --- a/R/inner_combine_linter.R +++ b/R/inner_combine_linter.R @@ -76,7 +76,7 @@ inner_combine_linter <- function() { log_args_cond, lubridate_args_cond ) - xpath <- glue::glue(" + xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'c'] /parent::expr[count(following-sibling::expr) > 1] /following-sibling::expr[1][ {c_expr_cond} ] diff --git a/R/is_numeric_linter.R b/R/is_numeric_linter.R index 4db1b1cd6..4bcefa8b9 100644 --- a/R/is_numeric_linter.R +++ b/R/is_numeric_linter.R @@ -43,7 +43,7 @@ is_numeric_linter <- function() { is_integer_expr <- "expr[1][SYMBOL_FUNCTION_CALL[text() = 'is.integer']]" # testing things like is.numeric(x) || is.integer(x) - or_xpath <- glue::glue(" + or_xpath <- glue(" //OR2 /parent::expr[ expr/{is_numeric_expr} diff --git a/R/lengths_linter.R b/R/lengths_linter.R index 5f37bc3f2..b24a39ff4 100644 --- a/R/lengths_linter.R +++ b/R/lengths_linter.R @@ -32,7 +32,7 @@ #' @export lengths_linter <- function() { loop_funs <- c("sapply", "vapply", "map_int", "map_dbl") - xpath <- glue::glue(" + xpath <- glue(" //SYMBOL_FUNCTION_CALL[ {xp_text_in_table(loop_funs)} ] /parent::expr /parent::expr[expr/SYMBOL[text() = 'length']] diff --git a/R/lintr-deprecated.R b/R/lintr-deprecated.R index 27f3a4383..cb2c8395b 100644 --- a/R/lintr-deprecated.R +++ b/R/lintr-deprecated.R @@ -51,7 +51,7 @@ closed_curly_linter <- function(allow_single_line = FALSE) { )" )) - xpath <- glue::glue("//OP-RIGHT-BRACE[ + xpath <- glue("//OP-RIGHT-BRACE[ { xp_cond_closed } and ( (@line1 = preceding-sibling::*[1]/@line2) or (@line1 = parent::expr/following-sibling::*[1][not(self::ELSE)]/@line1) diff --git a/R/lintr-package.R b/R/lintr-package.R index cb46d5ad9..d72c1780b 100644 --- a/R/lintr-package.R +++ b/R/lintr-package.R @@ -8,7 +8,7 @@ "_PACKAGE" ## lintr namespace: start -#' @importFrom glue glue +#' @importFrom glue glue glue_collapse glue_data #' @importFrom rex rex regex re_matches re_substitutes character_class #' @importFrom stats na.omit #' @importFrom utils capture.output head getParseData relist diff --git a/R/literal_coercion_linter.R b/R/literal_coercion_linter.R index aad7bf21d..02055cb4d 100644 --- a/R/literal_coercion_linter.R +++ b/R/literal_coercion_linter.R @@ -64,7 +64,7 @@ literal_coercion_linter <- function() { or STR_CONST[not(following-sibling::*[1][self::EQ_SUB])] ) " - xpath <- glue::glue(" + xpath <- glue(" //SYMBOL_FUNCTION_CALL[ {coercers} ] /parent::expr /parent::expr[ diff --git a/R/matrix_apply_linter.R b/R/matrix_apply_linter.R index e39c2082e..961945e71 100644 --- a/R/matrix_apply_linter.R +++ b/R/matrix_apply_linter.R @@ -69,7 +69,7 @@ matrix_apply_linter <- function() { ] " - xpath <- glue::glue("{sums_xpath} | {means_xpath}") + xpath <- glue("{sums_xpath} | {means_xpath}") # This doesn't handle the case when MARGIN and FUN are named and in a different position # but this should be relatively rate @@ -131,15 +131,15 @@ craft_colsums_rowsums_msg <- function(var, margin, fun, narm_val) { l2 <- suppressWarnings(as.integer(re_substitutes(l2, "L$", ""))) if (!is.na(narm_val)) { - narm <- glue::glue(", na.rm = {narm_val}") + narm <- glue(", na.rm = {narm_val}") } else { narm <- "" } if (identical(l1, 1L)) { - reco <- glue::glue("row{fun}s({var}{narm}, dims = {l2})") + reco <- glue("row{fun}s({var}{narm}, dims = {l2})") } else { - reco <- glue::glue( + reco <- glue( "row{fun}s(col{fun}s({var}{narm}, dims = {l1 - 1}), dims = {l2 - l1 + 1})", " or ", "col{fun}s({var}{narm}, dims = {l1 - 1}) if {var} has {l2} dimensions" diff --git a/R/missing_argument_linter.R b/R/missing_argument_linter.R index 75fab6b84..82f13aaa7 100644 --- a/R/missing_argument_linter.R +++ b/R/missing_argument_linter.R @@ -40,7 +40,7 @@ missing_argument_linter <- function(except = c("alist", "quote", "switch"), allo conds <- c(conds, "self::OP-COMMA[following-sibling::*[not(self::COMMENT)][1][self::OP-RIGHT-PAREN]]") } - xpath <- glue::glue("//SYMBOL_FUNCTION_CALL/parent::expr/parent::expr/*[{xp_or(conds)}]") + xpath <- glue("//SYMBOL_FUNCTION_CALL/parent::expr/parent::expr/*[{xp_or(conds)}]") to_function_xpath <- "string(./preceding-sibling::expr[last()]/SYMBOL_FUNCTION_CALL)" Linter(function(source_expression) { diff --git a/R/nested_ifelse_linter.R b/R/nested_ifelse_linter.R index 7f6c0c02a..0afc0e791 100644 --- a/R/nested_ifelse_linter.R +++ b/R/nested_ifelse_linter.R @@ -36,7 +36,7 @@ #' @export nested_ifelse_linter <- function() { # NB: land on the nested (inner) call, not the outer call, and throw a lint with the inner call's name - xpath <- glue::glue(" + xpath <- glue(" //SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)}] /parent::expr /following-sibling::expr[expr[1][SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ]]] diff --git a/R/object_name_linter.R b/R/object_name_linter.R index 10674136b..6dc3c86ef 100644 --- a/R/object_name_linter.R +++ b/R/object_name_linter.R @@ -12,7 +12,7 @@ object_name_xpath <- local({ "])" ) - glue::glue(" + glue(" //SYMBOL[ {xp_assignment_target} ] | //STR_CONST[ {xp_assignment_target} ] | //SYMBOL_FORMALS @@ -128,7 +128,7 @@ object_name_linter <- function(styles = c("snake_case", "symbols"), regexes = ch lint_message <- paste0( "Variable and function name style should match ", - glue::glue_collapse(unique(names(style_list)), sep = ", ", last = " or "), "." + glue_collapse(unique(names(style_list)), sep = ", ", last = " or "), "." ) Linter(function(source_expression) { diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index 856b5e77a..bf7792300 100644 --- a/R/object_usage_linter.R +++ b/R/object_usage_linter.R @@ -3,7 +3,7 @@ #' Check that closures have the proper usage using [codetools::checkUsage()]. #' Note that this runs [base::eval()] on the code, so **do not use with untrusted code**. #' -#' @param interpret_glue If `TRUE`, interpret [glue::glue()] calls to avoid false positives caused by local variables +#' @param interpret_glue If `TRUE`, interpret [glue()] calls to avoid false positives caused by local variables #' which are only used in a glue expression. #' @param skip_with A logical. If `TRUE` (default), code in `with()` expressions #' will be skipped. This argument will be passed to `skipWith` argument of @@ -48,7 +48,7 @@ object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) { # not all instances of linted symbols are potential sources for the observed violations -- see #1914 symbol_exclude_cond <- "preceding-sibling::OP-DOLLAR or preceding-sibling::OP-AT or ancestor::expr[OP-TILDE]" - xpath_culprit_symbol <- glue::glue(" + xpath_culprit_symbol <- glue(" descendant::SYMBOL[not( {symbol_exclude_cond} )] | descendant::SYMBOL_FUNCTION_CALL[not( {symbol_exclude_cond} )] | descendant::SPECIAL @@ -131,7 +131,7 @@ object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) { nodes[missing_symbol] <- lapply(which(missing_symbol), function(i) { line_based_match <- xml2::xml_find_first( fun_assignment, - glue::glue_data(res[i, ], "descendant::expr[@line1 = {line1} and @line2 = {line2}]") + glue_data(res[i, ], "descendant::expr[@line1 = {line1} and @line2 = {line2}]") ) if (is.na(line_based_match)) fun_assignment else line_based_match }) diff --git a/R/paste_linter.R b/R/paste_linter.R index b130a6f74..bf99843e4 100644 --- a/R/paste_linter.R +++ b/R/paste_linter.R @@ -5,7 +5,7 @@ #' #' 1. Block usage of [paste()] with `sep = ""`. [paste0()] is a faster, more concise alternative. #' 2. Block usage of `paste()` or `paste0()` with `collapse = ", "`. [toString()] is a direct -#' wrapper for this, and alternatives like [glue::glue_collapse()] might give better messages for humans. +#' wrapper for this, and alternatives like [glue_collapse()] might give better messages for humans. #' 3. Block usage of `paste0()` that supplies `sep=` -- this is not a formal argument to `paste0`, and #' is likely to be a mistake. #' 4. Block usage of `paste()` / `paste0()` combined with [rep()] that could be replaced by @@ -144,7 +144,7 @@ paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE) { source_expression = source_expression, lint_message = paste( 'toString(.) is more expressive than paste(., collapse = ", ").', - "Note also glue::glue_collapse() and and::and()", + "Note also glue_collapse() and and::and()", "for constructing human-readable / translation-friendly lists" ), type = "warning" diff --git a/R/pipe_continuation_linter.R b/R/pipe_continuation_linter.R index 4580637d4..9e0f6dd1e 100644 --- a/R/pipe_continuation_linter.R +++ b/R/pipe_continuation_linter.R @@ -63,7 +63,7 @@ pipe_continuation_linter <- function() { or @line1 = preceding-sibling::expr/descendant-or-self::*[self::SPECIAL[text() = '%>%'] or self::PIPE]/@line1 ) " - xpath <- glue::glue(" + xpath <- glue(" //SPECIAL[text() = '%>%' and {pipe_conditions} ] | //PIPE[ {pipe_conditions} ] ") diff --git a/R/redundant_ifelse_linter.R b/R/redundant_ifelse_linter.R index 0543a5c1c..27e5728df 100644 --- a/R/redundant_ifelse_linter.R +++ b/R/redundant_ifelse_linter.R @@ -44,7 +44,7 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export redundant_ifelse_linter <- function(allow10 = FALSE) { - tf_xpath <- glue::glue(" + tf_xpath <- glue(" //SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ] /parent::expr /parent::expr[ @@ -53,7 +53,7 @@ redundant_ifelse_linter <- function(allow10 = FALSE) { ] ") - num_xpath <- glue::glue(" + num_xpath <- glue(" //SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ] /parent::expr /parent::expr[ diff --git a/R/regex_subset_linter.R b/R/regex_subset_linter.R index bd22de516..76f9494a7 100644 --- a/R/regex_subset_linter.R +++ b/R/regex_subset_linter.R @@ -64,8 +64,8 @@ regex_subset_linter <- function() { and expr[position() = {arg_pos} ] = parent::expr/expr[1] ] " - grep_xpath <- glue::glue(xpath_fmt, calls = c("grepl", "grep"), arg_pos = 3L) - stringr_xpath <- glue::glue(xpath_fmt, calls = c("str_detect", "str_which"), arg_pos = 2L) + grep_xpath <- glue(xpath_fmt, calls = c("grepl", "grep"), arg_pos = 3L) + stringr_xpath <- glue(xpath_fmt, calls = c("str_detect", "str_which"), arg_pos = 2L) Linter(function(source_expression) { if (!is_lint_level(source_expression, "expression")) { diff --git a/R/routine_registration_linter.R b/R/routine_registration_linter.R index 9948e8f25..cbad4af04 100644 --- a/R/routine_registration_linter.R +++ b/R/routine_registration_linter.R @@ -33,7 +33,7 @@ #' @export routine_registration_linter <- function() { native_routine_callers <- c(".C", ".Call", ".Fortran", ".External") - xpath <- glue::glue(" + xpath <- glue(" //SYMBOL_FUNCTION_CALL[ {xp_text_in_table(native_routine_callers)} ] /parent::expr /following-sibling::expr[1]/STR_CONST diff --git a/R/seq_linter.R b/R/seq_linter.R index 76536f173..5c33cbcdb 100644 --- a/R/seq_linter.R +++ b/R/seq_linter.R @@ -49,14 +49,14 @@ seq_linter <- function() { bad_funcs <- xp_text_in_table(c("length", "n", "nrow", "ncol", "NROW", "NCOL", "dim")) # Exact `xpath` depends on whether bad function was used in conjunction with `seq()` - seq_xpath <- glue::glue(" + seq_xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'seq'] /parent::expr /following-sibling::expr[1][expr/SYMBOL_FUNCTION_CALL[ {bad_funcs} ]] /parent::expr[count(expr) = 2] ") # `.N` from {data.table} is special since it's not a function but a symbol - colon_xpath <- glue::glue(" + colon_xpath <- glue(" //OP-COLON /parent::expr[ expr[NUM_CONST[text() = '1' or text() = '1L']] diff --git a/R/sort_linter.R b/R/sort_linter.R index 568c84cd9..80357b971 100644 --- a/R/sort_linter.R +++ b/R/sort_linter.R @@ -61,7 +61,7 @@ sort_linter <- function() { text() = 'decreasing' or text() = 'na.last']" - arg_values_xpath <- glue::glue("{args_xpath}/following-sibling::expr[1]") + arg_values_xpath <- glue("{args_xpath}/following-sibling::expr[1]") Linter(function(source_expression) { if (!is_lint_level(source_expression, "expression")) { diff --git a/R/spaces_inside_linter.R b/R/spaces_inside_linter.R index f891a9b57..59439e747 100644 --- a/R/spaces_inside_linter.R +++ b/R/spaces_inside_linter.R @@ -38,7 +38,7 @@ spaces_inside_linter <- function() { and @end != following-sibling::*[1]/@start - 1 and @line1 = following-sibling::*[1]/@line1 " - left_xpath <- glue::glue(" + left_xpath <- glue(" //OP-LEFT-BRACKET[{left_xpath_condition}] | //LBB[{left_xpath_condition}] | //OP-LEFT-PAREN[{left_xpath_condition}]") @@ -48,7 +48,7 @@ spaces_inside_linter <- function() { and @start != preceding-sibling::*[1]/@end + 1 and @line1 = preceding-sibling::*[1]/@line2 " - right_xpath <- glue::glue(" + right_xpath <- glue(" //OP-RIGHT-BRACKET[{right_xpath_condition}] | //OP-RIGHT-PAREN[{right_xpath_condition} and not(preceding-sibling::*[1][self::EQ_SUB])]") diff --git a/R/string_boundary_linter.R b/R/string_boundary_linter.R index 86e643183..3ff0a7027 100644 --- a/R/string_boundary_linter.R +++ b/R/string_boundary_linter.R @@ -60,7 +60,7 @@ string_boundary_linter <- function(allow_grepl = FALSE) { "string-length(text()) > 3", "contains(text(), '^') or contains(text(), '$')" ) - str_detect_xpath <- glue::glue(" + str_detect_xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'str_detect'] /parent::expr /following-sibling::expr[2] @@ -68,7 +68,7 @@ string_boundary_linter <- function(allow_grepl = FALSE) { ") if (!allow_grepl) { - grepl_xpath <- glue::glue(" + grepl_xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'grepl'] /parent::expr /parent::expr[ @@ -96,7 +96,7 @@ string_boundary_linter <- function(allow_grepl = FALSE) { list(lint_expr = expr[can_replace], initial_anchor = initial_anchor[can_replace]) } - substr_xpath_parts <- glue::glue(" + substr_xpath_parts <- glue(" //{ c('EQ', 'NE') } /parent::expr[ expr[STR_CONST] diff --git a/R/strings_as_factors_linter.R b/R/strings_as_factors_linter.R index e3820ed77..1f48d878a 100644 --- a/R/strings_as_factors_linter.R +++ b/R/strings_as_factors_linter.R @@ -62,7 +62,7 @@ strings_as_factors_linter <- function() { # two exclusions # (1) above argument is to row.names= # (2) stringsAsFactors is manually supplied (with any value) - xpath <- glue::glue(" + xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'data.frame'] /parent::expr /parent::expr[ diff --git a/R/system_file_linter.R b/R/system_file_linter.R index 6fd448d38..f0d84d876 100644 --- a/R/system_file_linter.R +++ b/R/system_file_linter.R @@ -27,7 +27,7 @@ system_file_linter <- function() { funs <- c("system.file", "file.path") # either system.file(file.path(...)) or file.path(system.file(...)) - xpath_parts <- glue::glue(" + xpath_parts <- glue(" //SYMBOL_FUNCTION_CALL[text() = '{funs}'] /parent::expr[following-sibling::expr/expr/SYMBOL_FUNCTION_CALL[text() = '{rev(funs)}']] /parent::expr diff --git a/R/undesirable_function_linter.R b/R/undesirable_function_linter.R index 0c6258a29..36eafd1ef 100644 --- a/R/undesirable_function_linter.R +++ b/R/undesirable_function_linter.R @@ -73,9 +73,9 @@ undesirable_function_linter <- function(fun = default_undesirable_functions, ) if (symbol_is_undesirable) { - xpath <- glue::glue("//SYMBOL_FUNCTION_CALL[{xp_condition}] | //SYMBOL[{xp_condition}]") + xpath <- glue("//SYMBOL_FUNCTION_CALL[{xp_condition}] | //SYMBOL[{xp_condition}]") } else { - xpath <- glue::glue("//SYMBOL_FUNCTION_CALL[{xp_condition}]") + xpath <- glue("//SYMBOL_FUNCTION_CALL[{xp_condition}]") } diff --git a/R/unnecessary_concatenation_linter.R b/R/unnecessary_concatenation_linter.R index 57e82020a..914928e6f 100644 --- a/R/unnecessary_concatenation_linter.R +++ b/R/unnecessary_concatenation_linter.R @@ -75,20 +75,20 @@ unnecessary_concatenation_linter <- function(allow_single_expression = TRUE) { # " if (allow_single_expression) { zero_arg_cond <- - glue::glue("count(expr) = 1 and not( {to_pipe_xpath} / preceding-sibling::expr[ {non_constant_cond} ])") + glue("count(expr) = 1 and not( {to_pipe_xpath} / preceding-sibling::expr[ {non_constant_cond} ])") one_arg_cond <- - glue::glue("count(expr) = 2 and not(expr[2][ {non_constant_cond} ])") + glue("count(expr) = 2 and not(expr[2][ {non_constant_cond} ])") } else { - zero_arg_cond <- glue::glue("count(expr) = 1 and not( {to_pipe_xpath} )") + zero_arg_cond <- glue("count(expr) = 1 and not( {to_pipe_xpath} )") one_arg_cond <- "count(expr) = 2 and not(expr[2]/SYMBOL[text() = '...'])" - path_to_non_constant <- glue::glue("./expr[2][ {non_constant_cond} ]") + path_to_non_constant <- glue("./expr[2][ {non_constant_cond} ]") msg_const_expr <- paste( 'Unneeded concatenation of a simple expression. Remove the "c" call,', 'replacing with "as.vector" if using "c" to string attributes, e.g. in converting an array to a vector.' ) } - call_xpath <- glue::glue(" + call_xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'c'] /parent::expr /parent::expr[ diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index a25ffae20..a0eabe8ac 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -73,8 +73,8 @@ unnecessary_lambda_linter <- function() { " default_fun_xpath <- paste( sep = "|", - glue::glue(default_fun_xpath_fmt, paren_path = "expr"), - glue::glue(default_fun_xpath_fmt, paren_path = "expr[OP-LEFT-BRACE and count(expr) = 1]/expr[1]") + glue(default_fun_xpath_fmt, paren_path = "expr"), + glue(default_fun_xpath_fmt, paren_path = "expr[OP-LEFT-BRACE and count(expr) = 1]/expr[1]") ) # purrr-style inline formulas-as-functions, e.g. ~foo(.x) @@ -82,7 +82,7 @@ unnecessary_lambda_linter <- function() { # 1. a formula (OP-TILDE) # 2. the lone argument marker `.x` or `.` purrr_symbol <- "SYMBOL[text() = '.x' or text() = '.']" - purrr_fun_xpath <- glue::glue(" + purrr_fun_xpath <- glue(" //SYMBOL_FUNCTION_CALL[ {xp_text_in_table(purrr_mappers)} ] /parent::expr /following-sibling::expr[ @@ -95,7 +95,7 @@ unnecessary_lambda_linter <- function() { # path to calling function symbol from the matched expressions fun_xpath <- "./parent::expr/expr/SYMBOL_FUNCTION_CALL" # path to the symbol of the simpler function that avoids a lambda - symbol_xpath <- glue::glue("(expr|expr[OP-LEFT-BRACE]/expr[1])/expr[SYMBOL_FUNCTION_CALL]") + symbol_xpath <- glue("(expr|expr[OP-LEFT-BRACE]/expr[1])/expr[SYMBOL_FUNCTION_CALL]") Linter(function(source_expression) { if (!is_lint_level(source_expression, "expression")) { diff --git a/R/vector_logic_linter.R b/R/vector_logic_linter.R index 388ed99b9..af349ed7a 100644 --- a/R/vector_logic_linter.R +++ b/R/vector_logic_linter.R @@ -60,7 +60,7 @@ vector_logic_linter <- function() { # ... # # we _don't_ want to match anything on the second expr, hence this - xpath_parts <- glue::glue(" + xpath_parts <- glue(" //{ c('AND', 'OR') }[ ancestor::expr[ not(preceding-sibling::OP-RIGHT-PAREN) diff --git a/R/with.R b/R/with.R index 400d36b95..295aabb39 100644 --- a/R/with.R +++ b/R/with.R @@ -46,7 +46,7 @@ modify_defaults <- function(defaults, ...) { bad_nms <- setdiff(nms[to_null], names(defaults)) is_are <- if (length(bad_nms) > 1L) "are" else "is" warning( - "Trying to remove ", glue::glue_collapse(sQuote(bad_nms), sep = ", ", last = " and "), + "Trying to remove ", glue_collapse(sQuote(bad_nms), sep = ", ", last = " and "), ", which ", is_are, " not in `defaults`." ) } @@ -104,7 +104,7 @@ linters_with_tags <- function(tags, ..., packages = "lintr", exclude_tags = "dep if (!all(available$linter %in% ns_exports)) { missing_linters <- setdiff(available$linter, ns_exports) stop( - "Linters ", glue::glue_collapse(sQuote(missing_linters), sep = ", ", last = " and "), + "Linters ", glue_collapse(sQuote(missing_linters), sep = ", ", last = " and "), " advertised by `available_linters()` but not exported by package ", package, "." ) } diff --git a/R/yoda_test_linter.R b/R/yoda_test_linter.R index f698294f7..e7ecc6d42 100644 --- a/R/yoda_test_linter.R +++ b/R/yoda_test_linter.R @@ -45,14 +45,14 @@ yoda_test_linter <- function() { or (STR_CONST and not(OP-DOLLAR)) or ((OP-PLUS or OP-MINUS) and count(expr[NUM_CONST]) = 2) " - xpath <- glue::glue(" + xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'expect_equal' or text() = 'expect_identical' or text() = 'expect_setequal'] /parent::expr /following-sibling::expr[1][ {const_condition} ] /parent::expr[not(preceding-sibling::*[self::PIPE or self::SPECIAL[text() = '%>%']])] ") - second_const_xpath <- glue::glue("expr[position() = 3 and ({const_condition})]") + second_const_xpath <- glue("expr[position() = 3 and ({const_condition})]") Linter(function(source_expression) { if (!is_lint_level(source_expression, "expression")) { diff --git a/man/object_usage_linter.Rd b/man/object_usage_linter.Rd index 62e390816..35de61f2f 100644 --- a/man/object_usage_linter.Rd +++ b/man/object_usage_linter.Rd @@ -7,7 +7,7 @@ object_usage_linter(interpret_glue = TRUE, skip_with = TRUE) } \arguments{ -\item{interpret_glue}{If \code{TRUE}, interpret \code{\link[glue:glue]{glue::glue()}} calls to avoid false positives caused by local variables +\item{interpret_glue}{If \code{TRUE}, interpret \code{\link[=glue]{glue()}} calls to avoid false positives caused by local variables which are only used in a glue expression.} \item{skip_with}{A logical. If \code{TRUE} (default), code in \code{with()} expressions diff --git a/man/paste_linter.Rd b/man/paste_linter.Rd index e83352f76..b0cf248b7 100644 --- a/man/paste_linter.Rd +++ b/man/paste_linter.Rd @@ -21,7 +21,7 @@ The following issues are linted by default by this linter \enumerate{ \item Block usage of \code{\link[=paste]{paste()}} with \code{sep = ""}. \code{\link[=paste0]{paste0()}} is a faster, more concise alternative. \item Block usage of \code{paste()} or \code{paste0()} with \code{collapse = ", "}. \code{\link[=toString]{toString()}} is a direct -wrapper for this, and alternatives like \code{\link[glue:glue_collapse]{glue::glue_collapse()}} might give better messages for humans. +wrapper for this, and alternatives like \code{\link[=glue_collapse]{glue_collapse()}} might give better messages for humans. \item Block usage of \code{paste0()} that supplies \verb{sep=} -- this is not a formal argument to \code{paste0}, and is likely to be a mistake. \item Block usage of \code{paste()} / \code{paste0()} combined with \code{\link[=rep]{rep()}} that could be replaced by From 7d49598dcdf5c0730c279f5d948ae794461f581e Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 1 Aug 2023 21:46:07 +0000 Subject: [PATCH 06/16] xml2:: replacement --- R/class_equals_linter.R | 2 +- R/conjunct_test_linter.R | 2 +- R/expect_comparison_linter.R | 2 +- R/expect_true_false_linter.R | 2 +- R/fixed_regex_linter.R | 2 +- R/ifelse_censor_linter.R | 2 +- R/lintr-package.R | 2 +- R/missing_argument_linter.R | 2 +- R/package_hooks_linter.R | 8 ++++---- R/redundant_ifelse_linter.R | 8 ++++---- R/seq_linter.R | 2 +- R/string_boundary_linter.R | 2 +- R/unused_import_linter.R | 2 +- R/utils.R | 6 +++--- R/xp_utils.R | 2 +- 15 files changed, 23 insertions(+), 23 deletions(-) diff --git a/R/class_equals_linter.R b/R/class_equals_linter.R index 33a4d4960..e5e458653 100644 --- a/R/class_equals_linter.R +++ b/R/class_equals_linter.R @@ -53,7 +53,7 @@ class_equals_linter <- function() { bad_expr <- xml2::xml_find_all(xml, xpath) - operator <- xml2::xml_find_chr(bad_expr, "string(*[2])") + operator <- xml_find_char(bad_expr, "string(*[2])") lint_message <- sprintf( "Instead of comparing class(x) with %s, use inherits(x, 'class-name') or is. or is(x, 'class')", operator diff --git a/R/conjunct_test_linter.R b/R/conjunct_test_linter.R index 914fb29bb..ea42daece 100644 --- a/R/conjunct_test_linter.R +++ b/R/conjunct_test_linter.R @@ -79,7 +79,7 @@ conjunct_test_linter <- function(allow_named_stopifnot = TRUE) { } matched_fun <- xp_call_name(bad_expr) - operator <- xml2::xml_find_chr(bad_expr, "string(expr/*[self::AND2 or self::OR2])") + operator <- xml_find_char(bad_expr, "string(expr/*[self::AND2 or self::OR2])") replacement_fmt <- ifelse( matched_fun %in% c("expect_true", "expect_false"), "write multiple expectations like %1$s(A) and %1$s(B)", diff --git a/R/expect_comparison_linter.R b/R/expect_comparison_linter.R index 9f2bafc77..bd2f18d5f 100644 --- a/R/expect_comparison_linter.R +++ b/R/expect_comparison_linter.R @@ -72,7 +72,7 @@ expect_comparison_linter <- function() { bad_expr <- xml2::xml_find_all(xml, xpath) - comparator <- xml2::xml_find_chr(bad_expr, "string(expr[2]/*[2])") + comparator <- xml_find_char(bad_expr, "string(expr[2]/*[2])") expectation <- comparator_expectation_map[comparator] lint_message <- sprintf("%s(x, y) is better than expect_true(x %s y).", expectation, comparator) xml_nodes_to_lints(bad_expr, source_expression, lint_message = lint_message, type = "warning") diff --git a/R/expect_true_false_linter.R b/R/expect_true_false_linter.R index 0712acc77..b347073bc 100644 --- a/R/expect_true_false_linter.R +++ b/R/expect_true_false_linter.R @@ -50,7 +50,7 @@ expect_true_false_linter <- function() { # NB: use expr/$node, not expr[$node], to exclude other things (especially ns:: parts of the call) call_name <- xp_call_name(bad_expr, condition = "starts-with(text(), 'expect_')") - truth_value <- xml2::xml_find_chr(bad_expr, "string(expr/NUM_CONST[text() = 'TRUE' or text() = 'FALSE'])") + truth_value <- xml_find_char(bad_expr, "string(expr/NUM_CONST[text() = 'TRUE' or text() = 'FALSE'])") lint_message <- sprintf( "expect_%s(x) is better than %s(x, %s)", tolower(truth_value), call_name, truth_value diff --git a/R/fixed_regex_linter.R b/R/fixed_regex_linter.R index aad6720d8..2a092475c 100644 --- a/R/fixed_regex_linter.R +++ b/R/fixed_regex_linter.R @@ -119,7 +119,7 @@ fixed_regex_linter <- function() { is_static <- is_not_regex(pattern_strings) fixed_equivalent <- encodeString(get_fixed_string(pattern_strings[is_static]), quote = '"', justify = "none") - call_name <- xml2::xml_find_chr(patterns[is_static], "string(preceding-sibling::expr[last()]/SYMBOL_FUNCTION_CALL)") + call_name <- xml_find_char(patterns[is_static], "string(preceding-sibling::expr[last()]/SYMBOL_FUNCTION_CALL)") is_stringr <- startsWith(call_name, "str_") replacement <- ifelse( diff --git a/R/ifelse_censor_linter.R b/R/ifelse_censor_linter.R index dbe725c6b..558014830 100644 --- a/R/ifelse_censor_linter.R +++ b/R/ifelse_censor_linter.R @@ -56,7 +56,7 @@ ifelse_censor_linter <- function() { bad_expr <- xml2::xml_find_all(xml, xpath) matched_call <- xp_call_name(bad_expr) - operator <- xml2::xml_find_chr(bad_expr, "string(expr[2]/*[2])") + operator <- xml_find_char(bad_expr, "string(expr[2]/*[2])") match_first <- !is.na(xml2::xml_find_first(bad_expr, "expr[2][expr[1] = following-sibling::expr[1]]")) optimizer <- ifelse((operator %in% c("<", "<=")) == match_first, "pmin", "pmax") first_var <- rep_len("x", length(match_first)) diff --git a/R/lintr-package.R b/R/lintr-package.R index d72c1780b..88e5b736f 100644 --- a/R/lintr-package.R +++ b/R/lintr-package.R @@ -12,7 +12,7 @@ #' @importFrom rex rex regex re_matches re_substitutes character_class #' @importFrom stats na.omit #' @importFrom utils capture.output head getParseData relist -#' @importFrom xml2 xml_find_all as_list +#' @importFrom xml2 xml_find_all xml_find_chr as_list #' @importFrom cyclocomp cyclocomp #' @importFrom utils tail #' @rawNamespace diff --git a/R/missing_argument_linter.R b/R/missing_argument_linter.R index 82f13aaa7..835f9840e 100644 --- a/R/missing_argument_linter.R +++ b/R/missing_argument_linter.R @@ -51,7 +51,7 @@ missing_argument_linter <- function(except = c("alist", "quote", "switch"), allo xml <- source_expression$full_xml_parsed_content missing_args <- xml2::xml_find_all(xml, xpath) - function_call_name <- get_r_string(xml2::xml_find_chr(missing_args, to_function_xpath)) + function_call_name <- get_r_string(xml_find_char(missing_args, to_function_xpath)) xml_nodes_to_lints( missing_args[!function_call_name %in% except], diff --git a/R/package_hooks_linter.R b/R/package_hooks_linter.R index e6e4ddecd..bc6e7460a 100644 --- a/R/package_hooks_linter.R +++ b/R/package_hooks_linter.R @@ -143,7 +143,7 @@ package_hooks_linter <- function() { load_arg_name_message <- sprintf( "%s() should take two arguments, with the first starting with 'lib' and the second starting with 'pkg'.", - xml2::xml_find_chr(load_arg_name_expr, hook_xpath) + xml_find_char(load_arg_name_expr, hook_xpath) ) load_arg_name_lints <- xml_nodes_to_lints(load_arg_name_expr, source_expression, load_arg_name_message, type = "warning") @@ -153,7 +153,7 @@ package_hooks_linter <- function() { library_require_expr <- xml2::xml_find_all(xml, library_require_xpath) library_require_bad_call <- xml2::xml_text(library_require_expr) - library_require_hook <- xml2::xml_find_chr(library_require_expr, hook_xpath) + library_require_hook <- xml_find_char(library_require_expr, hook_xpath) library_require_message <- character(length(library_require_bad_call)) is_installed_packages <- library_require_bad_call == "installed.packages" library_require_message[is_installed_packages] <- @@ -168,7 +168,7 @@ package_hooks_linter <- function() { bad_unload_call_message <- sprintf( "Use library.dynam.unload() calls in .onUnload(), not %s().", - xml2::xml_find_chr(bad_unload_call_expr, hook_xpath) + xml_find_char(bad_unload_call_expr, hook_xpath) ) bad_unload_call_lints <- xml_nodes_to_lints(bad_unload_call_expr, source_expression, bad_unload_call_message, type = "warning") @@ -178,7 +178,7 @@ package_hooks_linter <- function() { unload_arg_name_message <- sprintf( "%s() should take one argument starting with 'lib'.", - xml2::xml_find_chr(unload_arg_name_expr, hook_xpath) + xml_find_char(unload_arg_name_expr, hook_xpath) ) unload_arg_name_lints <- xml_nodes_to_lints(unload_arg_name_expr, source_expression, unload_arg_name_message, type = "warning") diff --git a/R/redundant_ifelse_linter.R b/R/redundant_ifelse_linter.R index 27e5728df..575536cac 100644 --- a/R/redundant_ifelse_linter.R +++ b/R/redundant_ifelse_linter.R @@ -73,8 +73,8 @@ redundant_ifelse_linter <- function(allow10 = FALSE) { tf_expr <- xml2::xml_find_all(xml, tf_xpath) matched_call <- xp_call_name(tf_expr) # [1] call; [2] logical condition - first_arg <- xml2::xml_find_chr(tf_expr, "string(expr[3]/NUM_CONST)") - second_arg <- xml2::xml_find_chr(tf_expr, "string(expr[4]/NUM_CONST)") + first_arg <- xml_find_char(tf_expr, "string(expr[3]/NUM_CONST)") + second_arg <- xml_find_char(tf_expr, "string(expr[4]/NUM_CONST)") tf_message <- sprintf( "Just use the logical condition (or its negation) directly instead of calling %s(x, %s, %s)", matched_call, first_arg, second_arg @@ -85,8 +85,8 @@ redundant_ifelse_linter <- function(allow10 = FALSE) { num_expr <- xml2::xml_find_all(xml, num_xpath) matched_call <- xp_call_name(num_expr) # [1] call; [2] logical condition - first_arg <- xml2::xml_find_chr(num_expr, "string(expr[3]/NUM_CONST)") - second_arg <- xml2::xml_find_chr(num_expr, "string(expr[4]/NUM_CONST)") + first_arg <- xml_find_char(num_expr, "string(expr[3]/NUM_CONST)") + second_arg <- xml_find_char(num_expr, "string(expr[4]/NUM_CONST)") is_numeric_01 <- first_arg %in% c("0", "1") | second_arg %in% c("0", "1") coercion_function <- ifelse(is_numeric_01, "as.numeric", "as.integer") is_negated <- first_arg %in% c("0", "0L") diff --git a/R/seq_linter.R b/R/seq_linter.R index 5c33cbcdb..e5755e3f6 100644 --- a/R/seq_linter.R +++ b/R/seq_linter.R @@ -72,7 +72,7 @@ seq_linter <- function() { ## The actual order of the nodes is document order ## In practice we need to handle length(x):1 get_fun <- function(expr, n) { - funcall <- xml2::xml_find_chr(expr, sprintf("string(./expr[%d])", n)) + funcall <- xml_find_char(expr, sprintf("string(./expr[%d])", n)) # `dplyr::n()` is special because it has no arguments, so the lint message # should mention `n()`, and not `n(...)` diff --git a/R/string_boundary_linter.R b/R/string_boundary_linter.R index 3ff0a7027..fed3efe9e 100644 --- a/R/string_boundary_linter.R +++ b/R/string_boundary_linter.R @@ -165,7 +165,7 @@ string_boundary_linter <- function(allow_grepl = FALSE) { } substr_expr <- xml2::xml_find_all(xml, substr_xpath) - substr_one <- xml2::xml_find_chr(substr_expr, substr_arg2_xpath) %in% c("1", "1L") + substr_one <- xml_find_char(substr_expr, substr_arg2_xpath) %in% c("1", "1L") substr_lint_message <- paste( ifelse( substr_one, diff --git a/R/unused_import_linter.R b/R/unused_import_linter.R index c83f09b3b..50aaf7751 100644 --- a/R/unused_import_linter.R +++ b/R/unused_import_linter.R @@ -74,7 +74,7 @@ unused_import_linter <- function(allow_ns_usage = FALSE, except_packages = c("bi if (length(import_exprs) == 0L) { return(list()) } - imported_pkgs <- xml2::xml_find_chr(import_exprs, "string(expr[STR_CONST|SYMBOL])") + imported_pkgs <- xml_find_char(import_exprs, "string(expr[STR_CONST|SYMBOL])") # as.character(parse(...)) returns one entry per expression imported_pkgs <- as.character(parse(text = imported_pkgs, keep.source = FALSE)) diff --git a/R/utils.R b/R/utils.R index 05d010696..ad2941514 100644 --- a/R/utils.R +++ b/R/utils.R @@ -209,8 +209,8 @@ platform_independent_sort <- function(x) x[platform_independent_order(x)] #' #' @param s An input string or strings. If `s` is an `xml_node` or `xml_nodeset` and `xpath` is `NULL`, #' extract its string value with [xml2::xml_text()]. If `s` is an `xml_node` or `xml_nodeset` -#' and `xpath` is specified, it is extracted with [xml2::xml_find_chr()]. -#' @param xpath An XPath, passed on to [xml2::xml_find_chr()] after wrapping with `string()`. +#' and `xpath` is specified, it is extracted with [xml_find_char()]. +#' @param xpath An XPath, passed on to [xml_find_char()] after wrapping with `string()`. #' #' @examplesIf requireNamespace("withr", quietly = TRUE) #' tmp <- withr::local_tempfile(lines = "c('a', 'b')") @@ -233,7 +233,7 @@ get_r_string <- function(s, xpath = NULL) { if (is.null(xpath)) { s <- xml2::xml_text(s) } else { - s <- xml2::xml_find_chr(s, sprintf("string(%s)", xpath)) + s <- xml_find_char(s, sprintf("string(%s)", xpath)) } } # parse() skips "" elements --> offsets the length of the output, diff --git a/R/xp_utils.R b/R/xp_utils.R index 9bd136638..5c628bb7e 100644 --- a/R/xp_utils.R +++ b/R/xp_utils.R @@ -53,7 +53,7 @@ xp_call_name <- function(expr, depth = 1L, condition = NULL) { xpath <- paste0("string(", strrep("expr/", depth), node, ")") - xml2::xml_find_chr(expr, xpath) + xml_find_char(expr, xpath) } xp_find_location <- function(xml, xpath) { From c7968de4566d8b7e4388a26a53e567fbf183a670 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 1 Aug 2023 22:09:19 +0000 Subject: [PATCH 07/16] more namespace importing --- NAMESPACE | 6 ++++++ R/T_and_F_symbol_linter.R | 6 +++--- R/any_duplicated_linter.R | 6 +++--- R/any_is_na_linter.R | 2 +- R/assignment_linter.R | 8 +++---- R/backport_linter.R | 4 ++-- R/boolean_arithmetic_linter.R | 2 +- R/brace_linter.R | 12 +++++------ R/class_equals_linter.R | 4 ++-- R/commas_linter.R | 4 ++-- R/comment_linters.R | 4 ++-- R/condition_message_linter.R | 2 +- R/conjunct_test_linter.R | 4 ++-- R/consecutive_assertion_linter.R | 2 +- R/declared_functions.R | 2 +- R/duplicate_argument_linter.R | 4 ++-- R/empty_assignment_linter.R | 2 +- R/equals_na_linter.R | 2 +- R/expect_comparison_linter.R | 4 ++-- R/expect_identical_linter.R | 2 +- R/expect_length_linter.R | 2 +- R/expect_named_linter.R | 2 +- R/expect_not_linter.R | 2 +- R/expect_null_linter.R | 2 +- R/expect_s3_class_linter.R | 2 +- R/expect_s4_class_linter.R | 2 +- R/expect_true_false_linter.R | 4 ++-- R/expect_type_linter.R | 2 +- R/extraction_operator_linter.R | 4 ++-- R/fixed_regex_linter.R | 4 ++-- R/for_loop_index_linter.R | 2 +- R/function_argument_linter.R | 2 +- R/function_left_parentheses_linter.R | 8 +++---- R/function_return_linter.R | 2 +- R/get_source_expressions.R | 2 +- R/ifelse_censor_linter.R | 6 +++--- R/implicit_assignment_linter.R | 2 +- R/implicit_integer_linter.R | 4 ++-- R/indentation_linter.R | 22 +++++++++---------- R/infix_spaces_linter.R | 2 +- R/inner_combine_linter.R | 2 +- R/is_numeric_linter.R | 4 ++-- R/lengths_linter.R | 2 +- R/lintr-deprecated.R | 8 +++---- R/lintr-package.R | 2 +- R/literal_coercion_linter.R | 4 ++-- R/matrix_apply_linter.R | 20 ++++++++--------- R/missing_argument_linter.R | 4 ++-- R/missing_package_linter.R | 4 ++-- R/namespace_linter.R | 8 +++---- R/nested_ifelse_linter.R | 2 +- R/numeric_leading_zero_linter.R | 2 +- R/object_length_linter.R | 4 ++-- R/object_name_linter.R | 4 ++-- R/object_usage_linter.R | 20 ++++++++--------- R/outer_negation_linter.R | 2 +- R/package_hooks_linter.R | 22 +++++++++---------- R/paren_body_linter.R | 2 +- R/paste_linter.R | 8 +++---- R/pipe_call_linter.R | 2 +- R/pipe_continuation_linter.R | 2 +- R/redundant_equals_linter.R | 4 ++-- R/redundant_ifelse_linter.R | 12 +++++------ R/regex_subset_linter.R | 4 ++-- R/routine_registration_linter.R | 2 +- R/semicolon_linter.R | 4 ++-- R/seq_linter.R | 4 ++-- R/sort_linter.R | 12 +++++------ R/spaces_inside_linter.R | 8 +++---- R/spaces_left_parentheses_linter.R | 2 +- R/sprintf_linter.R | 2 +- R/string_boundary_linter.R | 6 +++--- R/strings_as_factors_linter.R | 2 +- R/system_file_linter.R | 2 +- R/trailing_whitespace_linter.R | 6 +++--- R/undesirable_function_linter.R | 2 +- R/undesirable_operator_linter.R | 4 ++-- R/unnecessary_concatenation_linter.R | 8 +++---- R/unnecessary_lambda_linter.R | 12 +++++------ R/unnecessary_nested_if_linter.R | 2 +- R/unnecessary_placeholder_linter.R | 2 +- R/unreachable_code_linter.R | 4 ++-- R/unused_import_linter.R | 8 +++---- R/utils.R | 32 ++++++++++++++-------------- R/vector_logic_linter.R | 2 +- R/xml_nodes_to_lints.R | 8 +++---- R/xp_utils.R | 8 +++---- R/yoda_test_linter.R | 4 ++-- man/get_r_string.Rd | 6 +++--- man/xml_nodes_to_lints.Rd | 4 ++-- 90 files changed, 235 insertions(+), 229 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 90f98e00d..3902494b4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -158,4 +158,10 @@ importFrom(utils,head) importFrom(utils,relist) importFrom(utils,tail) importFrom(xml2,as_list) +importFrom(xml2,xml_attr) +importFrom(xml2,xml_attrs) importFrom(xml2,xml_find_all) +importFrom(xml2,xml_find_chr) +importFrom(xml2,xml_find_first) +importFrom(xml2,xml_find_num) +importFrom(xml2,xml_text) diff --git a/R/T_and_F_symbol_linter.R b/R/T_and_F_symbol_linter.R index 11fae9ad1..9c74fb865 100644 --- a/R/T_and_F_symbol_linter.R +++ b/R/T_and_F_symbol_linter.R @@ -62,11 +62,11 @@ T_and_F_symbol_linter <- function() { # nolint: object_name. return(list()) } - bad_exprs <- xml2::xml_find_all(source_expression$xml_parsed_content, xpath) - bad_assigns <- xml2::xml_find_all(source_expression$xml_parsed_content, xpath_assignment) + bad_exprs <- xml_find_all(source_expression$xml_parsed_content, xpath) + bad_assigns <- xml_find_all(source_expression$xml_parsed_content, xpath_assignment) make_lints <- function(expr, fmt) { - symbol <- xml2::xml_text(expr) + symbol <- xml_text(expr) lint_message <- sprintf(fmt, replacement_map[symbol], symbol) xml_nodes_to_lints( xml = expr, diff --git a/R/any_duplicated_linter.R b/R/any_duplicated_linter.R index 64606478b..b7ad6af07 100644 --- a/R/any_duplicated_linter.R +++ b/R/any_duplicated_linter.R @@ -92,7 +92,7 @@ any_duplicated_linter <- function() { xml <- source_expression$xml_parsed_content - any_duplicated_expr <- xml2::xml_find_all(xml, any_duplicated_xpath) + any_duplicated_expr <- xml_find_all(xml, any_duplicated_xpath) any_duplicated_lints <- xml_nodes_to_lints( any_duplicated_expr, source_expression = source_expression, @@ -100,9 +100,9 @@ any_duplicated_linter <- function() { type = "warning" ) - length_unique_expr <- xml2::xml_find_all(xml, length_unique_xpath) + length_unique_expr <- xml_find_all(xml, length_unique_xpath) lint_message <- ifelse( - is.na(xml2::xml_find_first(length_unique_expr, uses_nrow_xpath)), + is.na(xml_find_first(length_unique_expr, uses_nrow_xpath)), "anyDuplicated(x) == 0L is better than length(unique(x)) == length(x).", "anyDuplicated(DF$col) == 0L is better than length(unique(DF$col)) == nrow(DF)" ) diff --git a/R/any_is_na_linter.R b/R/any_is_na_linter.R index 693514259..cd9178a85 100644 --- a/R/any_is_na_linter.R +++ b/R/any_is_na_linter.R @@ -53,7 +53,7 @@ any_is_na_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/assignment_linter.R b/R/assignment_linter.R index f97019d30..a0a8e500e 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -106,12 +106,12 @@ assignment_linter <- function(allow_cascading_assign = TRUE, xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) if (length(bad_expr) == 0L) { return(list()) } - operator <- xml2::xml_text(bad_expr) + operator <- xml_text(bad_expr) lint_message_fmt <- rep("Use <-, not %s, for assignment.", length(operator)) lint_message_fmt[operator %in% c("<<-", "->>")] <- "%s can have hard-to-predict behavior; prefer assigning to a specific environment instead (with assign() or <-)." @@ -119,8 +119,8 @@ assignment_linter <- function(allow_cascading_assign = TRUE, "Avoid the assignment pipe %s; prefer using <- and %%>%% separately." if (!allow_trailing) { - bad_trailing_expr <- xml2::xml_find_all(xml, trailing_assign_xpath) - trailing_assignments <- xml2::xml_attrs(bad_expr) %in% xml2::xml_attrs(bad_trailing_expr) + bad_trailing_expr <- xml_find_all(xml, trailing_assign_xpath) + trailing_assignments <- xml_attrs(bad_expr) %in% xml_attrs(bad_trailing_expr) lint_message_fmt[trailing_assignments] <- "Assignment %s should not be trailing at the end of a line." } diff --git a/R/backport_linter.R b/R/backport_linter.R index 3aeb86a43..6ab9acbc8 100644 --- a/R/backport_linter.R +++ b/R/backport_linter.R @@ -50,8 +50,8 @@ backport_linter <- function(r_version = getRversion(), except = character()) { xml <- source_expression$xml_parsed_content - all_names_nodes <- xml2::xml_find_all(xml, names_xpath) - all_names <- xml2::xml_text(all_names_nodes) + all_names_nodes <- xml_find_all(xml, names_xpath) + all_names <- xml_text(all_names_nodes) # not sapply/vapply, which may over-simplify to vector # rbind makes sure we have a matrix with dimensions [n_versions x n_names] diff --git a/R/boolean_arithmetic_linter.R b/R/boolean_arithmetic_linter.R index 2bbc7bb6f..0533c2f0c 100644 --- a/R/boolean_arithmetic_linter.R +++ b/R/boolean_arithmetic_linter.R @@ -62,7 +62,7 @@ boolean_arithmetic_linter <- function() { xml <- source_expression$xml_parsed_content - any_expr <- xml2::xml_find_all(xml, any_xpath) + any_expr <- xml_find_all(xml, any_xpath) xml_nodes_to_lints( any_expr, diff --git a/R/brace_linter.R b/R/brace_linter.R index 6822b78b4..a5e06b991 100644 --- a/R/brace_linter.R +++ b/R/brace_linter.R @@ -157,7 +157,7 @@ brace_linter <- function(allow_single_line = FALSE) { lints <- c( lints, xml_nodes_to_lints( - xml2::xml_find_all(xml, xp_open_curly), + xml_find_all(xml, xp_open_curly), source_expression = source_expression, lint_message = "Opening curly braces should never go on their own line and should always be followed by a new line." @@ -167,7 +167,7 @@ brace_linter <- function(allow_single_line = FALSE) { lints <- c( lints, xml_nodes_to_lints( - xml2::xml_find_all(xml, xp_paren_brace), + xml_find_all(xml, xp_paren_brace), source_expression = source_expression, lint_message = "There should be a space before an opening curly brace." ) @@ -176,7 +176,7 @@ brace_linter <- function(allow_single_line = FALSE) { lints <- c( lints, xml_nodes_to_lints( - xml2::xml_find_all(xml, xp_closed_curly), + xml_find_all(xml, xp_closed_curly), source_expression = source_expression, lint_message = "Closing curly-braces should always be on their own line, unless they are followed by an else." @@ -186,7 +186,7 @@ brace_linter <- function(allow_single_line = FALSE) { lints <- c( lints, xml_nodes_to_lints( - xml2::xml_find_all(xml, xp_else_same_line), + xml_find_all(xml, xp_else_same_line), source_expression = source_expression, lint_message = "`else` should come on the same line as the previous `}`." ) @@ -195,7 +195,7 @@ brace_linter <- function(allow_single_line = FALSE) { lints <- c( lints, xml_nodes_to_lints( - xml2::xml_find_all(xml, xp_function_brace), + xml_find_all(xml, xp_function_brace), source_expression = source_expression, lint_message = "Any function spanning multiple lines should use curly braces." ) @@ -204,7 +204,7 @@ brace_linter <- function(allow_single_line = FALSE) { lints <- c( lints, xml_nodes_to_lints( - xml2::xml_find_all(xml, xp_if_else_match_brace), + xml_find_all(xml, xp_if_else_match_brace), source_expression = source_expression, lint_message = "Either both or neither branch in `if`/`else` should use curly braces." ) diff --git a/R/class_equals_linter.R b/R/class_equals_linter.R index e5e458653..e5b795022 100644 --- a/R/class_equals_linter.R +++ b/R/class_equals_linter.R @@ -51,9 +51,9 @@ class_equals_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) - operator <- xml_find_char(bad_expr, "string(*[2])") + operator <- xml_find_chr(bad_expr, "string(*[2])") lint_message <- sprintf( "Instead of comparing class(x) with %s, use inherits(x, 'class-name') or is. or is(x, 'class')", operator diff --git a/R/commas_linter.R b/R/commas_linter.R index bb9023688..d7ff5ac14 100644 --- a/R/commas_linter.R +++ b/R/commas_linter.R @@ -67,7 +67,7 @@ commas_linter <- function() { xml <- source_expression$xml_parsed_content before_lints <- xml_nodes_to_lints( - xml2::xml_find_all(xml, xpath_before), + xml_find_all(xml, xpath_before), source_expression = source_expression, lint_message = "Commas should never have a space before.", range_start_xpath = "number(./preceding-sibling::*[1]/@col2 + 1)", # start after preceding expression @@ -75,7 +75,7 @@ commas_linter <- function() { ) after_lints <- xml_nodes_to_lints( - xml2::xml_find_all(xml, xpath_after), + xml_find_all(xml, xpath_after), source_expression = source_expression, lint_message = "Commas should always have a space after.", range_start_xpath = "number(./@col2 + 1)", # start and end after comma diff --git a/R/comment_linters.R b/R/comment_linters.R index 007588171..01470fbd5 100644 --- a/R/comment_linters.R +++ b/R/comment_linters.R @@ -79,8 +79,8 @@ commented_code_linter <- function() { if (!is_lint_level(source_expression, "file")) { return(list()) } - all_comment_nodes <- xml2::xml_find_all(source_expression$full_xml_parsed_content, "//COMMENT") - all_comments <- xml2::xml_text(all_comment_nodes) + all_comment_nodes <- xml_find_all(source_expression$full_xml_parsed_content, "//COMMENT") + all_comments <- xml_text(all_comment_nodes) code_candidates <- re_matches(all_comments, code_candidate_regex, global = FALSE, locations = TRUE) extracted_code <- code_candidates[, "code"] # ignore trailing ',' when testing for parsability diff --git a/R/condition_message_linter.R b/R/condition_message_linter.R index 8ed70fc45..0c59bfe66 100644 --- a/R/condition_message_linter.R +++ b/R/condition_message_linter.R @@ -59,7 +59,7 @@ condition_message_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) sep_value <- get_r_string(bad_expr, xpath = "./expr/SYMBOL_SUB[text() = 'sep']/following-sibling::expr/STR_CONST") bad_expr <- bad_expr[is.na(sep_value) | sep_value %in% c("", " ")] diff --git a/R/conjunct_test_linter.R b/R/conjunct_test_linter.R index ea42daece..76ecd4653 100644 --- a/R/conjunct_test_linter.R +++ b/R/conjunct_test_linter.R @@ -72,14 +72,14 @@ conjunct_test_linter <- function(allow_named_stopifnot = TRUE) { xml <- source_expression$full_xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) if (length(bad_expr) == 0L) { return(list()) } matched_fun <- xp_call_name(bad_expr) - operator <- xml_find_char(bad_expr, "string(expr/*[self::AND2 or self::OR2])") + operator <- xml_find_chr(bad_expr, "string(expr/*[self::AND2 or self::OR2])") replacement_fmt <- ifelse( matched_fun %in% c("expect_true", "expect_false"), "write multiple expectations like %1$s(A) and %1$s(B)", diff --git a/R/consecutive_assertion_linter.R b/R/consecutive_assertion_linter.R index 3a83584cf..22042f754 100644 --- a/R/consecutive_assertion_linter.R +++ b/R/consecutive_assertion_linter.R @@ -55,7 +55,7 @@ consecutive_assertion_linter <- function() { xml <- source_expression$full_xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) matched_function <- xp_call_name(bad_expr) xml_nodes_to_lints( diff --git a/R/declared_functions.R b/R/declared_functions.R index 1e8849060..0096946b9 100644 --- a/R/declared_functions.R +++ b/R/declared_functions.R @@ -15,5 +15,5 @@ declared_s3_generics <- function(x) { "/expr/SYMBOL/text()" ) - as.character(xml2::xml_find_all(x, xpath)) + as.character(xml_find_all(x, xpath)) } diff --git a/R/duplicate_argument_linter.R b/R/duplicate_argument_linter.R index 61d166ef8..4c1bd32fe 100644 --- a/R/duplicate_argument_linter.R +++ b/R/duplicate_argument_linter.R @@ -47,14 +47,14 @@ duplicate_argument_linter <- function(except = c("mutate", "transmute")) { xml <- source_expression$full_xml_parsed_content - calls <- xml2::xml_find_all(xml, xpath_call_with_args) + calls <- xml_find_all(xml, xpath_call_with_args) if (length(except) > 0L) { calls_text <- get_r_string(xp_call_name(calls)) calls <- calls[!(calls_text %in% except)] } - all_arg_nodes <- lapply(calls, xml2::xml_find_all, xpath_arg_name) + all_arg_nodes <- lapply(calls, xml_find_all, xpath_arg_name) arg_names <- lapply(all_arg_nodes, get_r_string) is_duplicated <- lapply(arg_names, duplicated) diff --git a/R/empty_assignment_linter.R b/R/empty_assignment_linter.R index 36a340e67..fbb2338ef 100644 --- a/R/empty_assignment_linter.R +++ b/R/empty_assignment_linter.R @@ -49,7 +49,7 @@ empty_assignment_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/equals_na_linter.R b/R/equals_na_linter.R index f52112ac7..16af7e1b9 100644 --- a/R/equals_na_linter.R +++ b/R/equals_na_linter.R @@ -45,7 +45,7 @@ equals_na_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/expect_comparison_linter.R b/R/expect_comparison_linter.R index bd2f18d5f..e9801bf35 100644 --- a/R/expect_comparison_linter.R +++ b/R/expect_comparison_linter.R @@ -70,9 +70,9 @@ expect_comparison_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) - comparator <- xml_find_char(bad_expr, "string(expr[2]/*[2])") + comparator <- xml_find_chr(bad_expr, "string(expr[2]/*[2])") expectation <- comparator_expectation_map[comparator] lint_message <- sprintf("%s(x, y) is better than expect_true(x %s y).", expectation, comparator) xml_nodes_to_lints(bad_expr, source_expression, lint_message = lint_message, type = "warning") diff --git a/R/expect_identical_linter.R b/R/expect_identical_linter.R index 4e3146259..0202e08dd 100644 --- a/R/expect_identical_linter.R +++ b/R/expect_identical_linter.R @@ -88,7 +88,7 @@ expect_identical_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, source_expression = source_expression, diff --git a/R/expect_length_linter.R b/R/expect_length_linter.R index a4dd3ad58..bebac9484 100644 --- a/R/expect_length_linter.R +++ b/R/expect_length_linter.R @@ -39,7 +39,7 @@ expect_length_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) matched_function <- xp_call_name(bad_expr) lint_message <- sprintf("expect_length(x, n) is better than %s(length(x), n)", matched_function) xml_nodes_to_lints(bad_expr, source_expression, lint_message, type = "warning") diff --git a/R/expect_named_linter.R b/R/expect_named_linter.R index 9bb82e254..19328aa2b 100644 --- a/R/expect_named_linter.R +++ b/R/expect_named_linter.R @@ -48,7 +48,7 @@ expect_named_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) matched_function <- xp_call_name(bad_expr) lint_message <- sprintf("expect_named(x, n) is better than %s(names(x), n)", matched_function) diff --git a/R/expect_not_linter.R b/R/expect_not_linter.R index cd0099e38..22826ceb7 100644 --- a/R/expect_not_linter.R +++ b/R/expect_not_linter.R @@ -37,7 +37,7 @@ expect_not_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/expect_null_linter.R b/R/expect_null_linter.R index a82a7d648..dba609b2c 100644 --- a/R/expect_null_linter.R +++ b/R/expect_null_linter.R @@ -60,7 +60,7 @@ expect_null_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) matched_function <- xp_call_name(bad_expr) msg <- ifelse( diff --git a/R/expect_s3_class_linter.R b/R/expect_s3_class_linter.R index 04431992d..28e536e45 100644 --- a/R/expect_s3_class_linter.R +++ b/R/expect_s3_class_linter.R @@ -61,7 +61,7 @@ expect_s3_class_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) matched_function <- xp_call_name(bad_expr) msg <- ifelse( matched_function %in% c("expect_equal", "expect_identical"), diff --git a/R/expect_s4_class_linter.R b/R/expect_s4_class_linter.R index 6c4d16b8d..3b76ee64a 100644 --- a/R/expect_s4_class_linter.R +++ b/R/expect_s4_class_linter.R @@ -42,7 +42,7 @@ expect_s4_class_linter <- function() { # TODO(michaelchirico): also catch expect_{equal,identical}(methods::is(x), k). # this seems empirically rare, but didn't check many S4-heavy packages. - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, source_expression = source_expression, diff --git a/R/expect_true_false_linter.R b/R/expect_true_false_linter.R index b347073bc..e01302176 100644 --- a/R/expect_true_false_linter.R +++ b/R/expect_true_false_linter.R @@ -46,11 +46,11 @@ expect_true_false_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) # NB: use expr/$node, not expr[$node], to exclude other things (especially ns:: parts of the call) call_name <- xp_call_name(bad_expr, condition = "starts-with(text(), 'expect_')") - truth_value <- xml_find_char(bad_expr, "string(expr/NUM_CONST[text() = 'TRUE' or text() = 'FALSE'])") + truth_value <- xml_find_chr(bad_expr, "string(expr/NUM_CONST[text() = 'TRUE' or text() = 'FALSE'])") lint_message <- sprintf( "expect_%s(x) is better than %s(x, %s)", tolower(truth_value), call_name, truth_value diff --git a/R/expect_type_linter.R b/R/expect_type_linter.R index b1465f441..3f0bf9d1d 100644 --- a/R/expect_type_linter.R +++ b/R/expect_type_linter.R @@ -52,7 +52,7 @@ expect_type_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) matched_function <- xp_call_name(bad_expr) msg <- ifelse( matched_function %in% c("expect_equal", "expect_identical"), diff --git a/R/extraction_operator_linter.R b/R/extraction_operator_linter.R index 729116d6e..0a59becae 100644 --- a/R/extraction_operator_linter.R +++ b/R/extraction_operator_linter.R @@ -67,8 +67,8 @@ extraction_operator_linter <- function() { } xml <- source_expression$xml_parsed_content - bad_exprs <- xml2::xml_find_all(xml, xpath) - msgs <- sprintf("Use `[[` instead of `%s` to extract an element.", xml2::xml_text(bad_exprs)) + bad_exprs <- xml_find_all(xml, xpath) + msgs <- sprintf("Use `[[` instead of `%s` to extract an element.", xml_text(bad_exprs)) xml_nodes_to_lints( bad_exprs, diff --git a/R/fixed_regex_linter.R b/R/fixed_regex_linter.R index 2a092475c..7725c77c4 100644 --- a/R/fixed_regex_linter.R +++ b/R/fixed_regex_linter.R @@ -114,12 +114,12 @@ fixed_regex_linter <- function() { xml <- source_expression$xml_parsed_content - patterns <- xml2::xml_find_all(xml, xpath) + patterns <- xml_find_all(xml, xpath) pattern_strings <- get_r_string(patterns) is_static <- is_not_regex(pattern_strings) fixed_equivalent <- encodeString(get_fixed_string(pattern_strings[is_static]), quote = '"', justify = "none") - call_name <- xml_find_char(patterns[is_static], "string(preceding-sibling::expr[last()]/SYMBOL_FUNCTION_CALL)") + call_name <- xml_find_chr(patterns[is_static], "string(preceding-sibling::expr[last()]/SYMBOL_FUNCTION_CALL)") is_stringr <- startsWith(call_name, "str_") replacement <- ifelse( diff --git a/R/for_loop_index_linter.R b/R/for_loop_index_linter.R index 08c070531..af68c3b64 100644 --- a/R/for_loop_index_linter.R +++ b/R/for_loop_index_linter.R @@ -49,7 +49,7 @@ for_loop_index_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/function_argument_linter.R b/R/function_argument_linter.R index 70db8ab56..af738e68d 100644 --- a/R/function_argument_linter.R +++ b/R/function_argument_linter.R @@ -62,7 +62,7 @@ function_argument_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/function_left_parentheses_linter.R b/R/function_left_parentheses_linter.R index 99f30f5c8..e19db0d8b 100644 --- a/R/function_left_parentheses_linter.R +++ b/R/function_left_parentheses_linter.R @@ -64,21 +64,21 @@ function_left_parentheses_linter <- function() { # nolint: object_length. xml <- source_expression$xml_parsed_content - bad_line_fun_exprs <- xml2::xml_find_all(xml, bad_line_fun_xpath) + bad_line_fun_exprs <- xml_find_all(xml, bad_line_fun_xpath) bad_line_fun_lints <- xml_nodes_to_lints( bad_line_fun_exprs, source_expression = source_expression, lint_message = "Left parenthesis should be on the same line as the 'function' symbol." ) - bad_line_call_exprs <- xml2::xml_find_all(xml, bad_line_call_xpath) + bad_line_call_exprs <- xml_find_all(xml, bad_line_call_xpath) bad_line_call_lints <- xml_nodes_to_lints( bad_line_call_exprs, source_expression = source_expression, lint_message = "Left parenthesis should be on the same line as the function's symbol." ) - bad_col_fun_exprs <- xml2::xml_find_all(xml, bad_col_fun_xpath) + bad_col_fun_exprs <- xml_find_all(xml, bad_col_fun_xpath) bad_col_fun_lints <- xml_nodes_to_lints( bad_col_fun_exprs, source_expression = source_expression, @@ -87,7 +87,7 @@ function_left_parentheses_linter <- function() { # nolint: object_length. range_end_xpath = "number(./following-sibling::OP-LEFT-PAREN/@col1 - 1)" # end before ( ) - bad_col_call_exprs <- xml2::xml_find_all(xml, bad_col_call_xpath) + bad_col_call_exprs <- xml_find_all(xml, bad_col_call_xpath) bad_col_call_lints <- xml_nodes_to_lints( bad_col_call_exprs, source_expression = source_expression, diff --git a/R/function_return_linter.R b/R/function_return_linter.R index 6d325db08..252cca808 100644 --- a/R/function_return_linter.R +++ b/R/function_return_linter.R @@ -68,7 +68,7 @@ function_return_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/get_source_expressions.R b/R/get_source_expressions.R index 736bdd65e..6030b3b19 100644 --- a/R/get_source_expressions.R +++ b/R/get_source_expressions.R @@ -101,7 +101,7 @@ get_source_expressions <- function(filename, lines = NULL) { if (!is.null(xml_parsed_content) && !is.na(xml_parsed_content)) { expression_xmls <- lapply( - xml2::xml_find_all(xml_parsed_content, "/exprlist/*"), + xml_find_all(xml_parsed_content, "/exprlist/*"), function(top_level_expr) xml2::xml_add_parent(xml2::xml_new_root(top_level_expr), "exprlist") ) for (i in seq_along(expressions)) { diff --git a/R/ifelse_censor_linter.R b/R/ifelse_censor_linter.R index 558014830..b574303df 100644 --- a/R/ifelse_censor_linter.R +++ b/R/ifelse_censor_linter.R @@ -53,11 +53,11 @@ ifelse_censor_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) matched_call <- xp_call_name(bad_expr) - operator <- xml_find_char(bad_expr, "string(expr[2]/*[2])") - match_first <- !is.na(xml2::xml_find_first(bad_expr, "expr[2][expr[1] = following-sibling::expr[1]]")) + operator <- xml_find_chr(bad_expr, "string(expr[2]/*[2])") + match_first <- !is.na(xml_find_first(bad_expr, "expr[2][expr[1] = following-sibling::expr[1]]")) optimizer <- ifelse((operator %in% c("<", "<=")) == match_first, "pmin", "pmax") first_var <- rep_len("x", length(match_first)) second_var <- rep_len("y", length(match_first)) diff --git a/R/implicit_assignment_linter.R b/R/implicit_assignment_linter.R index b025b8c70..6978f52a4 100644 --- a/R/implicit_assignment_linter.R +++ b/R/implicit_assignment_linter.R @@ -101,7 +101,7 @@ implicit_assignment_linter <- function(except = c("bquote", "expression", "expr" xml <- source_expression$full_xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) lint_message <- paste( "Avoid implicit assignments in function calls.", diff --git a/R/implicit_integer_linter.R b/R/implicit_integer_linter.R index df791528b..76a407cd1 100644 --- a/R/implicit_integer_linter.R +++ b/R/implicit_integer_linter.R @@ -58,10 +58,10 @@ implicit_integer_linter <- function(allow_colon = FALSE) { xml <- source_expression$full_xml_parsed_content - numbers <- xml2::xml_find_all(xml, xpath) + numbers <- xml_find_all(xml, xpath) xml_nodes_to_lints( - numbers[is_implicit_integer(xml2::xml_text(numbers))], + numbers[is_implicit_integer(xml_text(numbers))], source_expression = source_expression, lint_message = "Integers should not be implicit. Use the form 1L for integers or 1.0 for doubles.", type = "style", diff --git a/R/indentation_linter.R b/R/indentation_linter.R index 9e68df9d2..4003e80b0 100644 --- a/R/indentation_linter.R +++ b/R/indentation_linter.R @@ -219,29 +219,29 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al expected_indent_levels <- integer(length(indent_levels)) is_hanging <- logical(length(indent_levels)) - indent_changes <- xml2::xml_find_all(xml, xp_indent_changes) + indent_changes <- xml_find_all(xml, xp_indent_changes) for (change in indent_changes) { change_type <- find_indent_type(change) - change_begin <- as.integer(xml2::xml_attr(change, "line1")) + 1L - change_end <- xml2::xml_find_num(change, xp_block_ends) + change_begin <- as.integer(xml_attr(change, "line1")) + 1L + change_end <- xml_find_num(change, xp_block_ends) if (isTRUE(change_begin <= change_end)) { to_indent <- seq(from = change_begin, to = change_end) expected_indent_levels[to_indent] <- find_new_indent( current_indent = expected_indent_levels[to_indent], change_type = change_type, indent = indent, - hanging_indent = as.integer(xml2::xml_attr(change, "col2")) + hanging_indent = as.integer(xml_attr(change, "col2")) ) is_hanging[to_indent] <- change_type == "hanging" } } in_str_const <- logical(length(indent_levels)) - multiline_strings <- xml2::xml_find_all(xml, xp_multiline_string) + multiline_strings <- xml_find_all(xml, xp_multiline_string) for (string in multiline_strings) { is_in_str <- seq( - from = as.integer(xml2::xml_attr(string, "line1")) + 1L, - to = as.integer(xml2::xml_attr(string, "line2")) + from = as.integer(xml_attr(string, "line1")) + 1L, + to = as.integer(xml_attr(string, "line2")) ) in_str_const[is_in_str] <- TRUE } @@ -359,11 +359,11 @@ build_indentation_style_tidy <- function() { ) function(change) { - if (length(xml2::xml_find_first(change, xp_is_double_indent)) > 0L) { + if (length(xml_find_first(change, xp_is_double_indent)) > 0L) { "double" - } else if (length(xml2::xml_find_first(change, xp_suppress)) > 0L) { + } else if (length(xml_find_first(change, xp_suppress)) > 0L) { "suppress" - } else if (length(xml2::xml_find_first(change, xp_is_not_hanging)) == 0L) { + } else if (length(xml_find_first(change, xp_is_not_hanging)) == 0L) { "hanging" } else { "block" @@ -388,7 +388,7 @@ build_indentation_style_always <- function() { ) function(change) { - if (length(xml2::xml_find_first(change, xp_is_not_hanging)) == 0L) { + if (length(xml_find_first(change, xp_is_not_hanging)) == 0L) { "hanging" } else { "block" diff --git a/R/infix_spaces_linter.R b/R/infix_spaces_linter.R index fcdce9e5b..f431f6c7b 100644 --- a/R/infix_spaces_linter.R +++ b/R/infix_spaces_linter.R @@ -174,7 +174,7 @@ infix_spaces_linter <- function(exclude_operators = NULL, allow_multiple_spaces } xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/inner_combine_linter.R b/R/inner_combine_linter.R index 86673ff6a..2b1f22af8 100644 --- a/R/inner_combine_linter.R +++ b/R/inner_combine_linter.R @@ -90,7 +90,7 @@ inner_combine_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) matched_call <- xp_call_name(bad_expr, depth = 2L) lint_message <- paste( diff --git a/R/is_numeric_linter.R b/R/is_numeric_linter.R index 4bcefa8b9..dcfe670c0 100644 --- a/R/is_numeric_linter.R +++ b/R/is_numeric_linter.R @@ -76,7 +76,7 @@ is_numeric_linter <- function() { xml <- source_expression$xml_parsed_content - or_expr <- xml2::xml_find_all(xml, or_xpath) + or_expr <- xml_find_all(xml, or_xpath) or_lints <- xml_nodes_to_lints( or_expr, source_expression = source_expression, @@ -87,7 +87,7 @@ is_numeric_linter <- function() { type = "warning" ) - class_expr <- xml2::xml_find_all(xml, class_xpath) + class_expr <- xml_find_all(xml, class_xpath) if (length(class_expr) > 0L) { class_strings <- c( get_r_string(class_expr, "expr[2]/expr[2]/STR_CONST"), diff --git a/R/lengths_linter.R b/R/lengths_linter.R index b24a39ff4..48a04230a 100644 --- a/R/lengths_linter.R +++ b/R/lengths_linter.R @@ -45,7 +45,7 @@ lengths_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/lintr-deprecated.R b/R/lintr-deprecated.R index cb2c8395b..1037ad912 100644 --- a/R/lintr-deprecated.R +++ b/R/lintr-deprecated.R @@ -64,7 +64,7 @@ closed_curly_linter <- function(allow_single_line = FALSE) { } xml_nodes_to_lints( - xml2::xml_find_all(source_expression$xml_parsed_content, xpath), + xml_find_all(source_expression$xml_parsed_content, xpath), source_expression = source_expression, lint_message = "Closing curly-braces should always be on their own line, unless they are followed by an else." ) @@ -109,7 +109,7 @@ open_curly_linter <- function(allow_single_line = FALSE) { xml <- source_expression$xml_parsed_content - expr_before <- xml2::xml_find_all(xml, xpath_before) + expr_before <- xml_find_all(xml, xpath_before) lints_before <- xml_nodes_to_lints( expr_before, source_expression = source_expression, @@ -117,7 +117,7 @@ open_curly_linter <- function(allow_single_line = FALSE) { type = "style" ) - expr_after <- xml2::xml_find_all(xml, xpath_after) + expr_after <- xml_find_all(xml, xpath_after) lints_after <- xml_nodes_to_lints( expr_after, source_expression = source_expression, @@ -150,7 +150,7 @@ paren_brace_linter <- function() { xml <- source_expression$xml_parsed_content - match_exprs <- xml2::xml_find_all(xml, xpath) + match_exprs <- xml_find_all(xml, xpath) xml_nodes_to_lints( match_exprs, diff --git a/R/lintr-package.R b/R/lintr-package.R index 88e5b736f..ffecab706 100644 --- a/R/lintr-package.R +++ b/R/lintr-package.R @@ -12,7 +12,7 @@ #' @importFrom rex rex regex re_matches re_substitutes character_class #' @importFrom stats na.omit #' @importFrom utils capture.output head getParseData relist -#' @importFrom xml2 xml_find_all xml_find_chr as_list +#' @importFrom xml2 xml_attr xml_attrs xml_find_all xml_find_chr xml_find_num xml_find_first xml_text as_list #' @importFrom cyclocomp cyclocomp #' @importFrom utils tail #' @rawNamespace diff --git a/R/literal_coercion_linter.R b/R/literal_coercion_linter.R index 02055cb4d..637a7c27c 100644 --- a/R/literal_coercion_linter.R +++ b/R/literal_coercion_linter.R @@ -80,7 +80,7 @@ literal_coercion_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) coercer <- xp_call_name(bad_expr) # tiptoe around the fact that we don't require {rlang} @@ -96,7 +96,7 @@ literal_coercion_linter <- function() { ) } else { # duplicate, unless we add 'rlang::' and it wasn't there originally - coercion_str <- report_str <- xml2::xml_text(bad_expr) + coercion_str <- report_str <- xml_text(bad_expr) if (any(is_rlang_coercer) && !("package:rlang" %in% search())) { needs_prefix <- is_rlang_coercer & !startsWith(coercion_str, "rlang::") coercion_str[needs_prefix] <- paste0("rlang::", coercion_str[needs_prefix]) diff --git a/R/matrix_apply_linter.R b/R/matrix_apply_linter.R index 961945e71..b0d7f390c 100644 --- a/R/matrix_apply_linter.R +++ b/R/matrix_apply_linter.R @@ -83,17 +83,17 @@ matrix_apply_linter <- function() { } xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) - var <- xml2::xml_text(xml2::xml_find_all(bad_expr, var_xpath)) + var <- xml_text(xml_find_all(bad_expr, var_xpath)) - fun <- xml2::xml_text(xml2::xml_find_all(bad_expr, fun_xpath)) + fun <- xml_text(xml_find_all(bad_expr, fun_xpath)) fun <- tools::toTitleCase(fun) - margin <- xml2::xml_find_all(bad_expr, margin_xpath) + margin <- xml_find_all(bad_expr, margin_xpath) - narm_val <- xml2::xml_text( - xml2::xml_find_first(bad_expr, "SYMBOL_SUB[text() = 'na.rm']/following-sibling::expr") + narm_val <- xml_text( + xml_find_first(bad_expr, "SYMBOL_SUB[text() = 'na.rm']/following-sibling::expr") ) recos <- Map(craft_colsums_rowsums_msg, var, margin, fun, narm_val) @@ -109,12 +109,12 @@ matrix_apply_linter <- function() { craft_colsums_rowsums_msg <- function(var, margin, fun, narm_val) { - if (is.na(xml2::xml_find_first(margin, "OP-COLON"))) { - l1 <- xml2::xml_text(margin) + if (is.na(xml_find_first(margin, "OP-COLON"))) { + l1 <- xml_text(margin) l2 <- NULL } else { - l1 <- xml2::xml_text(xml2::xml_find_first(margin, "expr[1]")) - l2 <- xml2::xml_text(xml2::xml_find_first(margin, "expr[2]")) + l1 <- xml_text(xml_find_first(margin, "expr[1]")) + l2 <- xml_text(xml_find_first(margin, "expr[2]")) } # See #1764 for details about various cases. In short: diff --git a/R/missing_argument_linter.R b/R/missing_argument_linter.R index 835f9840e..ea025a068 100644 --- a/R/missing_argument_linter.R +++ b/R/missing_argument_linter.R @@ -50,8 +50,8 @@ missing_argument_linter <- function(except = c("alist", "quote", "switch"), allo xml <- source_expression$full_xml_parsed_content - missing_args <- xml2::xml_find_all(xml, xpath) - function_call_name <- get_r_string(xml_find_char(missing_args, to_function_xpath)) + missing_args <- xml_find_all(xml, xpath) + function_call_name <- get_r_string(xml_find_chr(missing_args, to_function_xpath)) xml_nodes_to_lints( missing_args[!function_call_name %in% except], diff --git a/R/missing_package_linter.R b/R/missing_package_linter.R index 2ab0b9d63..7418a1abd 100644 --- a/R/missing_package_linter.R +++ b/R/missing_package_linter.R @@ -49,8 +49,8 @@ missing_package_linter <- function() { xml <- source_expression$full_xml_parsed_content - pkg_calls <- xml2::xml_find_all(xml, call_xpath) - pkg_names <- get_r_string(xml2::xml_find_all( + pkg_calls <- xml_find_all(xml, call_xpath) + pkg_names <- get_r_string(xml_find_all( pkg_calls, "OP-LEFT-PAREN[1]/following-sibling::expr[1][SYMBOL | STR_CONST]" )) diff --git a/R/namespace_linter.R b/R/namespace_linter.R index b301db9e9..a0ca682d5 100644 --- a/R/namespace_linter.R +++ b/R/namespace_linter.R @@ -46,7 +46,7 @@ namespace_linter <- function(check_exports = TRUE, check_nonexports = TRUE) { xml <- source_expression$full_xml_parsed_content - ns_nodes <- xml2::xml_find_all(xml, "//NS_GET | //NS_GET_INT") + ns_nodes <- xml_find_all(xml, "//NS_GET | //NS_GET_INT") if (length(ns_nodes) == 0L) { return(list()) @@ -54,7 +54,7 @@ namespace_linter <- function(check_exports = TRUE, check_nonexports = TRUE) { ## Case 1: pkg is uninstalled in pkg::foo - package_nodes <- xml2::xml_find_all(ns_nodes, "preceding-sibling::*[1]") + package_nodes <- xml_find_all(ns_nodes, "preceding-sibling::*[1]") packages <- get_r_string(package_nodes) lints <- list() @@ -95,8 +95,8 @@ namespace_linter <- function(check_exports = TRUE, check_nonexports = TRUE) { } # nocov end - ns_get <- xml2::xml_text(ns_nodes) == "::" - symbol_nodes <- xml2::xml_find_all(ns_nodes, "following-sibling::*[1]") + ns_get <- xml_text(ns_nodes) == "::" + symbol_nodes <- xml_find_all(ns_nodes, "following-sibling::*[1]") symbols <- get_r_string(symbol_nodes) if (check_nonexports) { diff --git a/R/nested_ifelse_linter.R b/R/nested_ifelse_linter.R index 0afc0e791..a70ed7a1f 100644 --- a/R/nested_ifelse_linter.R +++ b/R/nested_ifelse_linter.R @@ -49,7 +49,7 @@ nested_ifelse_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) matched_call <- xp_call_name(bad_expr) lint_message <- paste( diff --git a/R/numeric_leading_zero_linter.R b/R/numeric_leading_zero_linter.R index 57ffdb6e9..c7b755802 100644 --- a/R/numeric_leading_zero_linter.R +++ b/R/numeric_leading_zero_linter.R @@ -44,7 +44,7 @@ numeric_leading_zero_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/object_length_linter.R b/R/object_length_linter.R index 1610e6f01..98a227a69 100644 --- a/R/object_length_linter.R +++ b/R/object_length_linter.R @@ -44,11 +44,11 @@ object_length_linter <- function(length = 30L) { xml <- source_expression$full_xml_parsed_content - assignments <- xml2::xml_find_all(xml, object_name_xpath) + assignments <- xml_find_all(xml, object_name_xpath) # Retrieve assigned name nms <- strip_names( - xml2::xml_text(assignments) + xml_text(assignments) ) # run namespace_imports at run-time, not "compile" time to allow package structure to change diff --git a/R/object_name_linter.R b/R/object_name_linter.R index 6dc3c86ef..4b4169679 100644 --- a/R/object_name_linter.R +++ b/R/object_name_linter.R @@ -138,11 +138,11 @@ object_name_linter <- function(styles = c("snake_case", "symbols"), regexes = ch xml <- source_expression$full_xml_parsed_content - assignments <- xml2::xml_find_all(xml, object_name_xpath) + assignments <- xml_find_all(xml, object_name_xpath) # Retrieve assigned name nms <- strip_names( - xml2::xml_text(assignments) + xml_text(assignments) ) # run namespace_imports at run-time, not "compile" time to allow package structure to change diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index bf7792300..20b55161b 100644 --- a/R/object_usage_linter.R +++ b/R/object_usage_linter.R @@ -78,7 +78,7 @@ object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) { assign(symbol, function(...) invisible(), envir = env) } - fun_assignments <- xml2::xml_find_all(xml, xpath_function_assignment) + fun_assignments <- xml_find_all(xml, xpath_function_assignment) lapply(fun_assignments, function(fun_assignment) { code <- get_content(lines = source_expression$content, fun_assignment) @@ -98,8 +98,8 @@ object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) { fun, known_used_symbols = known_used_symbols, declared_globals = declared_globals, - start_line = as.integer(xml2::xml_attr(fun_assignment, "line1")), - end_line = as.integer(xml2::xml_attr(fun_assignment, "line2")), + start_line = as.integer(xml_attr(fun_assignment, "line1")), + end_line = as.integer(xml_attr(fun_assignment, "line2")), skip_with = skip_with ) @@ -107,10 +107,10 @@ object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) { # e.g. `not_existing<-`(a, b) res$name <- rex::re_substitutes(res$name, rex::rex("<-"), "") - lintable_symbols <- xml2::xml_find_all(fun_assignment, xpath_culprit_symbol) + lintable_symbols <- xml_find_all(fun_assignment, xpath_culprit_symbol) - lintable_symbol_names <- gsub("^`|`$", "", xml2::xml_text(lintable_symbols)) - lintable_symbol_lines <- as.integer(xml2::xml_attr(lintable_symbols, "line1")) + lintable_symbol_names <- gsub("^`|`$", "", xml_text(lintable_symbols)) + lintable_symbol_lines <- as.integer(xml_attr(lintable_symbols, "line1")) matched_symbol <- vapply( seq_len(nrow(res)), @@ -129,7 +129,7 @@ object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) { # fallback to line based matching if no symbol is found missing_symbol <- is.na(matched_symbol) nodes[missing_symbol] <- lapply(which(missing_symbol), function(i) { - line_based_match <- xml2::xml_find_first( + line_based_match <- xml_find_first( fun_assignment, glue_data(res[i, ], "descendant::expr[@line1 = {line1} and @line2 = {line2}]") ) @@ -166,7 +166,7 @@ extract_glued_symbols <- function(expr) { # # Package stringr: # - str_interp - glue_calls <- xml2::xml_find_all( + glue_calls <- xml_find_all( expr, xpath = paste0( "descendant::SYMBOL_FUNCTION_CALL[text() = 'glue']/", # a glue() call @@ -231,7 +231,7 @@ symbol_extractor <- function(text, envir, data) { } get_assignment_symbols <- function(xml) { - get_r_string(xml2::xml_find_all( + get_r_string(xml_find_all( xml, " expr[LEFT_ASSIGN]/expr[1]/SYMBOL[1] | @@ -333,7 +333,7 @@ get_imported_symbols <- function(xml) { ] /expr[STR_CONST or SYMBOL][1] " - import_exprs <- xml2::xml_find_all(xml, import_exprs_xpath) + import_exprs <- xml_find_all(xml, import_exprs_xpath) if (length(import_exprs) == 0L) { return(character()) } diff --git a/R/outer_negation_linter.R b/R/outer_negation_linter.R index 2429f6b09..e290005e2 100644 --- a/R/outer_negation_linter.R +++ b/R/outer_negation_linter.R @@ -57,7 +57,7 @@ outer_negation_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) matched_call <- xp_call_name(bad_expr) inverse_call <- ifelse(matched_call == "any", "all", "any") diff --git a/R/package_hooks_linter.R b/R/package_hooks_linter.R index bc6e7460a..1d28858ea 100644 --- a/R/package_hooks_linter.R +++ b/R/package_hooks_linter.R @@ -66,7 +66,7 @@ package_hooks_linter <- function() { names(bad_call_xpaths) <- names(bad_calls) make_bad_call_lint_message <- function(expr, hook) { - call_name <- xml2::xml_text(expr) + call_name <- xml_text(expr) lint_message <- sprintf("Don't use %s() in %s().", call_name, hook) lint_message[call_name == "packageStartupMessage"] <- "Put packageStartupMessage() calls in .onAttach(), not .onLoad()." @@ -129,7 +129,7 @@ package_hooks_linter <- function() { # inherits: source_expression, bad_call_xpaths bad_msg_call_lints <- function(xml, hook) { - bad_expr <- xml2::xml_find_all(xml, bad_call_xpaths[[hook]]) + bad_expr <- xml_find_all(xml, bad_call_xpaths[[hook]]) lint_message <- make_bad_call_lint_message(bad_expr, hook) xml_nodes_to_lints(bad_expr, source_expression, lint_message, type = "warning") } @@ -139,21 +139,21 @@ package_hooks_linter <- function() { onattach_bad_msg_call_lints <- bad_msg_call_lints(xml, ".onAttach") # (2) .onLoad() and .onAttach() should take two arguments, with names matching ^lib and ^pkg - load_arg_name_expr <- xml2::xml_find_all(xml, load_arg_name_xpath) + load_arg_name_expr <- xml_find_all(xml, load_arg_name_xpath) load_arg_name_message <- sprintf( "%s() should take two arguments, with the first starting with 'lib' and the second starting with 'pkg'.", - xml_find_char(load_arg_name_expr, hook_xpath) + xml_find_chr(load_arg_name_expr, hook_xpath) ) load_arg_name_lints <- xml_nodes_to_lints(load_arg_name_expr, source_expression, load_arg_name_message, type = "warning") # (3) .onLoad() and .onAttach() shouldn't call require(), library(), or installed.packages() # NB: base only checks the SYMBOL_FUNCTION_CALL version, not SYMBOL. - library_require_expr <- xml2::xml_find_all(xml, library_require_xpath) + library_require_expr <- xml_find_all(xml, library_require_xpath) - library_require_bad_call <- xml2::xml_text(library_require_expr) - library_require_hook <- xml_find_char(library_require_expr, hook_xpath) + library_require_bad_call <- xml_text(library_require_expr) + library_require_hook <- xml_find_chr(library_require_expr, hook_xpath) library_require_message <- character(length(library_require_bad_call)) is_installed_packages <- library_require_bad_call == "installed.packages" library_require_message[is_installed_packages] <- @@ -164,21 +164,21 @@ package_hooks_linter <- function() { xml_nodes_to_lints(library_require_expr, source_expression, library_require_message, type = "warning") # (4) .Last.lib() and .onDetach() shouldn't call library.dynam.unload() - bad_unload_call_expr <- xml2::xml_find_all(xml, bad_unload_call_xpath) + bad_unload_call_expr <- xml_find_all(xml, bad_unload_call_xpath) bad_unload_call_message <- sprintf( "Use library.dynam.unload() calls in .onUnload(), not %s().", - xml_find_char(bad_unload_call_expr, hook_xpath) + xml_find_chr(bad_unload_call_expr, hook_xpath) ) bad_unload_call_lints <- xml_nodes_to_lints(bad_unload_call_expr, source_expression, bad_unload_call_message, type = "warning") # (5) .Last.lib() and .onDetach() should take one arguments with name matching ^lib - unload_arg_name_expr <- xml2::xml_find_all(xml, unload_arg_name_xpath) + unload_arg_name_expr <- xml_find_all(xml, unload_arg_name_xpath) unload_arg_name_message <- sprintf( "%s() should take one argument starting with 'lib'.", - xml_find_char(unload_arg_name_expr, hook_xpath) + xml_find_chr(unload_arg_name_expr, hook_xpath) ) unload_arg_name_lints <- xml_nodes_to_lints(unload_arg_name_expr, source_expression, unload_arg_name_message, type = "warning") diff --git a/R/paren_body_linter.R b/R/paren_body_linter.R index 2704f2350..1fdccfdc1 100644 --- a/R/paren_body_linter.R +++ b/R/paren_body_linter.R @@ -53,7 +53,7 @@ paren_body_linter <- function() { } xml <- source_expression$xml_parsed_content - matched_expressions <- xml2::xml_find_all(xml, xpath) + matched_expressions <- xml_find_all(xml, xpath) xml_nodes_to_lints( matched_expressions, diff --git a/R/paste_linter.R b/R/paste_linter.R index bf99843e4..ef47d5384 100644 --- a/R/paste_linter.R +++ b/R/paste_linter.R @@ -120,7 +120,7 @@ paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE) { optional_lints <- list() if (!allow_empty_sep) { - empty_sep_expr <- xml2::xml_find_all(xml, sep_xpath) + empty_sep_expr <- xml_find_all(xml, sep_xpath) sep_value <- get_r_string(empty_sep_expr, xpath = "./SYMBOL_SUB[text() = 'sep']/following-sibling::expr[1]") optional_lints <- c(optional_lints, xml_nodes_to_lints( @@ -133,7 +133,7 @@ paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE) { if (!allow_to_string) { # 3 expr: the function call, the argument, and collapse= - to_string_expr <- xml2::xml_find_all(xml, to_string_xpath) + to_string_expr <- xml_find_all(xml, to_string_xpath) collapse_value <- get_r_string( to_string_expr, xpath = "./SYMBOL_SUB[text() = 'collapse']/following-sibling::expr[1]" @@ -151,7 +151,7 @@ paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE) { )) } - paste0_sep_expr <- xml2::xml_find_all(xml, paste0_sep_xpath) + paste0_sep_expr <- xml_find_all(xml, paste0_sep_xpath) paste0_sep_lints <- xml_nodes_to_lints( paste0_sep_expr, source_expression = source_expression, @@ -159,7 +159,7 @@ paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE) { type = "warning" ) - paste_strrep_expr <- xml2::xml_find_all(xml, paste_strrep_xpath) + paste_strrep_expr <- xml_find_all(xml, paste_strrep_xpath) collapse_arg <- get_r_string(paste_strrep_expr, "SYMBOL_SUB/following-sibling::expr[1]/STR_CONST") paste_strrep_expr <- paste_strrep_expr[!nzchar(collapse_arg)] paste_call <- xp_call_name(paste_strrep_expr) diff --git a/R/pipe_call_linter.R b/R/pipe_call_linter.R index 534b5c3ac..30768f14d 100644 --- a/R/pipe_call_linter.R +++ b/R/pipe_call_linter.R @@ -32,7 +32,7 @@ pipe_call_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/pipe_continuation_linter.R b/R/pipe_continuation_linter.R index 9e0f6dd1e..21998666b 100644 --- a/R/pipe_continuation_linter.R +++ b/R/pipe_continuation_linter.R @@ -74,7 +74,7 @@ pipe_continuation_linter <- function() { } xml <- source_expression$full_xml_parsed_content - pipe_exprs <- xml2::xml_find_all(xml, xpath) + pipe_exprs <- xml_find_all(xml, xpath) pipe_text <- ifelse(xml2::xml_name(pipe_exprs) == "PIPE", "|>", "%>%") xml_nodes_to_lints( diff --git a/R/redundant_equals_linter.R b/R/redundant_equals_linter.R index d23811f17..55c5b2cc4 100644 --- a/R/redundant_equals_linter.R +++ b/R/redundant_equals_linter.R @@ -49,8 +49,8 @@ redundant_equals_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) - op <- xml2::xml_text(xml2::xml_find_first(bad_expr, "*[2]")) + bad_expr <- xml_find_all(xml, xpath) + op <- xml_text(xml_find_first(bad_expr, "*[2]")) xml_nodes_to_lints( bad_expr, diff --git a/R/redundant_ifelse_linter.R b/R/redundant_ifelse_linter.R index 575536cac..00ce22938 100644 --- a/R/redundant_ifelse_linter.R +++ b/R/redundant_ifelse_linter.R @@ -70,11 +70,11 @@ redundant_ifelse_linter <- function(allow10 = FALSE) { xml <- source_expression$xml_parsed_content lints <- list() - tf_expr <- xml2::xml_find_all(xml, tf_xpath) + tf_expr <- xml_find_all(xml, tf_xpath) matched_call <- xp_call_name(tf_expr) # [1] call; [2] logical condition - first_arg <- xml_find_char(tf_expr, "string(expr[3]/NUM_CONST)") - second_arg <- xml_find_char(tf_expr, "string(expr[4]/NUM_CONST)") + first_arg <- xml_find_chr(tf_expr, "string(expr[3]/NUM_CONST)") + second_arg <- xml_find_chr(tf_expr, "string(expr[4]/NUM_CONST)") tf_message <- sprintf( "Just use the logical condition (or its negation) directly instead of calling %s(x, %s, %s)", matched_call, first_arg, second_arg @@ -82,11 +82,11 @@ redundant_ifelse_linter <- function(allow10 = FALSE) { lints <- c(lints, xml_nodes_to_lints(tf_expr, source_expression, tf_message, type = "warning")) if (!allow10) { - num_expr <- xml2::xml_find_all(xml, num_xpath) + num_expr <- xml_find_all(xml, num_xpath) matched_call <- xp_call_name(num_expr) # [1] call; [2] logical condition - first_arg <- xml_find_char(num_expr, "string(expr[3]/NUM_CONST)") - second_arg <- xml_find_char(num_expr, "string(expr[4]/NUM_CONST)") + first_arg <- xml_find_chr(num_expr, "string(expr[3]/NUM_CONST)") + second_arg <- xml_find_chr(num_expr, "string(expr[4]/NUM_CONST)") is_numeric_01 <- first_arg %in% c("0", "1") | second_arg %in% c("0", "1") coercion_function <- ifelse(is_numeric_01, "as.numeric", "as.integer") is_negated <- first_arg %in% c("0", "0L") diff --git a/R/regex_subset_linter.R b/R/regex_subset_linter.R index 76f9494a7..aaf026058 100644 --- a/R/regex_subset_linter.R +++ b/R/regex_subset_linter.R @@ -74,7 +74,7 @@ regex_subset_linter <- function() { xml <- source_expression$xml_parsed_content - grep_expr <- xml2::xml_find_all(xml, grep_xpath) + grep_expr <- xml_find_all(xml, grep_xpath) grep_lints <- xml_nodes_to_lints( grep_expr, @@ -84,7 +84,7 @@ regex_subset_linter <- function() { type = "warning" ) - stringr_expr <- xml2::xml_find_all(xml, stringr_xpath) + stringr_expr <- xml_find_all(xml, stringr_xpath) stringr_lints <- xml_nodes_to_lints( stringr_expr, diff --git a/R/routine_registration_linter.R b/R/routine_registration_linter.R index cbad4af04..6ff5769a6 100644 --- a/R/routine_registration_linter.R +++ b/R/routine_registration_linter.R @@ -47,7 +47,7 @@ routine_registration_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/semicolon_linter.R b/R/semicolon_linter.R index 68dd47185..dfa3af603 100644 --- a/R/semicolon_linter.R +++ b/R/semicolon_linter.R @@ -88,9 +88,9 @@ semicolon_linter <- function(allow_compound = FALSE, allow_trailing = FALSE) { } xml <- source_expression$full_xml_parsed_content - bad_exprs <- xml2::xml_find_all(xml, xpath) + bad_exprs <- xml_find_all(xml, xpath) if (need_detection) { - is_trailing <- is.na(xml2::xml_find_first(bad_exprs, compound_xpath)) + is_trailing <- is.na(xml_find_first(bad_exprs, compound_xpath)) msg <- ifelse(is_trailing, msg_trailing, msg_compound) } diff --git a/R/seq_linter.R b/R/seq_linter.R index e5755e3f6..d7833be82 100644 --- a/R/seq_linter.R +++ b/R/seq_linter.R @@ -72,7 +72,7 @@ seq_linter <- function() { ## The actual order of the nodes is document order ## In practice we need to handle length(x):1 get_fun <- function(expr, n) { - funcall <- xml_find_char(expr, sprintf("string(./expr[%d])", n)) + funcall <- xml_find_chr(expr, sprintf("string(./expr[%d])", n)) # `dplyr::n()` is special because it has no arguments, so the lint message # should mention `n()`, and not `n(...)` @@ -93,7 +93,7 @@ seq_linter <- function() { xml <- source_expression$xml_parsed_content - badx <- xml2::xml_find_all(xml, xpath) + badx <- xml_find_all(xml, xpath) # TODO: better message customization. For example, length(x):1 # would get rev(seq_along(x)) as the preferred replacement. diff --git a/R/sort_linter.R b/R/sort_linter.R index 80357b971..642ac3e14 100644 --- a/R/sort_linter.R +++ b/R/sort_linter.R @@ -70,10 +70,10 @@ sort_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) - var <- xml2::xml_text( - xml2::xml_find_first( + var <- xml_text( + xml_find_first( bad_expr, ".//SYMBOL_FUNCTION_CALL[text() = 'order']/parent::expr[1]/following-sibling::expr[1]" ) @@ -87,9 +87,9 @@ sort_linter <- function() { # Reconstruct new argument call for each expression separately args <- vapply(bad_expr, function(e) { - arg_names <- xml2::xml_text(xml2::xml_find_all(e, args_xpath)) - arg_values <- xml2::xml_text( - xml2::xml_find_all(e, arg_values_xpath) + arg_names <- xml_text(xml_find_all(e, args_xpath)) + arg_values <- xml_text( + xml_find_all(e, arg_values_xpath) ) if (!"na.last" %in% arg_names) { arg_names <- c(arg_names, "na.last") diff --git a/R/spaces_inside_linter.R b/R/spaces_inside_linter.R index 59439e747..79a871e71 100644 --- a/R/spaces_inside_linter.R +++ b/R/spaces_inside_linter.R @@ -59,9 +59,9 @@ spaces_inside_linter <- function() { xml <- source_expression$full_xml_parsed_content - left_expr <- xml2::xml_find_all(xml, left_xpath) + left_expr <- xml_find_all(xml, left_xpath) left_msg <- ifelse( - xml2::xml_text(left_expr) %in% c("[", "[["), + xml_text(left_expr) %in% c("[", "[["), "Do not place spaces after square brackets.", "Do not place spaces after parentheses." ) @@ -74,9 +74,9 @@ spaces_inside_linter <- function() { range_end_xpath = "number(./following-sibling::*[1]/@col1 - 1)" # end before following expr ) - right_expr <- xml2::xml_find_all(xml, right_xpath) + right_expr <- xml_find_all(xml, right_xpath) right_msg <- ifelse( - xml2::xml_text(right_expr) == "]", + xml_text(right_expr) == "]", "Do not place spaces before square brackets.", "Do not place spaces before parentheses." ) diff --git a/R/spaces_left_parentheses_linter.R b/R/spaces_left_parentheses_linter.R index 40de60c78..60d98e583 100644 --- a/R/spaces_left_parentheses_linter.R +++ b/R/spaces_left_parentheses_linter.R @@ -64,7 +64,7 @@ spaces_left_parentheses_linter <- function() { xpath <- expression_level_xpath } - bad_paren <- xml2::xml_find_all(xml, xpath) + bad_paren <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_paren, diff --git a/R/sprintf_linter.R b/R/sprintf_linter.R index 551e8fb05..adffba7b2 100644 --- a/R/sprintf_linter.R +++ b/R/sprintf_linter.R @@ -46,7 +46,7 @@ sprintf_linter <- function() { xml <- source_expression$full_xml_parsed_content - sprintf_calls <- xml2::xml_find_all(xml, xpath) + sprintf_calls <- xml_find_all(xml, xpath) message <- vapply(sprintf_calls, capture_sprintf_warning, character(1L)) diff --git a/R/string_boundary_linter.R b/R/string_boundary_linter.R index fed3efe9e..ac59004c3 100644 --- a/R/string_boundary_linter.R +++ b/R/string_boundary_linter.R @@ -87,7 +87,7 @@ string_boundary_linter <- function(allow_grepl = FALSE) { } get_regex_lint_data <- function(xml, xpath) { - expr <- xml2::xml_find_all(xml, xpath) + expr <- xml_find_all(xml, xpath) patterns <- get_r_string(expr) initial_anchor <- startsWith(patterns, "^") search_start <- 1L + initial_anchor @@ -164,8 +164,8 @@ string_boundary_linter <- function(allow_grepl = FALSE) { )) } - substr_expr <- xml2::xml_find_all(xml, substr_xpath) - substr_one <- xml_find_char(substr_expr, substr_arg2_xpath) %in% c("1", "1L") + substr_expr <- xml_find_all(xml, substr_xpath) + substr_one <- xml_find_chr(substr_expr, substr_arg2_xpath) %in% c("1", "1L") substr_lint_message <- paste( ifelse( substr_one, diff --git a/R/strings_as_factors_linter.R b/R/strings_as_factors_linter.R index 1f48d878a..b580eca7f 100644 --- a/R/strings_as_factors_linter.R +++ b/R/strings_as_factors_linter.R @@ -89,7 +89,7 @@ strings_as_factors_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/system_file_linter.R b/R/system_file_linter.R index f0d84d876..069764393 100644 --- a/R/system_file_linter.R +++ b/R/system_file_linter.R @@ -41,7 +41,7 @@ system_file_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) outer_call <- xp_call_name(bad_expr) lint_message <- paste( diff --git a/R/trailing_whitespace_linter.R b/R/trailing_whitespace_linter.R index 6a43d7c77..5e6d1636f 100644 --- a/R/trailing_whitespace_linter.R +++ b/R/trailing_whitespace_linter.R @@ -59,9 +59,9 @@ trailing_whitespace_linter <- function(allow_empty_lines = FALSE, allow_in_strin } if (isTRUE(allow_in_strings) && !is.null(source_expression$full_xml_parsed_content)) { - all_str_consts <- xml2::xml_find_all(source_expression$full_xml_parsed_content, "//STR_CONST") - start_lines <- as.integer(xml2::xml_attr(all_str_consts, "line1")) - end_lines <- as.integer(xml2::xml_attr(all_str_consts, "line2")) + all_str_consts <- xml_find_all(source_expression$full_xml_parsed_content, "//STR_CONST") + start_lines <- as.integer(xml_attr(all_str_consts, "line1")) + end_lines <- as.integer(xml_attr(all_str_consts, "line2")) is_in_str <- vapply(bad_lines, function(ln) any(start_lines <= ln & ln < end_lines), logical(1L)) bad_lines <- bad_lines[!is_in_str] diff --git a/R/undesirable_function_linter.R b/R/undesirable_function_linter.R index 36eafd1ef..ad42a46ce 100644 --- a/R/undesirable_function_linter.R +++ b/R/undesirable_function_linter.R @@ -83,7 +83,7 @@ undesirable_function_linter <- function(fun = default_undesirable_functions, if (!is_lint_level(source_expression, "expression")) { return(list()) } - matched_nodes <- xml2::xml_find_all(source_expression$xml_parsed_content, xpath) + matched_nodes <- xml_find_all(source_expression$xml_parsed_content, xpath) fun_names <- get_r_string(matched_nodes) msgs <- vapply( diff --git a/R/undesirable_operator_linter.R b/R/undesirable_operator_linter.R index 20bcda35d..7fd594379 100644 --- a/R/undesirable_operator_linter.R +++ b/R/undesirable_operator_linter.R @@ -83,9 +83,9 @@ undesirable_operator_linter <- function(op = default_undesirable_operators) { xml <- source_expression$xml_parsed_content - bad_op <- xml2::xml_find_all(xml, xpath) + bad_op <- xml_find_all(xml, xpath) - operator <- xml2::xml_text(bad_op) + operator <- xml_text(bad_op) lint_message <- sprintf("Operator `%s` is undesirable.", operator) alternative <- op[operator] has_alternative <- !is.na(alternative) diff --git a/R/unnecessary_concatenation_linter.R b/R/unnecessary_concatenation_linter.R index 914928e6f..b2a58464c 100644 --- a/R/unnecessary_concatenation_linter.R +++ b/R/unnecessary_concatenation_linter.R @@ -104,11 +104,11 @@ unnecessary_concatenation_linter <- function(allow_single_expression = TRUE) { # } xml <- source_expression$xml_parsed_content - c_calls <- xml2::xml_find_all(xml, call_xpath) + c_calls <- xml_find_all(xml, call_xpath) # bump count(args) by 1 if inside a pipeline - num_args <- as.integer(xml2::xml_find_num(c_calls, num_args_xpath)) + - as.integer(!is.na(xml2::xml_find_first(c_calls, to_pipe_xpath))) + num_args <- as.integer(xml_find_num(c_calls, num_args_xpath)) + + as.integer(!is.na(xml_find_first(c_calls, to_pipe_xpath))) # NB: the xpath guarantees num_args is 0, 1, or 2. 2 comes # in "a" %>% c("b"). # TODO(michaelchirico): can we handle this all inside the XPath with reasonable concision? @@ -117,7 +117,7 @@ unnecessary_concatenation_linter <- function(allow_single_expression = TRUE) { # num_args <- num_args[is_unneeded] msg <- ifelse(num_args == 0L, msg_empty, msg_const) if (!allow_single_expression) { - is_single_expression <- !is.na(xml2::xml_find_first(c_calls, path_to_non_constant)) + is_single_expression <- !is.na(xml_find_first(c_calls, path_to_non_constant)) msg[is_single_expression] <- msg_const_expr } diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index a0eabe8ac..e4664ff14 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -104,15 +104,15 @@ unnecessary_lambda_linter <- function() { xml <- source_expression$xml_parsed_content - default_fun_expr <- xml2::xml_find_all(xml, default_fun_xpath) + default_fun_expr <- xml_find_all(xml, default_fun_xpath) # TODO(michaelchirico): further message customization is possible here, # e.g. don't always refer to 'lapply()' in the example, and customize to # whether arguments need to be subsumed in '...' or not. The trouble is in # keeping track of which argument the anonymous function is supplied (2nd # argument for many calls, but 3rd e.g. for apply()) - default_call_fun <- xml2::xml_text(xml2::xml_find_first(default_fun_expr, fun_xpath)) - default_symbol <- xml2::xml_text(xml2::xml_find_first(default_fun_expr, symbol_xpath)) + default_call_fun <- xml_text(xml_find_first(default_fun_expr, fun_xpath)) + default_symbol <- xml_text(xml_find_first(default_fun_expr, symbol_xpath)) default_fun_lints <- xml_nodes_to_lints( default_fun_expr, source_expression = source_expression, @@ -124,10 +124,10 @@ unnecessary_lambda_linter <- function() { type = "warning" ) - purrr_fun_expr <- xml2::xml_find_all(xml, purrr_fun_xpath) + purrr_fun_expr <- xml_find_all(xml, purrr_fun_xpath) - purrr_call_fun <- xml2::xml_text(xml2::xml_find_first(purrr_fun_expr, fun_xpath)) - purrr_symbol <- xml2::xml_text(xml2::xml_find_first(purrr_fun_expr, symbol_xpath)) + purrr_call_fun <- xml_text(xml_find_first(purrr_fun_expr, fun_xpath)) + purrr_symbol <- xml_text(xml_find_first(purrr_fun_expr, symbol_xpath)) purrr_fun_lints <- xml_nodes_to_lints( purrr_fun_expr, source_expression = source_expression, diff --git a/R/unnecessary_nested_if_linter.R b/R/unnecessary_nested_if_linter.R index dd078e897..354b167a3 100644 --- a/R/unnecessary_nested_if_linter.R +++ b/R/unnecessary_nested_if_linter.R @@ -43,7 +43,7 @@ unnecessary_nested_if_linter <- function() { xml <- source_expression$full_xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) lint_message <- paste( "Don't use nested `if` statements,", diff --git a/R/unnecessary_placeholder_linter.R b/R/unnecessary_placeholder_linter.R index 2f58e4b38..1085b124b 100644 --- a/R/unnecessary_placeholder_linter.R +++ b/R/unnecessary_placeholder_linter.R @@ -56,7 +56,7 @@ unnecessary_placeholder_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/unreachable_code_linter.R b/R/unreachable_code_linter.R index d2411b061..eca42f2a4 100644 --- a/R/unreachable_code_linter.R +++ b/R/unreachable_code_linter.R @@ -51,10 +51,10 @@ unreachable_code_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) is_nolint_end_comment <- xml2::xml_name(bad_expr) == "COMMENT" & - rex::re_matches(xml2::xml_text(bad_expr), settings$exclude_end) + rex::re_matches(xml_text(bad_expr), settings$exclude_end) xml_nodes_to_lints( bad_expr[!is_nolint_end_comment], diff --git a/R/unused_import_linter.R b/R/unused_import_linter.R index 50aaf7751..d08ec16ec 100644 --- a/R/unused_import_linter.R +++ b/R/unused_import_linter.R @@ -70,15 +70,15 @@ unused_import_linter <- function(allow_ns_usage = FALSE, except_packages = c("bi xml <- source_expression$full_xml_parsed_content - import_exprs <- xml2::xml_find_all(xml, import_xpath) + import_exprs <- xml_find_all(xml, import_xpath) if (length(import_exprs) == 0L) { return(list()) } - imported_pkgs <- xml_find_char(import_exprs, "string(expr[STR_CONST|SYMBOL])") + imported_pkgs <- xml_find_chr(import_exprs, "string(expr[STR_CONST|SYMBOL])") # as.character(parse(...)) returns one entry per expression imported_pkgs <- as.character(parse(text = imported_pkgs, keep.source = FALSE)) - used_symbols <- xml2::xml_text(xml2::xml_find_all(xml, xp_used_symbols)) + used_symbols <- xml_text(xml_find_all(xml, xp_used_symbols)) is_used <- vapply( imported_pkgs, @@ -101,7 +101,7 @@ unused_import_linter <- function(allow_ns_usage = FALSE, except_packages = c("bi is_ns_used <- vapply( imported_pkgs, function(pkg) { - ns_usage <- xml2::xml_find_first(xml, paste0("//SYMBOL_PACKAGE[text() = '", pkg, "']")) + ns_usage <- xml_find_first(xml, paste0("//SYMBOL_PACKAGE[text() = '", pkg, "']")) !identical(ns_usage, xml2::xml_missing()) }, logical(1L) diff --git a/R/utils.R b/R/utils.R index ad2941514..aaf4ebc4e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -104,7 +104,7 @@ get_content <- function(lines, info) { if (!missing(info)) { if (inherits(info, "xml_node")) { info <- lapply(stats::setNames(nm = c("col1", "col2", "line1", "line2")), function(attr) { - as.integer(xml2::xml_attr(info, attr)) + as.integer(xml_attr(info, attr)) }) } @@ -208,9 +208,9 @@ platform_independent_sort <- function(x) x[platform_independent_order(x)] #' will become `NA` outputs, which helps ensure that `length(get_r_string(s)) == length(s)`. #' #' @param s An input string or strings. If `s` is an `xml_node` or `xml_nodeset` and `xpath` is `NULL`, -#' extract its string value with [xml2::xml_text()]. If `s` is an `xml_node` or `xml_nodeset` -#' and `xpath` is specified, it is extracted with [xml_find_char()]. -#' @param xpath An XPath, passed on to [xml_find_char()] after wrapping with `string()`. +#' extract its string value with [xml_text()]. If `s` is an `xml_node` or `xml_nodeset` +#' and `xpath` is specified, it is extracted with [xml_find_chr()]. +#' @param xpath An XPath, passed on to [xml_find_chr()] after wrapping with `string()`. #' #' @examplesIf requireNamespace("withr", quietly = TRUE) #' tmp <- withr::local_tempfile(lines = "c('a', 'b')") @@ -231,9 +231,9 @@ platform_independent_sort <- function(x) x[platform_independent_order(x)] get_r_string <- function(s, xpath = NULL) { if (inherits(s, c("xml_node", "xml_nodeset"))) { if (is.null(xpath)) { - s <- xml2::xml_text(s) + s <- xml_text(s) } else { - s <- xml_find_char(s, sprintf("string(%s)", xpath)) + s <- xml_find_chr(s, sprintf("string(%s)", xpath)) } } # parse() skips "" elements --> offsets the length of the output, @@ -246,7 +246,7 @@ get_r_string <- function(s, xpath = NULL) { #' Convert XML node to R code within #' -#' NB this is not equivalent to `xml2::xml_text(xml)` in the presence of line breaks +#' NB this is not equivalent to `xml_text(xml)` in the presence of line breaks #' #' @param xml An `xml_node`. #' @@ -256,22 +256,22 @@ get_r_string <- function(s, xpath = NULL) { get_r_code <- function(xml) { # shortcut if xml has line1 and line2 attrs and they are equal # if they are missing, xml_attr() returns NA, so we continue - if (isTRUE(xml2::xml_attr(xml, "line1") == xml2::xml_attr(xml, "line2"))) { - return(xml2::xml_text(xml)) + if (isTRUE(xml_attr(xml, "line1") == xml_attr(xml, "line2"))) { + return(xml_text(xml)) } # find all unique line numbers - line_numbers <- sort(unique(xml2::xml_find_num( - xml2::xml_find_all(xml, "./descendant-or-self::*[@line1]"), + line_numbers <- sort(unique(xml_find_num( + xml_find_all(xml, "./descendant-or-self::*[@line1]"), "number(./@line1)" ))) if (length(line_numbers) <= 1L) { # no line breaks necessary - return(xml2::xml_text(xml)) + return(xml_text(xml)) } lines <- vapply(line_numbers, function(line_num) { # all terminal nodes starting on line_num - paste(xml2::xml_text( - xml2::xml_find_all(xml, sprintf("./descendant-or-self::*[@line1 = %d and not(*)]", line_num)) + paste(xml_text( + xml_find_all(xml, sprintf("./descendant-or-self::*[@line1 = %d and not(*)]", line_num)) ), collapse = "") }, character(1L)) paste(lines, collapse = "\n") @@ -279,14 +279,14 @@ get_r_code <- function(xml) { #' str2lang, but for xml children. #' -#' [xml2::xml_text()] is deceptively close to obviating this helper, but it collapses +#' [xml_text()] is deceptively close to obviating this helper, but it collapses #' text across lines. R is _mostly_ whitespace-agnostic, so this only matters in some edge cases, #' in particular when there are comments within an expression (`` node). See #1919. #' #' @noRd xml2lang <- function(x) { x_strip_comments <- xml_find_all(x, ".//*[not(self::COMMENT or self::expr)]") - str2lang(paste(xml2::xml_text(x_strip_comments), collapse = "")) + str2lang(paste(xml_text(x_strip_comments), collapse = "")) } is_linter <- function(x) inherits(x, "linter") diff --git a/R/vector_logic_linter.R b/R/vector_logic_linter.R index af349ed7a..d447dfaf1 100644 --- a/R/vector_logic_linter.R +++ b/R/vector_logic_linter.R @@ -84,7 +84,7 @@ vector_logic_linter <- function() { } xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) xml_nodes_to_lints( bad_expr, diff --git a/R/xml_nodes_to_lints.R b/R/xml_nodes_to_lints.R index 759cf7554..9b1fe4032 100644 --- a/R/xml_nodes_to_lints.R +++ b/R/xml_nodes_to_lints.R @@ -5,7 +5,7 @@ #' #' @details #' The location XPaths, `column_number_xpath`, `range_start_xpath` and `range_end_xpath` are evaluated using -#' [xml2::xml_find_num()] and will usually be of the form `"number(./relative/xpath)"`. +#' [xml_find_num()] and will usually be of the form `"number(./relative/xpath)"`. #' Note that the location line number cannot be changed and lints spanning multiple lines will ignore `range_end_xpath`. #' `column_number_xpath` and `range_start_xpath` are assumed to always refer to locations on the starting line of the #' `xml` node. @@ -13,7 +13,7 @@ #' @inheritParams lint-s3 #' @param xml An `xml_node` object (to generate one `Lint`) or an #' `xml_nodeset` object (to generate several `Lint`s), e.g. as returned by -#' [xml2::xml_find_all()] or [xml2::xml_find_first()] or a +#' [xml_find_all()] or [xml_find_first()] or a #' list of `xml_node` objects. #' @param source_expression A source expression object, e.g. as #' returned typically by [lint()], or more generally @@ -59,7 +59,7 @@ xml_nodes_to_lints <- function(xml, source_expression, lint_message, ) } type <- match.arg(type, c("style", "warning", "error")) - line1 <- xml2::xml_attr(xml, "line1") + line1 <- xml_attr(xml, "line1") col1 <- xp_find_location(xml, range_start_xpath) if (is.na(col1)) { warning("Could not find range start for lint. Defaulting to start of line.") @@ -69,7 +69,7 @@ xml_nodes_to_lints <- function(xml, source_expression, lint_message, lines <- source_expression[["lines"]] if (is.null(lines)) lines <- source_expression[["file_lines"]] - if (xml2::xml_attr(xml, "line2") == line1) { + if (xml_attr(xml, "line2") == line1) { col2 <- xp_find_location(xml, range_end_xpath) if (is.na(col2)) { warning("Could not find range end for lint. Defaulting to width 1.") diff --git a/R/xp_utils.R b/R/xp_utils.R index 5c628bb7e..29d767137 100644 --- a/R/xp_utils.R +++ b/R/xp_utils.R @@ -53,15 +53,15 @@ xp_call_name <- function(expr, depth = 1L, condition = NULL) { xpath <- paste0("string(", strrep("expr/", depth), node, ")") - xml_find_char(expr, xpath) + xml_find_chr(expr, xpath) } xp_find_location <- function(xml, xpath) { if (identical(xpath, "number(./@col1)")) { - as.integer(xml2::xml_attr(xml, "col1")) + as.integer(xml_attr(xml, "col1")) } else if (identical(xpath, "number(./@col2)")) { - as.integer(xml2::xml_attr(xml, "col2")) + as.integer(xml_attr(xml, "col2")) } else { - as.integer(xml2::xml_find_num(xml, xpath)) + as.integer(xml_find_num(xml, xpath)) } } diff --git a/R/yoda_test_linter.R b/R/yoda_test_linter.R index e7ecc6d42..eaadf8d5a 100644 --- a/R/yoda_test_linter.R +++ b/R/yoda_test_linter.R @@ -61,10 +61,10 @@ yoda_test_linter <- function() { xml <- source_expression$xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) matched_call <- xp_call_name(bad_expr) - second_const <- xml2::xml_find_first(bad_expr, second_const_xpath) + second_const <- xml_find_first(bad_expr, second_const_xpath) lint_message <- ifelse( is.na(second_const), paste( diff --git a/man/get_r_string.Rd b/man/get_r_string.Rd index 96a3db2bc..967bb305c 100644 --- a/man/get_r_string.Rd +++ b/man/get_r_string.Rd @@ -8,10 +8,10 @@ get_r_string(s, xpath = NULL) } \arguments{ \item{s}{An input string or strings. If \code{s} is an \code{xml_node} or \code{xml_nodeset} and \code{xpath} is \code{NULL}, -extract its string value with \code{\link[xml2:xml_text]{xml2::xml_text()}}. If \code{s} is an \code{xml_node} or \code{xml_nodeset} -and \code{xpath} is specified, it is extracted with \code{\link[xml2:xml_find_all]{xml2::xml_find_chr()}}.} +extract its string value with \code{\link[=xml_text]{xml_text()}}. If \code{s} is an \code{xml_node} or \code{xml_nodeset} +and \code{xpath} is specified, it is extracted with \code{\link[=xml_find_chr]{xml_find_chr()}}.} -\item{xpath}{An XPath, passed on to \code{\link[xml2:xml_find_all]{xml2::xml_find_chr()}} after wrapping with \code{string()}.} +\item{xpath}{An XPath, passed on to \code{\link[=xml_find_chr]{xml_find_chr()}} after wrapping with \code{string()}.} } \description{ Convert \code{STR_CONST} \code{text()} values into R strings. This is useful to account for arbitrary diff --git a/man/xml_nodes_to_lints.Rd b/man/xml_nodes_to_lints.Rd index 6a53b05a1..85cbecdd2 100644 --- a/man/xml_nodes_to_lints.Rd +++ b/man/xml_nodes_to_lints.Rd @@ -17,7 +17,7 @@ xml_nodes_to_lints( \arguments{ \item{xml}{An \code{xml_node} object (to generate one \code{Lint}) or an \code{xml_nodeset} object (to generate several \code{Lint}s), e.g. as returned by -\code{\link[xml2:xml_find_all]{xml2::xml_find_all()}} or \code{\link[xml2:xml_find_all]{xml2::xml_find_first()}} or a +\code{\link[=xml_find_all]{xml_find_all()}} or \code{\link[=xml_find_first]{xml_find_first()}} or a list of \code{xml_node} objects.} \item{source_expression}{A source expression object, e.g. as @@ -48,7 +48,7 @@ linter logic into a \code{\link[=Lint]{Lint()}} object to return. } \details{ The location XPaths, \code{column_number_xpath}, \code{range_start_xpath} and \code{range_end_xpath} are evaluated using -\code{\link[xml2:xml_find_all]{xml2::xml_find_num()}} and will usually be of the form \code{"number(./relative/xpath)"}. +\code{\link[=xml_find_num]{xml_find_num()}} and will usually be of the form \code{"number(./relative/xpath)"}. Note that the location line number cannot be changed and lints spanning multiple lines will ignore \code{range_end_xpath}. \code{column_number_xpath} and \code{range_start_xpath} are assumed to always refer to locations on the starting line of the \code{xml} node. From 073d5f7f7c269da319e47fc9c9e54817874ab891 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 1 Aug 2023 22:11:21 +0000 Subject: [PATCH 08/16] ue namespace imports for ubiquitous internal functions --- DESCRIPTION | 1 - NAMESPACE | 1 - R/keyword_quote_linter.R | 129 ------------------------------------ man/keyword_quote_linter.Rd | 24 ------- 4 files changed, 155 deletions(-) delete mode 100644 R/keyword_quote_linter.R delete mode 100644 man/keyword_quote_linter.Rd diff --git a/DESCRIPTION b/DESCRIPTION index d57706fa8..0358b669f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -113,7 +113,6 @@ Collate: 'inner_combine_linter.R' 'is_lint_level.R' 'is_numeric_linter.R' - 'keyword_quote_linter.R' 'lengths_linter.R' 'line_length_linter.R' 'lint.R' diff --git a/NAMESPACE b/NAMESPACE index 3902494b4..29ffbdac4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -77,7 +77,6 @@ export(infix_spaces_linter) export(inner_combine_linter) export(is_lint_level) export(is_numeric_linter) -export(keyword_quote_linter) export(lengths_linter) export(line_length_linter) export(lint) diff --git a/R/keyword_quote_linter.R b/R/keyword_quote_linter.R deleted file mode 100644 index 1937691d1..000000000 --- a/R/keyword_quote_linter.R +++ /dev/null @@ -1,129 +0,0 @@ -#' Block unnecessary quoting in calls -#' -#' Any valid symbol can be used as a keyword argument to an R function call. -#' Sometimes, it is necessary to quote (or backtick) an argument that is -#' not an otherwise valid symbol (e.g. creating a vector whose names have -#' spaces); besides this edge case, quoting should not be done. -#' -#' The most common source of violation for this is creating named vectors, -#' lists, or data.frame-alikes, but it can be observed in other calls as well. -#' -#' @evalRd rd_tags("keyword_quote_linter") -#' @seealso [linters] for a complete list of linters available in lintr. -#' @export -# TODO(michaelchirico): offer a stricter version of this that -# requires backticks to be used for non-syntactic names (i.e., not quotes). -# Here are the relevant xpaths: -# //expr[expr[SYMBOL_FUNCTION_CALL]]/SYMBOL_SUB[starts-with(text(), '`')] -# //expr[expr[SYMBOL_FUNCTION_CALL]]/STR_CONST[{is_quoted(text())}] -keyword_quote_linter <- function() { - # NB: xml2 uses xpath 1.0 which doesn't support matches() for regex, so we - # have to jump out of xpath to complete this lint. - # It's also a bit tough to get the escaping through R and then xpath to - # work as intended, hence the rather verbose declaration here. - quote_cond <- xp_or( - "starts-with(text(), '\"')", - "starts-with(text(), '`')", - 'starts-with(text(), "\'")' - ) - # SYMBOL_SUB for backticks, STR_CONST for quoted names - call_arg_xpath <- glue(" - //SYMBOL_FUNCTION_CALL - /parent::expr - /parent::expr - /*[(self::SYMBOL_SUB or self::STR_CONST) and {quote_cond}] - ") - - # also exclude $ or @, which are handled below - assignment_xpath <- " - (//EQ_ASSIGN | //LEFT_ASSIGN[text() != ':=']) - /preceding-sibling::expr[ - not(OP-DOLLAR or OP-AT) - and (STR_CONST or SYMBOL[starts-with(text(), '`')]) - ] - " - - extraction_xpath <- " - (//OP-DOLLAR | //OP-AT)/following-sibling::STR_CONST - | //OP-DOLLAR/following-sibling::SYMBOL[starts-with(text(), '`')] - | //OP-AT/following-sibling::SLOT[starts-with(text(), '`')] - " - - return(Linter(function(source_expression) { - if (!is_lint_level(source_expression, "expression")) { - return(list()) - } - - xml <- source_expression$xml_parsed_content - - call_arg_expr <- xml_find_all(xml, call_arg_xpath) - - invalid_call_quoting <- is_valid_r_name(get_r_string(call_arg_expr)) - - call_arg_lints <- xml_nodes_to_lints( - call_arg_expr[invalid_call_quoting], - source_expression = source_expression, - lint_message = "Only quote named arguments to functions if necessary, i.e., the name is not a valid R symbol (see ?make.names).", - type = "warning" - ) - - assignment_expr <- xml_find_all(xml, assignment_xpath) - - invalid_assignment_quoting <- is_valid_r_name(get_r_string(assignment_expr), no_quote = TRUE) - - assignment_lints <- xml_nodes_to_lints( - assignment_expr[invalid_assignment_quoting], - source_expression = source_expression, - lint_message = paste( - "Only quote targets of assignment if necessary, i.e., the name is not a valid R symbol (see ?make.names).", - "If necessary, use backticks to create non-syntactic names, not quotes." - ), - type = "warning" - ) - - extraction_expr <- xml_find_all(xml, extraction_xpath) - - invalid_extraction_quoting <- - is_valid_r_name(get_r_string(extraction_expr), no_quote = TRUE) - - extraction_expr <- extraction_expr[invalid_extraction_quoting] - extractor <- xml_find_chr(extraction_expr, "string(preceding-sibling::*[1])") - gen_extractor <- ifelse(extractor == "$", "[[", "slot()") - - extraction_lints <- xml_nodes_to_lints( - extraction_expr[invalid_extraction_quoting], - source_expression = source_expression, - lint_message = paste( - "Only quote targets of extraction with", extractor, "if necessary, i.e., the name is not a valid R symbol (see ?make.names).", - "If necessary, use backticks to create non-syntactic names, not quotes, or use", gen_extractor, "to extract by string." - ), - type = "warning" - ) - - return(c(call_arg_lints, assignment_lints, extraction_lints)) - })) -} - -# from ?Reserved -r_reserved_words <- c( - "if", "else", "repeat", "while", "function", "for", "in", "next", "break", - "TRUE", "FALSE", "NULL", "Inf", "NaN", "NA", - "NA_integer_", "NA_real_", "NA_complex_", "NA_character_" -) - -#' Check if a string could be assigned as an R variable. -#' -#' considered valid, i.e., anything wrapped in '' or "" is linted. -#' -#' See [make.names()] for the description of syntactically valid names in R. -#' we could also replace this with `make.names(x) == x` -#' @noRd -is_valid_r_name <- function(x, no_quote = FALSE) { - if (no_quote) { - bad_quote <- !startsWith(x, "`") - } else { - bad_quote <- FALSE - } - is_valid_symbol <- grepl("^([a-zA-Z][a-zA-Z0-9._]*|[.]|[.][a-zA-Z._][a-zA-Z0-9._]*)$", x) - return(bad_quote | (is_valid_symbol & !(x %in% r_reserved_words))) -} diff --git a/man/keyword_quote_linter.Rd b/man/keyword_quote_linter.Rd deleted file mode 100644 index 7c24f6065..000000000 --- a/man/keyword_quote_linter.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/keyword_quote_linter.R -\name{keyword_quote_linter} -\alias{keyword_quote_linter} -\title{Block unnecessary quoting in calls} -\usage{ -keyword_quote_linter() -} -\description{ -Any valid symbol can be used as a keyword argument to an R function call. -Sometimes, it is necessary to quote (or backtick) an argument that is -not an otherwise valid symbol (e.g. creating a vector whose names have -spaces); besides this edge case, quoting should not be done. -} -\details{ -The most common source of violation for this is creating named vectors, -lists, or data.frame-alikes, but it can be observed in other calls as well. -} -\seealso{ -\link{linters} for a complete list of linters available in lintr. -} -\section{Tags}{ -\link[=consistency_linters]{consistency}, \link[=readability_linters]{readability}, \link[=style_linters]{style} -} From 819b925145a6f2947dc359d8d7123f1038ea229c Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 1 Aug 2023 22:13:44 +0000 Subject: [PATCH 09/16] remove test file too --- tests/testthat/test-keyword_quote_linter.R | 232 --------------------- 1 file changed, 232 deletions(-) delete mode 100644 tests/testthat/test-keyword_quote_linter.R diff --git a/tests/testthat/test-keyword_quote_linter.R b/tests/testthat/test-keyword_quote_linter.R deleted file mode 100644 index 0aa7a42dc..000000000 --- a/tests/testthat/test-keyword_quote_linter.R +++ /dev/null @@ -1,232 +0,0 @@ -test_that("keyword_quote_linter skips allowed usages", { - # main use case: c() - expect_lint("x <- c(1, 2, 4, 5)", NULL, keyword_quote_linter()) - expect_lint("x <- c(a = 1, 2)", NULL, keyword_quote_linter()) - expect_lint("x <- c(a = 1, b = 2)", NULL, keyword_quote_linter()) - expect_lint("y <- c(`a b` = 1, `c d` = 2)", NULL, keyword_quote_linter()) - expect_lint('y <- c("a b" = 1, "c d" = 2)', NULL, keyword_quote_linter()) - expect_lint("z <- c('a b' = 1, c = 2)", NULL, keyword_quote_linter()) - - # other use cases: switch() and list() - expect_lint("list(a = 1, b = list(c = 2))", NULL, keyword_quote_linter()) - expect_lint("list(`a b` = 1, c = 2:6)", NULL, keyword_quote_linter()) - - expect_lint("switch(x, a = 1, b = 2)", NULL, keyword_quote_linter()) - expect_lint( - "switch(x, `a b` = 1, c = 2:6)", - NULL, - keyword_quote_linter() - ) -}) - -test_that("keyword_quote_linter blocks simple disallowed usages", { - expect_lint( - 'c("a" = 1, b = 2)', - rex::rex("Only quote named arguments to functions"), - keyword_quote_linter() - ) - - expect_lint( - "c('a' = 1, 'b' = 2)", - list( - "Only quote named arguments to functions", - "Only quote named arguments to functions" - ), - keyword_quote_linter() - ) - - expect_lint( - "c(`a` = 1, b = list(`c` = 2))", - list( - "Only quote named arguments to functions", - "Only quote named arguments to functions" - ), - keyword_quote_linter() - ) - - expect_lint( - "switch(x, `a` = c('b' = list(\"c\" = 1)))", - list( - "Only quote named arguments to functions", - "Only quote named arguments to functions", - "Only quote named arguments to functions" - ), - keyword_quote_linter() - ) -}) - -test_that("keyword_quote_linter skips quoting on reserved words", { - expect_lint("c(`next` = 1, `while` = 2)", NULL, keyword_quote_linter()) - expect_lint( - "switch(x, `for` = 3, `TRUE` = 4)", - NULL, - keyword_quote_linter() - ) - expect_lint("list('NA' = 5, 'Inf' = 6)", NULL, keyword_quote_linter()) -}) - -test_that("keyword_quote_linter works on more common functions", { - expect_lint( - "data.frame('a' = 1)", - rex::rex("Only quote named arguments to functions"), - keyword_quote_linter() - ) - expect_lint( - "data.table('a' = 1)", - rex::rex("Only quote named arguments to functions"), - keyword_quote_linter() - ) - expect_lint( - "data.table::data.table('a' = 1)", - rex::rex("Only quote named arguments to functions"), - keyword_quote_linter() - ) - expect_lint( - "rbind('a' = 1)", - rex::rex("Only quote named arguments to functions"), - keyword_quote_linter() - ) - expect_lint( - "cbind('a' = 1)", - rex::rex("Only quote named arguments to functions"), - keyword_quote_linter() - ) -}) - -test_that("keyword_quote_linter finds blocked usages in any function call", { - expect_lint( - "foo('a' = 1)", - rex::rex("Only quote named arguments to functions"), - keyword_quote_linter() - ) -}) - -test_that("keyword_quote_linter blocks quoted assignment targets", { - expect_lint( - '"foo bar" <- 1', - rex::rex("Only quote targets of assignment if necessary"), - keyword_quote_linter() - ) - expect_lint( - "'foo bar' = 1", - rex::rex("Only quote targets of assignment if necessary"), - keyword_quote_linter() - ) - # valid choice: use backticks - expect_lint("`foo bar` = 1", NULL, keyword_quote_linter()) - - expect_lint( - '"foo" <- 1', - rex::rex("Only quote targets of assignment if necessary"), - keyword_quote_linter() - ) - expect_lint( - "'foo' = 1", - rex::rex("Only quote targets of assignment if necessary"), - keyword_quote_linter() - ) - expect_lint( - "`foo` = 1", - rex::rex("Only quote targets of assignment if necessary"), - keyword_quote_linter() - ) - - # don't include data.table assignments - expect_lint('DT[, "a" := 1]', NULL, keyword_quote_linter()) - expect_lint("DT[, 'a' := 1]", NULL, keyword_quote_linter()) - expect_lint("DT[, `a` := 1]", NULL, keyword_quote_linter()) - - # include common use cases: [<-/$ methods and infixes - expect_lint( - '"$.my_class" <- function(x, key) { }', - rex::rex("Only quote targets of assignment if necessary"), - keyword_quote_linter() - ) - expect_lint( - "'Setter[<-.my_class' = function(x, idx, value) { }", - rex::rex("Only quote targets of assignment if necessary"), - keyword_quote_linter() - ) - expect_lint( - '"%nin%" <- function(x, table) !x %in% table', - rex::rex("Only quote targets of assignment if necessary"), - keyword_quote_linter() - ) -}) - -test_that("keyword_quote_linter blocks quoted $, @ extractions", { - expect_lint( - 'x$"foo bar" <- 1', - rex::rex("Only quote targets of extraction with $ if necessary"), - keyword_quote_linter() - ) - expect_lint( - "x$'foo bar' = 1", - rex::rex("Only quote targets of extraction with $ if necessary"), - keyword_quote_linter() - ) - expect_lint( - 'x@"foo bar" <- 1', - rex::rex("Only quote targets of extraction with @ if necessary"), - keyword_quote_linter() - ) - expect_lint( - "x@'foo bar' = 1", - rex::rex("Only quote targets of extraction with @ if necessary"), - keyword_quote_linter() - ) - # valid choice: non-syntactic name with backticks - expect_lint("x@`foo bar` <- 1", NULL, keyword_quote_linter()) - expect_lint("x@`foo bar` = 1", NULL, keyword_quote_linter()) - - expect_lint( - 'x$"foo" <- 1', - rex::rex("Only quote targets of extraction with $ if necessary"), - keyword_quote_linter() - ) - expect_lint( - "x$'foo' = 1", - rex::rex("Only quote targets of extraction with $ if necessary"), - keyword_quote_linter() - ) - expect_lint( - 'x@"foo" <- 1', - rex::rex("Only quote targets of extraction with @ if necessary"), - keyword_quote_linter() - ) - expect_lint( - "x@'foo' = 1", - rex::rex("Only quote targets of extraction with @ if necessary"), - keyword_quote_linter() - ) - expect_lint( - "x@`foo` <- 1", - rex::rex("Only quote targets of extraction with @ if necessary"), - keyword_quote_linter() - ) - expect_lint( - "x@`foo` = 1", - rex::rex("Only quote targets of extraction with @ if necessary"), - keyword_quote_linter() - ) -}) - -test_that("multiple lints are generated correctly", { - expect_lint( - trim_some(' - { - foo("a" = 1) - "b" <- 2 - x$"c" - y@"d" - } - '), - list( - list(message = "Only quote named arguments"), - list(message = "Only quote targets of assignment"), - list(message = "Only quote targets of extraction with \\$"), - list(message = "Only quote targets of extraction with @") - ), - keyword_quote_linter() - ) -}) From aa3be82bcb43b4533f78ed8e32a7f0d710823e93 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 1 Aug 2023 22:18:37 +0000 Subject: [PATCH 10/16] delete from metadata --- inst/lintr/linters.csv | 1 - 1 file changed, 1 deletion(-) diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 79488335a..e6bbebaed 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -41,7 +41,6 @@ indentation_linter,style readability default configurable infix_spaces_linter,style readability default configurable inner_combine_linter,efficiency consistency readability is_numeric_linter,readability best_practices consistency -keyword_quote_linter,readability consistency style lengths_linter,efficiency readability best_practices line_length_linter,style readability default configurable literal_coercion_linter,best_practices consistency efficiency From fcef307e3594183b9436f74b1fca862fe47a0b26 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 2 Aug 2023 06:32:00 +0000 Subject: [PATCH 11/16] revert spurious edits to comments --- R/object_usage_linter.R | 2 +- R/paste_linter.R | 2 +- R/utils.R | 8 ++++---- R/xml_nodes_to_lints.R | 4 ++-- man/consistency_linters.Rd | 1 - man/get_r_string.Rd | 6 +++--- man/linters.Rd | 7 +++---- man/object_usage_linter.Rd | 2 +- man/paste_linter.Rd | 2 +- man/readability_linters.Rd | 1 - man/style_linters.Rd | 1 - man/xml_nodes_to_lints.Rd | 4 ++-- 12 files changed, 18 insertions(+), 22 deletions(-) diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index 20b55161b..0cc06d2e9 100644 --- a/R/object_usage_linter.R +++ b/R/object_usage_linter.R @@ -3,7 +3,7 @@ #' Check that closures have the proper usage using [codetools::checkUsage()]. #' Note that this runs [base::eval()] on the code, so **do not use with untrusted code**. #' -#' @param interpret_glue If `TRUE`, interpret [glue()] calls to avoid false positives caused by local variables +#' @param interpret_glue If `TRUE`, interpret [glue::glue()] calls to avoid false positives caused by local variables #' which are only used in a glue expression. #' @param skip_with A logical. If `TRUE` (default), code in `with()` expressions #' will be skipped. This argument will be passed to `skipWith` argument of diff --git a/R/paste_linter.R b/R/paste_linter.R index ef47d5384..6cc218470 100644 --- a/R/paste_linter.R +++ b/R/paste_linter.R @@ -5,7 +5,7 @@ #' #' 1. Block usage of [paste()] with `sep = ""`. [paste0()] is a faster, more concise alternative. #' 2. Block usage of `paste()` or `paste0()` with `collapse = ", "`. [toString()] is a direct -#' wrapper for this, and alternatives like [glue_collapse()] might give better messages for humans. +#' wrapper for this, and alternatives like [glue::glue_collapse()] might give better messages for humans. #' 3. Block usage of `paste0()` that supplies `sep=` -- this is not a formal argument to `paste0`, and #' is likely to be a mistake. #' 4. Block usage of `paste()` / `paste0()` combined with [rep()] that could be replaced by diff --git a/R/utils.R b/R/utils.R index aaf4ebc4e..11b2d6ec6 100644 --- a/R/utils.R +++ b/R/utils.R @@ -208,9 +208,9 @@ platform_independent_sort <- function(x) x[platform_independent_order(x)] #' will become `NA` outputs, which helps ensure that `length(get_r_string(s)) == length(s)`. #' #' @param s An input string or strings. If `s` is an `xml_node` or `xml_nodeset` and `xpath` is `NULL`, -#' extract its string value with [xml_text()]. If `s` is an `xml_node` or `xml_nodeset` -#' and `xpath` is specified, it is extracted with [xml_find_chr()]. -#' @param xpath An XPath, passed on to [xml_find_chr()] after wrapping with `string()`. +#' extract its string value with [xml2::xml_text()]. If `s` is an `xml_node` or `xml_nodeset` +#' and `xpath` is specified, it is extracted with [xml2::xml_find_chr()]. +#' @param xpath An XPath, passed on to [xml2::xml_find_chr()] after wrapping with `string()`. #' #' @examplesIf requireNamespace("withr", quietly = TRUE) #' tmp <- withr::local_tempfile(lines = "c('a', 'b')") @@ -279,7 +279,7 @@ get_r_code <- function(xml) { #' str2lang, but for xml children. #' -#' [xml_text()] is deceptively close to obviating this helper, but it collapses +#' [xml2::xml_text()] is deceptively close to obviating this helper, but it collapses #' text across lines. R is _mostly_ whitespace-agnostic, so this only matters in some edge cases, #' in particular when there are comments within an expression (`` node). See #1919. #' diff --git a/R/xml_nodes_to_lints.R b/R/xml_nodes_to_lints.R index 9b1fe4032..46407345a 100644 --- a/R/xml_nodes_to_lints.R +++ b/R/xml_nodes_to_lints.R @@ -5,7 +5,7 @@ #' #' @details #' The location XPaths, `column_number_xpath`, `range_start_xpath` and `range_end_xpath` are evaluated using -#' [xml_find_num()] and will usually be of the form `"number(./relative/xpath)"`. +#' [xml2::xml_find_num()] and will usually be of the form `"number(./relative/xpath)"`. #' Note that the location line number cannot be changed and lints spanning multiple lines will ignore `range_end_xpath`. #' `column_number_xpath` and `range_start_xpath` are assumed to always refer to locations on the starting line of the #' `xml` node. @@ -13,7 +13,7 @@ #' @inheritParams lint-s3 #' @param xml An `xml_node` object (to generate one `Lint`) or an #' `xml_nodeset` object (to generate several `Lint`s), e.g. as returned by -#' [xml_find_all()] or [xml_find_first()] or a +#' [xml2::xml_find_all()] or [xml2::xml_find_first()] or a #' list of `xml_node` objects. #' @param source_expression A source expression object, e.g. as #' returned typically by [lint()], or more generally diff --git a/man/consistency_linters.Rd b/man/consistency_linters.Rd index 7d4d401be..9a500bea1 100644 --- a/man/consistency_linters.Rd +++ b/man/consistency_linters.Rd @@ -21,7 +21,6 @@ The following linters are tagged with 'consistency': \item{\code{\link{implicit_integer_linter}}} \item{\code{\link{inner_combine_linter}}} \item{\code{\link{is_numeric_linter}}} -\item{\code{\link{keyword_quote_linter}}} \item{\code{\link{literal_coercion_linter}}} \item{\code{\link{numeric_leading_zero_linter}}} \item{\code{\link{object_name_linter}}} diff --git a/man/get_r_string.Rd b/man/get_r_string.Rd index 967bb305c..96a3db2bc 100644 --- a/man/get_r_string.Rd +++ b/man/get_r_string.Rd @@ -8,10 +8,10 @@ get_r_string(s, xpath = NULL) } \arguments{ \item{s}{An input string or strings. If \code{s} is an \code{xml_node} or \code{xml_nodeset} and \code{xpath} is \code{NULL}, -extract its string value with \code{\link[=xml_text]{xml_text()}}. If \code{s} is an \code{xml_node} or \code{xml_nodeset} -and \code{xpath} is specified, it is extracted with \code{\link[=xml_find_chr]{xml_find_chr()}}.} +extract its string value with \code{\link[xml2:xml_text]{xml2::xml_text()}}. If \code{s} is an \code{xml_node} or \code{xml_nodeset} +and \code{xpath} is specified, it is extracted with \code{\link[xml2:xml_find_all]{xml2::xml_find_chr()}}.} -\item{xpath}{An XPath, passed on to \code{\link[=xml_find_chr]{xml_find_chr()}} after wrapping with \code{string()}.} +\item{xpath}{An XPath, passed on to \code{\link[xml2:xml_find_all]{xml2::xml_find_chr()}} after wrapping with \code{string()}.} } \description{ Convert \code{STR_CONST} \code{text()} values into R strings. This is useful to account for arbitrary diff --git a/man/linters.Rd b/man/linters.Rd index c8dff4b90..8cce38cf6 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -20,16 +20,16 @@ The following tags exist: \item{\link[=best_practices_linters]{best_practices} (50 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (7 linters)} \item{\link[=configurable_linters]{configurable} (29 linters)} -\item{\link[=consistency_linters]{consistency} (19 linters)} +\item{\link[=consistency_linters]{consistency} (18 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (25 linters)} \item{\link[=deprecated_linters]{deprecated} (8 linters)} \item{\link[=efficiency_linters]{efficiency} (23 linters)} \item{\link[=executing_linters]{executing} (5 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} -\item{\link[=readability_linters]{readability} (48 linters)} +\item{\link[=readability_linters]{readability} (47 linters)} \item{\link[=robustness_linters]{robustness} (14 linters)} -\item{\link[=style_linters]{style} (35 linters)} +\item{\link[=style_linters]{style} (34 linters)} } } \section{Linters}{ @@ -75,7 +75,6 @@ The following linters exist: \item{\code{\link{infix_spaces_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{inner_combine_linter}} (tags: consistency, efficiency, readability)} \item{\code{\link{is_numeric_linter}} (tags: best_practices, consistency, readability)} -\item{\code{\link{keyword_quote_linter}} (tags: consistency, readability, style)} \item{\code{\link{lengths_linter}} (tags: best_practices, efficiency, readability)} \item{\code{\link{line_length_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{literal_coercion_linter}} (tags: best_practices, consistency, efficiency)} diff --git a/man/object_usage_linter.Rd b/man/object_usage_linter.Rd index 35de61f2f..62e390816 100644 --- a/man/object_usage_linter.Rd +++ b/man/object_usage_linter.Rd @@ -7,7 +7,7 @@ object_usage_linter(interpret_glue = TRUE, skip_with = TRUE) } \arguments{ -\item{interpret_glue}{If \code{TRUE}, interpret \code{\link[=glue]{glue()}} calls to avoid false positives caused by local variables +\item{interpret_glue}{If \code{TRUE}, interpret \code{\link[glue:glue]{glue::glue()}} calls to avoid false positives caused by local variables which are only used in a glue expression.} \item{skip_with}{A logical. If \code{TRUE} (default), code in \code{with()} expressions diff --git a/man/paste_linter.Rd b/man/paste_linter.Rd index b0cf248b7..e83352f76 100644 --- a/man/paste_linter.Rd +++ b/man/paste_linter.Rd @@ -21,7 +21,7 @@ The following issues are linted by default by this linter \enumerate{ \item Block usage of \code{\link[=paste]{paste()}} with \code{sep = ""}. \code{\link[=paste0]{paste0()}} is a faster, more concise alternative. \item Block usage of \code{paste()} or \code{paste0()} with \code{collapse = ", "}. \code{\link[=toString]{toString()}} is a direct -wrapper for this, and alternatives like \code{\link[=glue_collapse]{glue_collapse()}} might give better messages for humans. +wrapper for this, and alternatives like \code{\link[glue:glue_collapse]{glue::glue_collapse()}} might give better messages for humans. \item Block usage of \code{paste0()} that supplies \verb{sep=} -- this is not a formal argument to \code{paste0}, and is likely to be a mistake. \item Block usage of \code{paste()} / \code{paste0()} combined with \code{\link[=rep]{rep()}} that could be replaced by diff --git a/man/readability_linters.Rd b/man/readability_linters.Rd index c1e730773..d1f32efec 100644 --- a/man/readability_linters.Rd +++ b/man/readability_linters.Rd @@ -33,7 +33,6 @@ The following linters are tagged with 'readability': \item{\code{\link{infix_spaces_linter}}} \item{\code{\link{inner_combine_linter}}} \item{\code{\link{is_numeric_linter}}} -\item{\code{\link{keyword_quote_linter}}} \item{\code{\link{lengths_linter}}} \item{\code{\link{line_length_linter}}} \item{\code{\link{matrix_apply_linter}}} diff --git a/man/style_linters.Rd b/man/style_linters.Rd index a0a7213fd..1c4e93c17 100644 --- a/man/style_linters.Rd +++ b/man/style_linters.Rd @@ -25,7 +25,6 @@ The following linters are tagged with 'style': \item{\code{\link{implicit_integer_linter}}} \item{\code{\link{indentation_linter}}} \item{\code{\link{infix_spaces_linter}}} -\item{\code{\link{keyword_quote_linter}}} \item{\code{\link{line_length_linter}}} \item{\code{\link{numeric_leading_zero_linter}}} \item{\code{\link{object_length_linter}}} diff --git a/man/xml_nodes_to_lints.Rd b/man/xml_nodes_to_lints.Rd index 85cbecdd2..6a53b05a1 100644 --- a/man/xml_nodes_to_lints.Rd +++ b/man/xml_nodes_to_lints.Rd @@ -17,7 +17,7 @@ xml_nodes_to_lints( \arguments{ \item{xml}{An \code{xml_node} object (to generate one \code{Lint}) or an \code{xml_nodeset} object (to generate several \code{Lint}s), e.g. as returned by -\code{\link[=xml_find_all]{xml_find_all()}} or \code{\link[=xml_find_first]{xml_find_first()}} or a +\code{\link[xml2:xml_find_all]{xml2::xml_find_all()}} or \code{\link[xml2:xml_find_all]{xml2::xml_find_first()}} or a list of \code{xml_node} objects.} \item{source_expression}{A source expression object, e.g. as @@ -48,7 +48,7 @@ linter logic into a \code{\link[=Lint]{Lint()}} object to return. } \details{ The location XPaths, \code{column_number_xpath}, \code{range_start_xpath} and \code{range_end_xpath} are evaluated using -\code{\link[=xml_find_num]{xml_find_num()}} and will usually be of the form \code{"number(./relative/xpath)"}. +\code{\link[xml2:xml_find_all]{xml2::xml_find_num()}} and will usually be of the form \code{"number(./relative/xpath)"}. Note that the location line number cannot be changed and lints spanning multiple lines will ignore \code{range_end_xpath}. \code{column_number_xpath} and \code{range_start_xpath} are assumed to always refer to locations on the starting line of the \code{xml} node. From 3c6cc2182d53fdfc35822787583f06c18dda10e0 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 3 Aug 2023 04:11:35 +0000 Subject: [PATCH 12/16] fix whitespace in XPaths --- R/indentation_linter.R | 42 ++++++++++++++++++++++++++++-------------- 1 file changed, 28 insertions(+), 14 deletions(-) diff --git a/R/indentation_linter.R b/R/indentation_linter.R index d0d37eed2..6c0fd8164 100644 --- a/R/indentation_linter.R +++ b/R/indentation_linter.R @@ -163,12 +163,21 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al paste( c( glue("self::{paren_tokens_left}/following-sibling::{paren_tokens_right}/preceding-sibling::*[1]/@line2"), - glue("self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))}] - /following-sibling::SYMBOL_FUNCTION_CALL/parent::expr/following-sibling::expr[1]/@line2"), - glue("self::*[ - {xp_and(paste0('not(self::', paren_tokens_left, ')'))} and - not(following-sibling::SYMBOL_FUNCTION_CALL) - ]/following-sibling::*[not(self::COMMENT)][1]/@line2") + glue(" + self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))}] + /following-sibling::SYMBOL_FUNCTION_CALL + /parent::expr + /following-sibling::expr[1] + /@line2 + "), + glue(" + self::*[ + {xp_and(paste0('not(self::', paren_tokens_left, ')'))} + and not(following-sibling::SYMBOL_FUNCTION_CALL) + ] + /following-sibling::*[not(self::COMMENT)][1] + /@line2 + ") ), collapse = " | " ), @@ -178,16 +187,21 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al global_nodes <- function(nodes) paste0("//", nodes, collapse = "|") xp_indent_changes <- paste( c( - glue("//{paren_tokens_left}[not(@line1 = following-sibling::expr[ - @line2 > @line1 and - ({xp_or(paste0('descendant::', paren_tokens_left, '[', xp_last_on_line, ']'))}) - ]/@line1)]"), + glue("//{paren_tokens_left}[not( + @line1 = following-sibling::expr[ + @line2 > @line1 and + ({xp_or(paste0('descendant::', paren_tokens_left, '[', xp_last_on_line, ']'))}) + ]/@line1 + )]"), glue::glue("({ global_nodes(infix_tokens) })[{xp_last_on_line}{infix_condition}]"), glue::glue("({ global_nodes(no_paren_keywords) })[{xp_last_on_line}]"), - glue::glue("({ global_nodes(keyword_tokens) })/following-sibling::OP-RIGHT-PAREN[ - {xp_last_on_line} and - not(following-sibling::expr[1][OP-LEFT-BRACE]) - ]") + glue::glue(" + ({ global_nodes(keyword_tokens) }) + /following-sibling::OP-RIGHT-PAREN[ + {xp_last_on_line} and + not(following-sibling::expr[1][OP-LEFT-BRACE]) + ] + ") ), collapse = " | " ) From b1277caaa6e355eeb5321db1fd9de86a3da09ab3 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 3 Aug 2023 04:13:40 +0000 Subject: [PATCH 13/16] revert inside string --- R/paste_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/paste_linter.R b/R/paste_linter.R index 6cc218470..ed4f35424 100644 --- a/R/paste_linter.R +++ b/R/paste_linter.R @@ -144,7 +144,7 @@ paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE) { source_expression = source_expression, lint_message = paste( 'toString(.) is more expressive than paste(., collapse = ", ").', - "Note also glue_collapse() and and::and()", + "Note also glue::glue_collapse() and and::and()", "for constructing human-readable / translation-friendly lists" ), type = "warning" From 84d0eadb32a27de471739233517824dedb229df5 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 3 Aug 2023 04:16:42 +0000 Subject: [PATCH 14/16] restore :: for seldom-used calls --- R/assignment_linter.R | 2 +- R/object_usage_linter.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/assignment_linter.R b/R/assignment_linter.R index a0a8e500e..01b25ae11 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -120,7 +120,7 @@ assignment_linter <- function(allow_cascading_assign = TRUE, if (!allow_trailing) { bad_trailing_expr <- xml_find_all(xml, trailing_assign_xpath) - trailing_assignments <- xml_attrs(bad_expr) %in% xml_attrs(bad_trailing_expr) + trailing_assignments <- xml2::xml_attrs(bad_expr) %in% xml2::xml_attrs(bad_trailing_expr) lint_message_fmt[trailing_assignments] <- "Assignment %s should not be trailing at the end of a line." } diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index 49b19c172..48a391710 100644 --- a/R/object_usage_linter.R +++ b/R/object_usage_linter.R @@ -131,7 +131,7 @@ object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) { nodes[missing_symbol] <- lapply(which(missing_symbol), function(i) { line_based_match <- xml_find_first( fun_assignment, - glue_data(res[i, ], "descendant::expr[@line1 = {line1} and @line2 = {line2}]") + glue::glue_data(res[i, ], "descendant::expr[@line1 = {line1} and @line2 = {line2}]") ) if (is.na(line_based_match)) fun_assignment else line_based_match }) From 443d789ef49c4f2cec2434c834f79de864d53c6e Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 3 Aug 2023 23:56:54 +0000 Subject: [PATCH 15/16] new :: usage --- R/library_call_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/library_call_linter.R b/R/library_call_linter.R index 52411f8fe..0fda85eee 100644 --- a/R/library_call_linter.R +++ b/R/library_call_linter.R @@ -59,7 +59,7 @@ library_call_linter <- function() { xml <- source_expression$full_xml_parsed_content - bad_expr <- xml2::xml_find_all(xml, xpath) + bad_expr <- xml_find_all(xml, xpath) if (length(bad_expr) == 0L) { return(list()) From 14b432ee7d4620099f250354eece74a8eb1a88f4 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 7 Aug 2023 18:52:41 +0000 Subject: [PATCH 16/16] unimport rare calls --- NAMESPACE | 2 -- R/lintr-package.R | 4 ++-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 0ee9e46aa..6a74b097c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -145,7 +145,6 @@ export(yoda_test_linter) importFrom(cyclocomp,cyclocomp) importFrom(glue,glue) importFrom(glue,glue_collapse) -importFrom(glue,glue_data) importFrom(rex,character_class) importFrom(rex,re_matches) importFrom(rex,re_substitutes) @@ -159,7 +158,6 @@ importFrom(utils,relist) importFrom(utils,tail) importFrom(xml2,as_list) importFrom(xml2,xml_attr) -importFrom(xml2,xml_attrs) importFrom(xml2,xml_find_all) importFrom(xml2,xml_find_chr) importFrom(xml2,xml_find_first) diff --git a/R/lintr-package.R b/R/lintr-package.R index ffecab706..a351dc834 100644 --- a/R/lintr-package.R +++ b/R/lintr-package.R @@ -8,11 +8,11 @@ "_PACKAGE" ## lintr namespace: start -#' @importFrom glue glue glue_collapse glue_data +#' @importFrom glue glue glue_collapse #' @importFrom rex rex regex re_matches re_substitutes character_class #' @importFrom stats na.omit #' @importFrom utils capture.output head getParseData relist -#' @importFrom xml2 xml_attr xml_attrs xml_find_all xml_find_chr xml_find_num xml_find_first xml_text as_list +#' @importFrom xml2 xml_attr xml_find_all xml_find_chr xml_find_num xml_find_first xml_text as_list #' @importFrom cyclocomp cyclocomp #' @importFrom utils tail #' @rawNamespace