1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
#' Block usage like x %in% "a"
#'
#' `vector %in% set` is appropriate for matching a vector to a set, but if
#' that set has size 1, `==` is more appropriate.
#'
#' `scalar %in% vector` is OK, because the alternative (`any(vector == scalar)`)
#' is more circuitous & potentially less clear.
#'
#' @param in_operators Character vector of additional infix operators that behave like the `%in%` operator,
#' e.g. `{data.table}`'s `%chin%` operator.
#'
#' @examples
#' # will produce lints
#' lint(
#' text = "x %in% 1L",
#' linters = scalar_in_linter()
#' )
#'
#' lint(
#' text = "x %chin% 'a'",
#' linters = scalar_in_linter(in_operators = "%chin%")
#' )
#'
#' # okay
#' lint(
#' text = "x %in% 1:10",
#' linters = scalar_in_linter()
#' )
#'
#' @evalRd rd_tags("scalar_in_linter")
#' @seealso [linters] for a complete list of linters available in lintr.
#' @export
scalar_in_linter <- function(in_operators = NULL) {
# TODO(#2085): Extend to include other cases where the RHS is clearly a scalar
# NB: all of logical, integer, double, hex, complex are parsed as NUM_CONST
xpath <- glue("
//SPECIAL[{xp_text_in_table(c('%in%', {in_operators}))}]
/following-sibling::expr[NUM_CONST[not(starts-with(text(), 'NA'))] or STR_CONST]
/parent::expr
")
Linter(linter_level = "expression", function(source_expression) {
xml <- source_expression$xml_parsed_content
bad_expr <- xml_find_all(xml, xpath)
in_op <- xml_find_chr(bad_expr, "string(SPECIAL)")
lint_msg <- glue(
"Use comparison operators (e.g. ==, !=, etc.) to match length-1 scalars instead of {in_op}. ",
"Note that comparison operators preserve NA where {in_op} does not."
)
xml_nodes_to_lints(
bad_expr,
source_expression = source_expression,
lint_message = lint_msg,
type = "warning"
)
})
}
|
