Make a new list based on all linters provided by packages and tagged with tags.
The result of this function is meant to be passed to the linters argument of lint(),
or to be put in your configuration file.
Arguments
- tags
Optional character vector of tags to search. Only linters with at least one matching tag will be returned. If
tagsisNULL, all linters will be returned.- ...
Arguments of elements to change. If unnamed, the argument is automatically named. If the named argument already exists in the list of linters, it is replaced by the new element. If it does not exist, it is added. If the value is
NULL, the linter is removed.- packages
A character vector of packages to search for linters.
- exclude_tags
Tags to exclude from the results. Linters with at least one matching tag will not be returned. If
except_tagsisNULL, no linters will be excluded.
See also
linters_with_defaults for basing off lintr's set of default linters. available_linters to get a data frame of available linters. linters for a complete list of linters available in lintr.
Examples
# `linters_with_defaults()` and `linters_with_tags("default")` are the same:
all.equal(linters_with_defaults(), linters_with_tags("default"))
#> [1] TRUE
# Get all linters useful for package development
linters_with_tags(tags = "package_development")
#> $backport_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> if (all(r_version >= R_system_version(names(backports)))) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> all_names_nodes <- xml2::xml_find_all(xml, names_xpath)
#> all_names <- xml2::xml_text(all_names_nodes)
#> needs_backport <- do.call(rbind, lapply(backport_blacklist,
#> function(nm) all_names %in% nm))
#> bad_idx <- colSums(needs_backport) > 0L
#> needs_backport_version_idx <- ((which(needs_backport) - 1L)%%length(backport_blacklist)) +
#> 1L
#> lint_message <- sprintf(paste("%s (R %s) is not available for dependency R >= %s.",
#> "Use the `except` argument of `backport_linter()` to configure available backports."),
#> all_names[bad_idx], names(backport_blacklist)[needs_backport_version_idx],
#> r_version)
#> xml_nodes_to_lints(all_names_nodes[bad_idx], source_expression = source_expression,
#> lint_message = lint_message, type = "warning")
#> }
#> <bytecode: 0x55cacf909340>
#> <environment: 0x55cad08ad968>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "backport_linter"
#>
#> $conjunct_test_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> xml <- source_expression$full_xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> if (length(bad_expr) == 0L) {
#> return(list())
#> }
#> matched_fun <- xp_call_name(bad_expr)
#> operator <- xml2::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)",
#> "write multiple conditions like %s(A, B).")
#> lint_message <- paste(sprintf("Instead of %s(A %s B),", matched_fun,
#> operator), sprintf(replacement_fmt, matched_fun), "The latter will produce better error messages in the case of failure.")
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message = lint_message,
#> type = "warning")
#> }
#> <bytecode: 0x55cacf910370>
#> <environment: 0x55caced74898>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "conjunct_test_linter"
#>
#> $expect_comparison_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> comparator <- xml2::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")
#> }
#> <bytecode: 0x55cacf914290>
#> <environment: 0x55cacef7ac38>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_comparison_linter"
#>
#> $expect_identical_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = paste("Use expect_identical(x, y) by default; resort to expect_equal() only when needed,",
#> "e.g. when setting ignore_attr= or tolerance=."),
#> type = "warning")
#> }
#> <bytecode: 0x55cacef98fb8>
#> <environment: 0x55cacf6a8f28>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_identical_linter"
#>
#> $expect_length_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::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")
#> }
#> <bytecode: 0x55cacef9ad88>
#> <environment: 0x55cacf7a7228>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_length_linter"
#>
#> $expect_named_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> matched_function <- xp_call_name(bad_expr, depth = 0L)
#> lint_message <- sprintf("expect_named(x, n) is better than %s(names(x), n)",
#> matched_function)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message, type = "warning")
#> }
#> <bytecode: 0x55cacef9c8b8>
#> <environment: 0x55cad026e678>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_named_linter"
#>
#> $expect_not_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = "expect_false(x) is better than expect_true(!x), and vice versa.",
#> type = "warning")
#> }
#> <bytecode: 0x55cacef9e6f8>
#> <environment: 0x55cacf7c6e90>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_not_linter"
#>
#> $expect_null_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> matched_function <- xp_call_name(bad_expr, depth = 0L)
#> msg <- ifelse(matched_function %in% c("expect_equal", "expect_identical"),
#> sprintf("expect_null(x) is better than %s(x, NULL)",
#> matched_function), "expect_null(x) is better than expect_true(is.null(x))")
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message = msg,
#> type = "warning")
#> }
#> <bytecode: 0x55cacefa0458>
#> <environment: 0x55cacf7e1190>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_null_linter"
#>
#> $expect_s3_class_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> matched_function <- xp_call_name(bad_expr)
#> msg <- ifelse(matched_function %in% c("expect_equal", "expect_identical"),
#> sprintf("expect_s3_class(x, k) is better than %s(class(x), k).",
#> matched_function), "expect_s3_class(x, k) is better than expect_true(is.<k>(x)) or expect_true(inherits(x, k)).")
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message = paste(msg,
#> "Note also expect_s4_class() available for testing S4 objects."),
#> type = "warning")
#> }
#> <bytecode: 0x55cacefa5300>
#> <environment: 0x55cad0456b98>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_s3_class_linter"
#>
#> $expect_s4_class_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = paste("expect_s4_class(x, k) is better than expect_true(is(x, k)).",
#> "Note also expect_s3_class() available for testing S3 objects."),
#> type = "warning")
#> }
#> <bytecode: 0x55cacefa6bc8>
#> <environment: 0x55cad07b78c8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_s4_class_linter"
#>
#> $expect_true_false_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> 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'])")
#> lint_message <- sprintf("expect_%s(x) is better than %s(x, %s)",
#> tolower(truth_value), call_name, truth_value)
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message,
#> type = "warning")
#> }
#> <bytecode: 0x55cacefa86c0>
#> <environment: 0x55cad07913b0>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_true_false_linter"
#>
#> $expect_type_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> matched_function <- xp_call_name(bad_expr)
#> msg <- ifelse(matched_function %in% c("expect_equal", "expect_identical"),
#> sprintf("expect_type(x, t) is better than %s(typeof(x), t)",
#> matched_function), "expect_type(x, t) is better than expect_true(is.<t>(x))")
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message = msg,
#> type = "warning")
#> }
#> <bytecode: 0x55cacefad4f8>
#> <environment: 0x55cad09d2f78>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_type_linter"
#>
#> $package_hooks_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_msg_call_lints <- function(xml, hook) {
#> bad_expr <- xml2::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")
#> }
#> onload_bad_msg_call_lints <- bad_msg_call_lints(xml, ".onLoad")
#> onattach_bad_msg_call_lints <- bad_msg_call_lints(xml, ".onAttach")
#> load_arg_name_expr <- xml2::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'.",
#> xml2::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")
#> 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_message <- character(length(library_require_bad_call))
#> is_installed_packages <- library_require_bad_call == "installed.packages"
#> library_require_message[is_installed_packages] <- sprintf("Don't slow down package load by running installed.packages() in %s().",
#> library_require_hook)
#> library_require_message[!is_installed_packages] <- sprintf("Don't alter the search() path in %s() by calling %s().",
#> library_require_hook, library_require_bad_call)
#> library_require_lints <- xml_nodes_to_lints(library_require_expr,
#> source_expression, library_require_message, type = "warning")
#> bad_unload_call_expr <- xml2::xml_find_all(xml, bad_unload_call_xpath)
#> bad_unload_call_message <- sprintf("Use library.dynam.unload() calls in .onUnload(), not %s().",
#> xml2::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")
#> unload_arg_name_expr <- xml2::xml_find_all(xml, unload_arg_name_xpath)
#> unload_arg_name_message <- sprintf("%s() should take one argument starting with 'lib'.",
#> xml2::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")
#> return(c(onload_bad_msg_call_lints, onattach_bad_msg_call_lints,
#> load_arg_name_lints, library_require_lints, bad_unload_call_lints,
#> unload_arg_name_lints))
#> }
#> <bytecode: 0x55cad08a1268>
#> <environment: 0x55cad04ed6e0>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "package_hooks_linter"
#>
#> $yoda_test_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> matched_call <- xp_call_name(bad_expr)
#> second_const <- xml2::xml_find_first(bad_expr, second_const_xpath)
#> lint_message <- ifelse(is.na(second_const), paste("Tests should compare objects in the order 'actual', 'expected', not the reverse.",
#> sprintf("For example, do %1$s(foo(x), 2L) instead of %1$s(2L, foo(x)).",
#> matched_call)), sprintf("Avoid storing placeholder tests like %s(1, 1)",
#> matched_call))
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message,
#> type = "warning")
#> }
#> <bytecode: 0x55cad08a9690>
#> <environment: 0x55cad0219ad0>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "yoda_test_linter"
#>
# Get all linters provided by lintr
linters_with_tags(tags = NULL)
#> $absolute_path_linter
#> function (source_expression)
#> {
#> lapply(ids_with_token(source_expression, "STR_CONST"), function(id) {
#> token <- with_id(source_expression, id)
#> path <- get_r_string(token$text)
#> if (path_function(path)) {
#> start <- token[["col1"]] + 1L
#> end <- token[["col2"]] - 1L
#> Lint(filename = source_expression[["filename"]],
#> line_number = token[["line1"]], column_number = start,
#> type = "warning", message = message, line = source_expression[["lines"]][[as.character(token[["line1"]])]],
#> ranges = list(c(start, end)))
#> }
#> })
#> }
#> <bytecode: 0x55cacefbbce8>
#> <environment: 0x55cad0fa7e80>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "absolute_path_linter"
#>
#> $any_duplicated_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> any_duplicated_expr <- xml2::xml_find_all(xml, any_duplicated_xpath)
#> any_duplicated_lints <- xml_nodes_to_lints(any_duplicated_expr,
#> source_expression = source_expression, lint_message = "anyDuplicated(x, ...) > 0 is better than any(duplicated(x), ...).",
#> type = "warning")
#> length_unique_expr <- xml2::xml_find_all(xml, length_unique_xpath)
#> lint_message <- ifelse(is.na(xml2::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)")
#> length_unique_lints <- xml_nodes_to_lints(length_unique_expr,
#> source_expression = source_expression, lint_message = lint_message,
#> type = "warning")
#> return(c(any_duplicated_lints, length_unique_lints))
#> }
#> <bytecode: 0x55cad0d65c88>
#> <environment: 0x55cad0f71400>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "any_duplicated_linter"
#>
#> $any_is_na_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = "anyNA(x) is better than any(is.na(x)).",
#> type = "warning")
#> }
#> <bytecode: 0x55cad0d67208>
#> <environment: 0x55cacffb0db8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "any_is_na_linter"
#>
#> $assignment_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> if (length(bad_expr) == 0L) {
#> return(list())
#> }
#> operator <- xml2::xml_text(bad_expr)
#> lint_message_fmt <- ifelse(operator %in% c("<<-", "->>"),
#> "%s can have hard-to-predict behavior; prefer assigning to a specific environment instead (with assign() or <-).",
#> "Use <-, not %s, for assignment.")
#> 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)
#> lint_message_fmt[trailing_assignments] <- "Assignment %s should not be trailing at end of line"
#> }
#> lint_message <- sprintf(lint_message_fmt, operator)
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message,
#> type = "style")
#> }
#> <bytecode: 0x55cace77c288>
#> <environment: 0x55cad0411070>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "assignment_linter"
#>
#> $backport_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> if (all(r_version >= R_system_version(names(backports)))) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> all_names_nodes <- xml2::xml_find_all(xml, names_xpath)
#> all_names <- xml2::xml_text(all_names_nodes)
#> needs_backport <- do.call(rbind, lapply(backport_blacklist,
#> function(nm) all_names %in% nm))
#> bad_idx <- colSums(needs_backport) > 0L
#> needs_backport_version_idx <- ((which(needs_backport) - 1L)%%length(backport_blacklist)) +
#> 1L
#> lint_message <- sprintf(paste("%s (R %s) is not available for dependency R >= %s.",
#> "Use the `except` argument of `backport_linter()` to configure available backports."),
#> all_names[bad_idx], names(backport_blacklist)[needs_backport_version_idx],
#> r_version)
#> xml_nodes_to_lints(all_names_nodes[bad_idx], source_expression = source_expression,
#> lint_message = lint_message, type = "warning")
#> }
#> <bytecode: 0x55cacf909340>
#> <environment: 0x55cad1107cc0>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "backport_linter"
#>
#> $brace_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> lints <- list()
#> lints <- c(lints, xml_nodes_to_lints(xml2::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."))
#> lints <- c(lints, xml_nodes_to_lints(xml2::xml_find_all(xml,
#> xp_paren_brace), source_expression = source_expression,
#> lint_message = "There should be a space before an opening curly brace."))
#> lints <- c(lints, xml_nodes_to_lints(xml2::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."))
#> lints <- c(lints, xml_nodes_to_lints(xml2::xml_find_all(xml,
#> xp_else_same_line), source_expression = source_expression,
#> lint_message = "`else` should come on the same line as the previous `}`."))
#> lints <- c(lints, xml_nodes_to_lints(xml2::xml_find_all(xml,
#> xp_function_brace), source_expression = source_expression,
#> lint_message = "Any function spanning multiple lines should use curly braces."))
#> lints <- c(lints, xml_nodes_to_lints(xml2::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."))
#> lints
#> }
#> <bytecode: 0x55caceb36128>
#> <environment: 0x55cad03ce0d0>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "brace_linter"
#>
#> $class_equals_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> operator <- xml2::xml_find_chr(bad_expr, "string(*[2])")
#> lint_message <- sprintf("Instead of comparing class(x) with %s, use inherits(x, 'class-name') or is.<class> or is(x, 'class')",
#> operator)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = lint_message, type = "warning")
#> }
#> <bytecode: 0x55cad0d69080>
#> <environment: 0x55cad0575ca8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "class_equals_linter"
#>
#> $commas_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> before_lints <- xml_nodes_to_lints(xml2::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)",
#> range_end_xpath = "number(./@col1 - 1)")
#> after_lints <- xml_nodes_to_lints(xml2::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)", range_end_xpath = "number(./@col2 + 1)")
#> c(before_lints, after_lints)
#> }
#> <bytecode: 0x55cace244468>
#> <environment: 0x55cad04c4ad8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "commas_linter"
#>
#> $commented_code_linter
#> function (source_expression)
#> {
#> 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)
#> code_candidates <- re_matches(all_comments, code_candidate_regex,
#> global = FALSE, locations = TRUE)
#> extracted_code <- code_candidates[, "code"]
#> extracted_code <- rex::re_substitutes(extracted_code, rex::rex(",",
#> any_spaces, end), "")
#> extracted_code <- rex::re_substitutes(extracted_code, rex::rex(start,
#> any_spaces, ","), "")
#> is_parsable <- which(vapply(extracted_code, parsable, logical(1L)))
#> lint_list <- xml_nodes_to_lints(all_comment_nodes[is_parsable],
#> source_expression = source_expression, lint_message = "Commented code should be removed.")
#> for (i in seq_along(lint_list)) {
#> rng <- lint_list[[i]]$ranges[[1L]]
#> rng[2L] <- rng[1L] + code_candidates[is_parsable[i],
#> "code.end"] - 1L
#> rng[1L] <- rng[1L] + code_candidates[is_parsable[i],
#> "code.start"] - 1L
#> lint_list[[i]]$column_number <- rng[1L]
#> lint_list[[i]]$ranges <- list(rng)
#> }
#> lint_list
#> }
#> <bytecode: 0x55cacea3ec60>
#> <environment: 0x55cad0834b48>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "commented_code_linter"
#>
#> $condition_message_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::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("",
#> " ")]
#> outer_call <- xp_call_name(bad_expr)
#> inner_call <- xp_call_name(bad_expr, depth = 2L)
#> lint_message <- paste("Don't use", inner_call, "to build",
#> outer_call, "strings.", "Instead use the fact that these functions build condition message strings from their input",
#> "(using \"\" as a separator). For translatable strings, prefer using gettextf().")
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = lint_message, type = "warning")
#> }
#> <bytecode: 0x55cad0d7bbc0>
#> <environment: 0x55cad074d2d0>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "condition_message_linter"
#>
#> $conjunct_test_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> xml <- source_expression$full_xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> if (length(bad_expr) == 0L) {
#> return(list())
#> }
#> matched_fun <- xp_call_name(bad_expr)
#> operator <- xml2::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)",
#> "write multiple conditions like %s(A, B).")
#> lint_message <- paste(sprintf("Instead of %s(A %s B),", matched_fun,
#> operator), sprintf(replacement_fmt, matched_fun), "The latter will produce better error messages in the case of failure.")
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message = lint_message,
#> type = "warning")
#> }
#> <bytecode: 0x55cacf910370>
#> <environment: 0x55cad07d6690>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "conjunct_test_linter"
#>
#> $consecutive_stopifnot_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> xml <- source_expression$full_xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = "Unify consecutive calls to stopifnot().",
#> type = "warning")
#> }
#> <bytecode: 0x55cad0d7ced8>
#> <environment: 0x55cad065eb48>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "consecutive_stopifnot_linter"
#>
#> $cyclocomp_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> complexity <- try_silently(cyclocomp::cyclocomp(parse(text = source_expression$content)))
#> if (inherits(complexity, "try-error") || complexity <= complexity_limit) {
#> return(list())
#> }
#> col1 <- source_expression[["column"]][1L]
#> Lint(filename = source_expression[["filename"]], line_number = source_expression[["line"]][1L],
#> column_number = source_expression[["column"]][1L], type = "style",
#> message = sprintf("Functions should have cyclomatic complexity of less than %d, this has %d.",
#> complexity_limit, complexity), ranges = list(rep(col1,
#> 2L)), line = source_expression$lines[1L])
#> }
#> <bytecode: 0x55cacfea3540>
#> <environment: 0x55cad01020b8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "cyclocomp_linter"
#>
#> $duplicate_argument_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> xml <- source_expression$full_xml_parsed_content
#> calls <- xml2::xml_find_all(xml, xpath_call_with_args)
#> if (length(except)) {
#> calls_text <- get_r_string(xp_call_name(calls))
#> calls <- calls[!(calls_text %in% except)]
#> }
#> all_arg_nodes <- lapply(calls, function(call_node) {
#> xml2::xml_find_all(call_node, xpath_arg_name)
#> })
#> arg_names <- lapply(all_arg_nodes, get_r_string)
#> is_duplicated <- lapply(arg_names, duplicated)
#> xml_nodes_to_lints(unlist(all_arg_nodes, recursive = FALSE)[unlist(is_duplicated)],
#> source_expression = source_expression, lint_message = "Duplicate arguments in function call.",
#> type = "warning")
#> }
#> <bytecode: 0x55cad0d7fbf8>
#> <environment: 0x55cad0ef0768>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "duplicate_argument_linter"
#>
#> $equals_na_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message = "Use is.na for comparisons to NA (not == or !=)",
#> type = "warning")
#> }
#> <bytecode: 0x55cacfe0ee70>
#> <environment: 0x55cad001ae18>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "equals_na_linter"
#>
#> $expect_comparison_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> comparator <- xml2::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")
#> }
#> <bytecode: 0x55cacf914290>
#> <environment: 0x55cad007e498>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_comparison_linter"
#>
#> $expect_identical_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = paste("Use expect_identical(x, y) by default; resort to expect_equal() only when needed,",
#> "e.g. when setting ignore_attr= or tolerance=."),
#> type = "warning")
#> }
#> <bytecode: 0x55cacef98fb8>
#> <environment: 0x55cad01d3f20>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_identical_linter"
#>
#> $expect_length_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::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")
#> }
#> <bytecode: 0x55cacef9ad88>
#> <environment: 0x55cacdb506c0>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_length_linter"
#>
#> $expect_named_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> matched_function <- xp_call_name(bad_expr, depth = 0L)
#> lint_message <- sprintf("expect_named(x, n) is better than %s(names(x), n)",
#> matched_function)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message, type = "warning")
#> }
#> <bytecode: 0x55cacef9c8b8>
#> <environment: 0x55cacda31308>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_named_linter"
#>
#> $expect_not_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = "expect_false(x) is better than expect_true(!x), and vice versa.",
#> type = "warning")
#> }
#> <bytecode: 0x55cacef9e6f8>
#> <environment: 0x55cacd9d8fd8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_not_linter"
#>
#> $expect_null_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> matched_function <- xp_call_name(bad_expr, depth = 0L)
#> msg <- ifelse(matched_function %in% c("expect_equal", "expect_identical"),
#> sprintf("expect_null(x) is better than %s(x, NULL)",
#> matched_function), "expect_null(x) is better than expect_true(is.null(x))")
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message = msg,
#> type = "warning")
#> }
#> <bytecode: 0x55cacefa0458>
#> <environment: 0x55cacd97eaf8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_null_linter"
#>
#> $expect_s3_class_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> matched_function <- xp_call_name(bad_expr)
#> msg <- ifelse(matched_function %in% c("expect_equal", "expect_identical"),
#> sprintf("expect_s3_class(x, k) is better than %s(class(x), k).",
#> matched_function), "expect_s3_class(x, k) is better than expect_true(is.<k>(x)) or expect_true(inherits(x, k)).")
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message = paste(msg,
#> "Note also expect_s4_class() available for testing S4 objects."),
#> type = "warning")
#> }
#> <bytecode: 0x55cacefa5300>
#> <environment: 0x55cacc71c3a8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_s3_class_linter"
#>
#> $expect_s4_class_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = paste("expect_s4_class(x, k) is better than expect_true(is(x, k)).",
#> "Note also expect_s3_class() available for testing S3 objects."),
#> type = "warning")
#> }
#> <bytecode: 0x55cacefa6bc8>
#> <environment: 0x55cacd7d0600>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_s4_class_linter"
#>
#> $expect_true_false_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> 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'])")
#> lint_message <- sprintf("expect_%s(x) is better than %s(x, %s)",
#> tolower(truth_value), call_name, truth_value)
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message,
#> type = "warning")
#> }
#> <bytecode: 0x55cacefa86c0>
#> <environment: 0x55cacd7635e8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_true_false_linter"
#>
#> $expect_type_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> matched_function <- xp_call_name(bad_expr)
#> msg <- ifelse(matched_function %in% c("expect_equal", "expect_identical"),
#> sprintf("expect_type(x, t) is better than %s(typeof(x), t)",
#> matched_function), "expect_type(x, t) is better than expect_true(is.<t>(x))")
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message = msg,
#> type = "warning")
#> }
#> <bytecode: 0x55cacefad4f8>
#> <environment: 0x55cacd6d7840>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "expect_type_linter"
#>
#> $extraction_operator_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> 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))
#> xml_nodes_to_lints(bad_exprs, source_expression = source_expression,
#> lint_message = msgs, type = "warning")
#> }
#> <bytecode: 0x55cad0d6e0b0>
#> <environment: 0x55cacd5d2380>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "extraction_operator_linter"
#>
#> $fixed_regex_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> patterns <- xml2::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 <- xml2::xml_find_chr(patterns[is_static], "string(preceding-sibling::expr[last()]/SYMBOL_FUNCTION_CALL)")
#> is_stringr <- startsWith(call_name, "str_")
#> replacement <- ifelse(is_stringr, sprintf("stringr::fixed(%s)",
#> fixed_equivalent), fixed_equivalent)
#> msg <- paste("This regular expression is static, i.e., its matches can be expressed as a fixed substring expression, which",
#> "is faster to compute. Here, you can use", replacement,
#> ifelse(is_stringr, "as the pattern.", "with fixed = TRUE."))
#> xml_nodes_to_lints(patterns[is_static], source_expression = source_expression,
#> lint_message = msg, type = "warning")
#> }
#> <bytecode: 0x55cad06c60b0>
#> <environment: 0x55cacd543970>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "fixed_regex_linter"
#>
#> $function_argument_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = "Arguments without defaults should come before arguments with defaults.",
#> type = "style")
#> }
#> <bytecode: 0x55cad0d70b40>
#> <environment: 0x55cacd4b5a30>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "function_argument_linter"
#>
#> $function_left_parentheses_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_exprs <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_exprs, source_expression = source_expression,
#> lint_message = "Remove spaces before the left parenthesis in a function call.",
#> range_start_xpath = "number(./@col2 + 1)", range_end_xpath = "number(./following-sibling::OP-LEFT-PAREN/@col1 - 1)")
#> }
#> <bytecode: 0x55cacfe12578>
#> <environment: 0x55cacd425a08>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "function_left_parentheses_linter"
#>
#> $ifelse_censor_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> 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])")
#> 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))
#> second_var <- rep_len("y", length(match_first))
#> first_var[!match_first] <- "y"
#> second_var[!match_first] <- "x"
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = sprintf("%s(x, y) is preferable to %s(x %s y, %s, %s).",
#> optimizer, matched_call, operator, first_var, second_var),
#> type = "warning")
#> }
#> <bytecode: 0x55cad06bd428>
#> <environment: 0x55cacd31cb78>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "ifelse_censor_linter"
#>
#> $implicit_integer_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> xml <- source_expression$full_xml_parsed_content
#> numbers <- xml2::xml_find_all(xml, "//NUM_CONST")
#> xml_nodes_to_lints(numbers[is_implicit_integer(xml2::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", column_number_xpath = "number(./@col2 + 1)",
#> range_end_xpath = "number(./@col2 + 1)")
#> }
#> <bytecode: 0x55cad06c0a50>
#> <environment: 0x55cacd254ed8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "implicit_integer_linter"
#>
#> $infix_spaces_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = lint_message, type = "style")
#> }
#> <bytecode: 0x55cacfa0d660>
#> <environment: 0x55cacd188b48>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "infix_spaces_linter"
#>
#> $inner_combine_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> matched_call <- xp_call_name(bad_expr, depth = 2L)
#> lint_message <- paste("Combine inputs to vectorized functions first to take full advantage of vectorization, e.g.,",
#> sprintf("%1$s(c(x, y)) only runs the more expensive %1$s() once as compared to c(%1$s(x), %1$s(y)).",
#> matched_call))
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message, type = "warning")
#> }
#> <bytecode: 0x55cad06cbd68>
#> <environment: 0x55cacd0a4428>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "inner_combine_linter"
#>
#> $line_length_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> line_lengths <- nchar(source_expression$file_lines)
#> long_lines <- which(line_lengths > length)
#> lint_message <- sprintf("Lines should not be more than %d characters.",
#> length)
#> lapply(long_lines, function(long_line) {
#> Lint(filename = source_expression$filename, line_number = long_line,
#> column_number = length + 1L, type = "style", message = lint_message,
#> line = source_expression$file_lines[long_line], ranges = list(c(1L,
#> line_lengths[long_line])))
#> })
#> }
#> <bytecode: 0x55cad0b13a80>
#> <environment: 0x55caccf4bc50>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "line_length_linter"
#>
#> $literal_coercion_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = paste("Use literals directly where possible, instead of coercion.",
#> "c.f. 1L instead of as.integer(1) or rlang::int(1), or NA_real_ instead of as.numeric(NA)."),
#> type = "warning")
#> }
#> <bytecode: 0x55cad06ccd70>
#> <environment: 0x55caccec22f8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "literal_coercion_linter"
#>
#> $missing_argument_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> 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))
#> xml_nodes_to_lints(missing_args[!function_call_name %in%
#> except], source_expression = source_expression, lint_message = "Missing argument in function call.")
#> }
#> <bytecode: 0x55cad06d1f98>
#> <environment: 0x55caccdf0968>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "missing_argument_linter"
#>
#> $missing_package_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> 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, "OP-LEFT-PAREN[1]/following-sibling::expr[1][SYMBOL | STR_CONST]"))
#> installed_packges <- .packages(all.available = TRUE)
#> missing_pkgs <- !(pkg_names %in% installed_packges)
#> xml_nodes_to_lints(pkg_calls[missing_pkgs], source_expression = source_expression,
#> lint_message = sprintf("Package '%s' is not installed.",
#> pkg_names[missing_pkgs]), type = "warning")
#> }
#> <bytecode: 0x55cad06d3160>
#> <environment: 0x55caccd33690>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "missing_package_linter"
#>
#> $namespace_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> xml <- source_expression$full_xml_parsed_content
#> ns_nodes <- xml2::xml_find_all(xml, "//NS_GET | //NS_GET_INT")
#> if (length(ns_nodes) == 0L) {
#> return(list())
#> }
#> package_nodes <- xml2::xml_find_all(ns_nodes, "preceding-sibling::*[1]")
#> packages <- get_r_string(package_nodes)
#> lints <- list()
#> installed_packages <- .packages(all.available = TRUE)
#> installed <- packages %in% installed_packages
#> if (!all(installed)) {
#> lints <- c(lints, xml_nodes_to_lints(package_nodes[!installed],
#> source_expression = source_expression, lint_message = sprintf("Package '%s' is not installed.",
#> packages[!installed]), type = "warning"))
#> ns_nodes <- ns_nodes[installed]
#> packages <- packages[installed]
#> package_nodes <- package_nodes[installed]
#> }
#> if (!check_exports && !check_nonexports) {
#> return(lints)
#> }
#> namespaces <- lapply(packages, function(package) tryCatch(getNamespace(package),
#> error = identity))
#> failed_namespace <- vapply(namespaces, inherits, "condition",
#> FUN.VALUE = logical(1L))
#> if (any(failed_namespace)) {
#> lints <- c(lints, xml_nodes_to_lints(package_nodes[failed_namespace],
#> source_expression = source_expression, lint_message = vapply(namespaces[failed_namespace],
#> conditionMessage, character(1L)), type = "warning"))
#> ns_nodes <- ns_nodes[!failed_namespace]
#> packages <- packages[!failed_namespace]
#> namespaces <- namespaces[!failed_namespace]
#> }
#> ns_get <- xml2::xml_text(ns_nodes) == "::"
#> symbol_nodes <- xml2::xml_find_all(ns_nodes, "following-sibling::*[1]")
#> symbols <- get_r_string(symbol_nodes)
#> if (check_nonexports) {
#> lints <- c(lints, build_ns_get_int_lints(packages[!ns_get],
#> symbols[!ns_get], symbol_nodes[!ns_get], namespaces[!ns_get],
#> source_expression))
#> }
#> if (check_exports) {
#> lints <- c(lints, build_ns_get_lints(packages[ns_get],
#> symbols[ns_get], symbol_nodes[ns_get], namespaces[ns_get],
#> source_expression))
#> }
#> lints
#> }
#> <bytecode: 0x55cad06da130>
#> <environment: 0x55caccb8ac78>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "namespace_linter"
#>
#> $nested_ifelse_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> matched_call <- xp_call_name(bad_expr)
#> lint_message <- paste(sprintf("Don't use nested %s() calls;",
#> matched_call), "instead, try (1) data.table::fcase; (2) dplyr::case_when; or (3) using a lookup table.")
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message,
#> type = "warning")
#> }
#> <bytecode: 0x55cad06e2948>
#> <environment: 0x55cacc8a5f48>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "nested_ifelse_linter"
#>
#> $no_tab_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> all_matches <- re_matches(source_expression[["lines"]], regex,
#> locations = TRUE, global = TRUE)
#> line_numbers <- as.integer(names(source_expression[["lines"]]))
#> lints <- Map(function(line_matches, line_number) {
#> lapply(split(line_matches, seq_len(nrow(line_matches))),
#> function(.match) {
#> if (is.na(.match[["start"]]) || .in_ignorable_position(source_expression,
#> line_number, .match)) {
#> return()
#> }
#> start <- .match[["start"]]
#> end <- .match[["end"]]
#> Lint(filename = source_expression[["filename"]],
#> line_number = line_number, column_number = start,
#> type = lint_type, message = lint_msg, line = source_expression[["lines"]][[as.character(line_number)]],
#> ranges = list(c(start, end)))
#> })
#> }, all_matches, line_numbers)
#> Filter(function(x) any(lengths(x) > 0L), lints)
#> }
#> <bytecode: 0x55cacfa106d8>
#> <environment: 0x55cacc6d2568>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "no_tab_linter"
#>
#> $nonportable_path_linter
#> function (source_expression)
#> {
#> lapply(ids_with_token(source_expression, "STR_CONST"), function(id) {
#> token <- with_id(source_expression, id)
#> path <- get_r_string(token$text)
#> if (path_function(path)) {
#> start <- token[["col1"]] + 1L
#> end <- token[["col2"]] - 1L
#> Lint(filename = source_expression[["filename"]],
#> line_number = token[["line1"]], column_number = start,
#> type = "warning", message = message, line = source_expression[["lines"]][[as.character(token[["line1"]])]],
#> ranges = list(c(start, end)))
#> }
#> })
#> }
#> <bytecode: 0x55cacefbbce8>
#> <environment: 0x55cacc5a3be0>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "nonportable_path_linter"
#>
#> $numeric_leading_zero_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = "Include the leading zero for fractional numeric constants.",
#> type = "warning")
#> }
#> <bytecode: 0x55cad06e4e50>
#> <environment: 0x55cacc4a6f98>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "numeric_leading_zero_linter"
#>
#> $object_length_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> xml <- source_expression$full_xml_parsed_content
#> assignments <- xml2::xml_find_all(xml, object_name_xpath)
#> nms <- strip_names(xml2::xml_text(assignments))
#> ns_imports <- namespace_imports(find_package(source_expression$filename))
#> generics <- strip_names(c(declared_s3_generics(xml), imported_s3_generics(ns_imports)$fun,
#> .base_s3_generics))
#> generics <- unique(generics[nzchar(generics)])
#> nms_stripped <- re_substitutes(nms, rex(start, or(generics),
#> "."), "")
#> too_long <- nchar(nms_stripped) > length
#> xml_nodes_to_lints(assignments[too_long], source_expression = source_expression,
#> lint_message = lint_message, type = "style")
#> }
#> <bytecode: 0x55cacf07b5c0>
#> <environment: 0x55cacc2e6440>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "object_length_linter"
#>
#> $object_name_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> xml <- source_expression$full_xml_parsed_content
#> assignments <- xml2::xml_find_all(xml, object_name_xpath)
#> nms <- strip_names(xml2::xml_text(assignments))
#> generics <- c(declared_s3_generics(xml), imported_s3_generics(namespace_imports(find_package(source_expression$filename)))$fun,
#> .base_s3_generics)
#> generics <- unique(generics[nzchar(generics)])
#> style_matches <- lapply(styles, function(style) {
#> check_style(nms, style, generics)
#> })
#> matches_a_style <- Reduce(`|`, style_matches)
#> xml_nodes_to_lints(assignments[!matches_a_style], source_expression,
#> lint_message = lint_message, type = "style")
#> }
#> <bytecode: 0x55cacef456e0>
#> <environment: 0x55cacc1aa688>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "object_name_linter"
#>
#> $object_usage_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> pkg_name <- pkg_name(find_package(dirname(source_expression$filename)))
#> env <- make_check_env(pkg_name)
#> declared_globals <- try_silently(utils::globalVariables(package = pkg_name %||%
#> globalenv()))
#> xml <- source_expression$full_xml_parsed_content
#> symbols <- c(get_assignment_symbols(xml), get_imported_symbols(xml))
#> for (symbol in symbols) {
#> assign(symbol, function(...) invisible(), envir = env)
#> }
#> fun_assignments <- xml2::xml_find_all(xml, xpath_function_assignment)
#> lapply(fun_assignments, function(fun_assignment) {
#> code <- get_content(lines = source_expression$content,
#> fun_assignment)
#> fun <- try_silently(eval(envir = env, parse(text = code,
#> keep.source = TRUE)))
#> if (inherits(fun, "try-error")) {
#> return()
#> }
#> known_used_symbols <- get_used_symbols(fun_assignment,
#> interpret_glue = interpret_glue)
#> res <- parse_check_usage(fun, known_used_symbols = known_used_symbols,
#> declared_globals = declared_globals, start_line = as.integer(xml2::xml_attr(fun_assignment,
#> "line1")))
#> res$name <- rex::re_substitutes(res$name, rex::rex("<-"),
#> "")
#> lintable_symbols <- xml2::xml_find_all(fun_assignment,
#> "descendant::SYMBOL | descendant::SYMBOL_FUNCTION_CALL")
#> lintable_symbol_names <- gsub("^`|`$", "", get_r_string(lintable_symbols))
#> lintable_symbol_lines <- as.integer(xml2::xml_attr(lintable_symbols,
#> "line1"))
#> matched_symbol <- vapply(seq_len(nrow(res)), function(i) {
#> match(TRUE, lintable_symbol_names == res$name[i] &
#> lintable_symbol_lines >= res$line1[i] & lintable_symbol_lines <=
#> res$line2[i])
#> }, integer(1L))
#> nodes <- unclass(lintable_symbols)[matched_symbol]
#> nodes[is.na(matched_symbol)] <- list(fun_assignment)
#> xml_nodes_to_lints(nodes, source_expression = source_expression,
#> lint_message = res$message, type = "warning")
#> })
#> }
#> <bytecode: 0x55cacf02c718>
#> <environment: 0x55cacc0fbee8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "object_usage_linter"
#>
#> $outer_negation_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> matched_call <- xp_call_name(bad_expr)
#> inverse_call <- ifelse(matched_call == "any", "all", "any")
#> lint_message <- paste(sprintf("!%s(x) is better than %s(!x).",
#> inverse_call, matched_call), "The former applies negation only once after aggregation instead of many times for each element of x.")
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message,
#> type = "warning")
#> }
#> <bytecode: 0x55cad06e6a60>
#> <environment: 0x55cacc010440>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "outer_negation_linter"
#>
#> $package_hooks_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_msg_call_lints <- function(xml, hook) {
#> bad_expr <- xml2::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")
#> }
#> onload_bad_msg_call_lints <- bad_msg_call_lints(xml, ".onLoad")
#> onattach_bad_msg_call_lints <- bad_msg_call_lints(xml, ".onAttach")
#> load_arg_name_expr <- xml2::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'.",
#> xml2::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")
#> 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_message <- character(length(library_require_bad_call))
#> is_installed_packages <- library_require_bad_call == "installed.packages"
#> library_require_message[is_installed_packages] <- sprintf("Don't slow down package load by running installed.packages() in %s().",
#> library_require_hook)
#> library_require_message[!is_installed_packages] <- sprintf("Don't alter the search() path in %s() by calling %s().",
#> library_require_hook, library_require_bad_call)
#> library_require_lints <- xml_nodes_to_lints(library_require_expr,
#> source_expression, library_require_message, type = "warning")
#> bad_unload_call_expr <- xml2::xml_find_all(xml, bad_unload_call_xpath)
#> bad_unload_call_message <- sprintf("Use library.dynam.unload() calls in .onUnload(), not %s().",
#> xml2::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")
#> unload_arg_name_expr <- xml2::xml_find_all(xml, unload_arg_name_xpath)
#> unload_arg_name_message <- sprintf("%s() should take one argument starting with 'lib'.",
#> xml2::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")
#> return(c(onload_bad_msg_call_lints, onattach_bad_msg_call_lints,
#> load_arg_name_lints, library_require_lints, bad_unload_call_lints,
#> unload_arg_name_lints))
#> }
#> <bytecode: 0x55cad08a1268>
#> <environment: 0x55cacbf2ed18>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "package_hooks_linter"
#>
#> $paren_body_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> matched_expressions <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(matched_expressions, source_expression = source_expression,
#> lint_message = "There should be a space between a right parenthesis and a body expression.")
#> }
#> <bytecode: 0x55cacecd3d00>
#> <environment: 0x55cacbe52608>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "paren_body_linter"
#>
#> $paste_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> lints <- list()
#> if (!allow_empty_sep) {
#> empty_sep_expr <- xml2::xml_find_all(xml, sep_xpath)
#> sep_value <- get_r_string(empty_sep_expr, xpath = "./SYMBOL_SUB[text() = 'sep']/following-sibling::expr[1]")
#> lints <- c(lints, xml_nodes_to_lints(empty_sep_expr[!nzchar(sep_value)],
#> source_expression = source_expression, lint_message = "paste0(...) is better than paste(..., sep = \"\").",
#> type = "warning"))
#> }
#> if (!allow_to_string) {
#> to_string_expr <- xml2::xml_find_all(xml, to_string_xpath)
#> collapse_value <- get_r_string(to_string_expr, xpath = "./SYMBOL_SUB[text() = 'collapse']/following-sibling::expr[1]")
#> lints <- c(lints, xml_nodes_to_lints(to_string_expr[collapse_value ==
#> ", "], source_expression = source_expression, lint_message = paste("toString(.) is more expressive than paste(., collapse = \", \").",
#> "Note also glue::glue_collapse() and and::and()",
#> "for constructing human-readable / translation-friendly lists"),
#> type = "warning"))
#> }
#> paste0_sep_expr <- xml2::xml_find_all(xml, paste0_sep_xpath)
#> lints <- c(lints, xml_nodes_to_lints(paste0_sep_expr, source_expression = source_expression,
#> lint_message = "sep= is not a formal argument to paste0(); did you mean to use paste(), or collapse=?",
#> type = "warning"))
#> lints
#> }
#> <bytecode: 0x55cad06ee608>
#> <environment: 0x55cacbdd2b00>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "paste_linter"
#>
#> $pipe_call_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = "Use explicit calls in magrittr pipes, i.e., `a %>% foo` should be `a %>% foo()`.",
#> type = "warning")
#> }
#> <bytecode: 0x55cad06f4ea0>
#> <environment: 0x55cacbced830>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "pipe_call_linter"
#>
#> $pipe_continuation_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> x <- source_expression$full_xml_parsed_content
#> pipe_exprs <- xml_find_all(x, multiline_pipe_test)
#> xml_nodes_to_lints(pipe_exprs, source_expression = source_expression,
#> lint_message = paste("`%>%` should always have a space before it and a new line after it,",
#> "unless the full pipeline fits on one line."), type = "style")
#> }
#> <bytecode: 0x55cacecd1f78>
#> <environment: 0x55cacbc431b8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "pipe_continuation_linter"
#>
#> $redundant_ifelse_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> lints <- list()
#> tf_expr <- xml2::xml_find_all(xml, tf_xpath)
#> matched_call <- xp_call_name(tf_expr)
#> 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)")
#> 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)
#> 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)
#> matched_call <- xp_call_name(num_expr)
#> 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)")
#> 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")
#> replacement_argument <- ifelse(is_negated, "!x", "x")
#> lint_message <- paste(sprintf("Prefer %s(%s) to %s(x, %s, %s) if really needed.",
#> coercion_function, replacement_argument, matched_call,
#> first_arg, second_arg))
#> lints <- c(lints, xml_nodes_to_lints(num_expr, source_expression,
#> lint_message, type = "warning"))
#> }
#> return(lints)
#> }
#> <bytecode: 0x55cad06fc4d0>
#> <environment: 0x55cacbbabd50>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "redundant_ifelse_linter"
#>
#> $regex_subset_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> grep_expr <- xml2::xml_find_all(xml, grep_xpath)
#> grep_lints <- xml_nodes_to_lints(grep_expr, source_expression = source_expression,
#> lint_message = "Prefer grep(pattern, x, ..., value = TRUE) over x[grep(pattern, x, ...)] and x[grepl(pattern, x, ...)].",
#> type = "warning")
#> stringr_expr <- xml2::xml_find_all(xml, stringr_xpath)
#> stringr_lints <- xml_nodes_to_lints(stringr_expr, source_expression = source_expression,
#> lint_message = "Prefer stringr::str_subset(x, pattern) over x[str_detect(x, pattern)] and x[str_which(x, pattern)].",
#> type = "warning")
#> return(c(grep_lints, stringr_lints))
#> }
#> <bytecode: 0x55cacff25d18>
#> <environment: 0x55cacbae9470>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "regex_subset_linter"
#>
#> $semicolon_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> xml <- source_expression$full_xml_parsed_content
#> bad_exprs <- xml2::xml_find_all(xml, xpath)
#> if (need_detection) {
#> is_trailing <- is.na(xml2::xml_find_first(bad_exprs,
#> compound_xpath))
#> msg <- ifelse(is_trailing, msg_trailing, msg_compound)
#> }
#> xml_nodes_to_lints(bad_exprs, source_expression = source_expression,
#> lint_message = msg)
#> }
#> <bytecode: 0x55cacecd6a30>
#> <environment: 0x55cacb105800>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "semicolon_linter"
#>
#> $seq_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> badx <- xml2::xml_find_all(xml, xpath)
#> dot_expr1 <- get_fun(badx, 1L)
#> dot_expr2 <- get_fun(badx, 2L)
#> seq_along_idx <- grepl("length(", dot_expr1, fixed = TRUE) |
#> grepl("length(", dot_expr2, fixed = TRUE)
#> replacement <- ifelse(seq_along_idx, "seq_along", "seq_len")
#> dot_expr3 <- ifelse(seq_along_idx, "...", dot_expr2)
#> lint_message <- ifelse(grepl("seq", dot_expr1, fixed = TRUE),
#> sprintf("%s(%s) is likely to be wrong in the empty edge case. Use %s(%s) instead.",
#> dot_expr1, dot_expr2, replacement, dot_expr3), sprintf("%s:%s is likely to be wrong in the empty edge case. Use %s(%s) instead.",
#> dot_expr1, dot_expr2, replacement, dot_expr3))
#> xml_nodes_to_lints(badx, source_expression, lint_message,
#> type = "warning")
#> }
#> <bytecode: 0x55cad0d36e80>
#> <environment: 0x55cacb01b398>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "seq_linter"
#>
#> $single_quotes_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> content <- source_expression$full_parsed_content
#> str_idx <- which(content$token == "STR_CONST")
#> squote_matches <- which(re_matches(content[str_idx, "text"],
#> squote_regex))
#> lapply(squote_matches, function(id) {
#> with(content[str_idx[id], ], {
#> line <- source_expression$file_lines[[line1]]
#> col2 <- if (line1 == line2)
#> col2
#> else nchar(line)
#> Lint(filename = source_expression$filename, line_number = line1,
#> column_number = col1, type = "style", message = "Only use double-quotes.",
#> line = line, ranges = list(c(col1, col2)))
#> })
#> })
#> }
#> <bytecode: 0x55cacfcc3d18>
#> <environment: 0x55cacaf18298>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "single_quotes_linter"
#>
#> $spaces_inside_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> xml <- source_expression$full_xml_parsed_content
#> left_expr <- xml2::xml_find_all(xml, left_xpath)
#> left_msg <- ifelse(xml2::xml_text(left_expr) == "[", "Do not place spaces after square brackets.",
#> "Do not place spaces after parentheses.")
#> left_lints <- xml_nodes_to_lints(left_expr, source_expression = source_expression,
#> lint_message = left_msg, range_start_xpath = "number(./@col2 + 1)",
#> range_end_xpath = "number(./following-sibling::*[1]/@col1 - 1)")
#> right_expr <- xml2::xml_find_all(xml, right_xpath)
#> right_msg <- ifelse(xml2::xml_text(right_expr) == "]", "Do not place spaces before square brackets.",
#> "Do not place spaces before parentheses.")
#> right_lints <- xml_nodes_to_lints(right_expr, source_expression = source_expression,
#> lint_message = right_msg, range_start_xpath = "number(./preceding-sibling::*[1]/@col2 + 1)",
#> range_end_xpath = "number(./@col1 - 1)")
#> c(left_lints, right_lints)
#> }
#> <bytecode: 0x55cacfb1ddb8>
#> <environment: 0x55cacaa7d130>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "spaces_inside_linter"
#>
#> $spaces_left_parentheses_linter
#> function (source_expression)
#> {
#> if (is_lint_level(source_expression, "file")) {
#> xml <- source_expression$full_xml_parsed_content
#> xpath <- file_level_xpath
#> }
#> else {
#> xml <- source_expression$xml_parsed_content
#> xpath <- expression_level_xpath
#> }
#> bad_paren <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_paren, source_expression, lint_message = "Place a space before left parenthesis, except in a function call.",
#> type = "style")
#> }
#> <bytecode: 0x55cacf4076e0>
#> <environment: 0x55caca6b8728>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "spaces_left_parentheses_linter"
#>
#> $sprintf_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> xml <- source_expression$full_xml_parsed_content
#> sprintf_calls <- xml2::xml_find_all(xml, xpath)
#> message <- vapply(sprintf_calls, capture_sprintf_warning,
#> character(1L))
#> has_message <- !is.na(message)
#> xml_nodes_to_lints(sprintf_calls[has_message], source_expression = source_expression,
#> lint_message = message[has_message], type = "warning")
#> }
#> <bytecode: 0x55cacff29090>
#> <environment: 0x55cac9805258>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "sprintf_linter"
#>
#> $string_boundary_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> lints <- list()
#> str_detect_lint_data <- get_regex_lint_data(xml, str_detect_xpath)
#> str_detect_lint_message <- paste(ifelse(str_detect_lint_data$initial_anchor,
#> "Use startsWith() to detect a fixed initial substring.",
#> "Use endsWith() to detect a fixed terminal substring."),
#> "Doing so is more readable and more efficient.")
#> lints <- c(lints, xml_nodes_to_lints(str_detect_lint_data$lint_expr,
#> source_expression = source_expression, lint_message = str_detect_lint_message,
#> type = "warning"))
#> if (!allow_grepl) {
#> grepl_lint_data <- get_regex_lint_data(xml, grepl_xpath)
#> grepl_replacement <- ifelse(grepl_lint_data$initial_anchor,
#> "startsWith", "endsWith")
#> grepl_type <- ifelse(grepl_lint_data$initial_anchor,
#> "initial", "terminal")
#> grepl_lint_message <- paste(sprintf("Use !is.na(x) & %s(x, string) to detect a fixed %s substring, or, if missingness is not a concern, just %s.",
#> grepl_replacement, grepl_type, grepl_replacement),
#> "Doing so is more readable and more efficient.")
#> lints <- c(lints, xml_nodes_to_lints(grepl_lint_data$lint_expr,
#> source_expression = source_expression, lint_message = grepl_lint_message,
#> type = "warning"))
#> }
#> 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_lint_message <- paste(ifelse(substr_one, "Use startsWith() to detect an initial substring.",
#> "Use endsWith() to detect a terminal substring."), "Doing so is more readable and more efficient.")
#> lints <- c(lints, xml_nodes_to_lints(substr_expr, source_expression,
#> substr_lint_message, type = "warning"))
#> lints
#> }
#> <bytecode: 0x55cacff2f770>
#> <environment: 0x55cac9f1bc38>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "string_boundary_linter"
#>
#> $strings_as_factors_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = paste("This code relies on the default value of stringsAsFactors,",
#> "which changed in version R 4.0. Please supply an explicit value for",
#> "stringsAsFactors for this code to work with versions of R both before",
#> "and after this switch."), type = "warning")
#> }
#> <bytecode: 0x55cacff385e0>
#> <environment: 0x55cac8d8a208>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "strings_as_factors_linter"
#>
#> $system_file_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> outer_call <- xp_call_name(bad_expr)
#> lint_message <- paste("Use the `...` argument of system.file() to expand paths,",
#> "e.g. system.file(\"data\", \"model.csv\", package = \"myrf\") instead of",
#> ifelse(outer_call == "system.file", "system.file(file.path(\"data\", \"model.csv\"), package = \"myrf\")",
#> "file.path(system.file(package = \"myrf\"), \"data\", \"model.csv\")"))
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message,
#> type = "warning")
#> }
#> <bytecode: 0x55cacff3a228>
#> <environment: 0x55cace7a1e58>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "system_file_linter"
#>
#> $T_and_F_symbol_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> 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)
#> make_lints <- function(expr, fmt) {
#> symbol <- xml2::xml_text(expr)
#> lint_message <- sprintf(fmt, replacement_map[symbol],
#> symbol)
#> xml_nodes_to_lints(xml = expr, source_expression = source_expression,
#> lint_message = lint_message, type = "style", column_number_xpath = "number(./@col2 + 1)",
#> range_end_xpath = "number(./@col2 + 1)")
#> }
#> c(make_lints(bad_exprs, "Use %s instead of the symbol %s."),
#> make_lints(bad_assigns, "Don't use %2$s as a variable name, as it can break code relying on %2$s being %1$s."))
#> }
#> <bytecode: 0x55cacf40c2e8>
#> <environment: 0x55cace170f88>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "T_and_F_symbol_linter"
#>
#> $todo_comment_linter
#> function (source_expression)
#> {
#> tokens <- with_id(source_expression, ids_with_token(source_expression,
#> "COMMENT"))
#> are_todo <- re_matches(tokens[["text"]], todo_comment_regex,
#> ignore.case = TRUE)
#> tokens <- tokens[are_todo, ]
#> lapply(split(tokens, seq_len(nrow(tokens))), function(token) {
#> Lint(filename = source_expression[["filename"]], line_number = token[["line1"]],
#> column_number = token[["col1"]], type = "style",
#> message = "TODO comments should be removed.", line = source_expression[["lines"]][[as.character(token[["line1"]])]],
#> ranges = list(c(token[["col1"]], token[["col2"]])))
#> })
#> }
#> <bytecode: 0x55cacff3eca8>
#> <environment: 0x55cace724930>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "todo_comment_linter"
#>
#> $trailing_blank_lines_linter
#> function (source_expression)
#> {
#> blanks <- re_matches(source_expression$file_lines, rex(start,
#> any_spaces, end))
#> line_number <- length(source_expression$file_lines)
#> lints <- list()
#> while (line_number > 0L && (is.na(blanks[[line_number]]) ||
#> isTRUE(blanks[[line_number]]))) {
#> if (!is.na(blanks[[line_number]])) {
#> lints[[length(lints) + 1L]] <- Lint(filename = source_expression$filename,
#> line_number = line_number, column_number = 1L,
#> type = "style", message = "Trailing blank lines are superfluous.",
#> line = source_expression$file_lines[[line_number]])
#> }
#> line_number <- line_number - 1L
#> }
#> if (identical(source_expression$terminal_newline, FALSE)) {
#> last_line <- tail(source_expression$file_lines, 1L)
#> lints[[length(lints) + 1L]] <- Lint(filename = source_expression$filename,
#> line_number = length(source_expression$file_lines),
#> column_number = nchar(last_line) %||% 0L + 1L, type = "style",
#> message = "Missing terminal newline.", line = last_line)
#> }
#> lints
#> }
#> <bytecode: 0x55cad052ddc0>
#> <environment: 0x55cad0c8c010>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "trailing_blank_lines_linter"
#>
#> $trailing_whitespace_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> res <- re_matches(source_expression$file_lines, rex(blanks,
#> end), locations = TRUE)
#> if (isTRUE(allow_empty_lines)) {
#> bad_lines <- which(res$start > 1L)
#> }
#> else {
#> bad_lines <- which(!is.na(res$start))
#> }
#> 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"))
#> is_in_str <- vapply(bad_lines, function(ln) {
#> any(start_lines <= ln & ln < end_lines)
#> }, logical(1L))
#> bad_lines <- bad_lines[!is_in_str]
#> }
#> lapply(bad_lines, function(line) {
#> Lint(filename = source_expression$filename, line_number = line,
#> column_number = res$start[[line]], type = "style",
#> message = "Trailing whitespace is superfluous.",
#> line = source_expression$file_lines[[line]], ranges = list(c(res$start[[line]],
#> res$end[[line]])))
#> })
#> }
#> <bytecode: 0x55cacf3fd168>
#> <environment: 0x55cace9dc608>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "trailing_whitespace_linter"
#>
#> $undesirable_function_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> matched_nodes <- xml2::xml_find_all(source_expression$xml_parsed_content,
#> xpath)
#> fun_names <- get_r_string(matched_nodes)
#> msgs <- vapply(stats::setNames(nm = unique(fun_names)), function(fun_name) {
#> msg <- sprintf("Function \"%s\" is undesirable.", fun_name)
#> alternative <- fun[[fun_name]]
#> if (!is.na(alternative)) {
#> msg <- paste(msg, sprintf("As an alternative, %s.",
#> alternative))
#> }
#> msg
#> }, character(1L))
#> xml_nodes_to_lints(matched_nodes, source_expression = source_expression,
#> lint_message = unname(msgs[fun_names]))
#> }
#> <bytecode: 0x55cacff417e0>
#> <environment: 0x55cacfb2e7a0>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "undesirable_function_linter"
#>
#> $undesirable_operator_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_op <- xml2::xml_find_all(xml, xpath)
#> operator <- xml2::xml_text(bad_op)
#> lint_message <- sprintf("Operator `%s` is undesirable.",
#> operator)
#> alternative <- op[operator]
#> has_alternative <- !is.na(alternative)
#> lint_message[has_alternative] <- paste(lint_message[has_alternative],
#> alternative[has_alternative])
#> xml_nodes_to_lints(bad_op, source_expression, lint_message,
#> type = "warning")
#> }
#> <bytecode: 0x55cacff4c030>
#> <environment: 0x55cacf796ce8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "undesirable_operator_linter"
#>
#> $unneeded_concatenation_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> c_calls <- xml2::xml_find_all(xml, xpath_call)
#> 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)))
#> is_unneeded <- num_args <= 1L
#> c_calls <- c_calls[is_unneeded]
#> 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))
#> msg[is_single_expression] <- msg_const_expr
#> }
#> xml_nodes_to_lints(c_calls, source_expression = source_expression,
#> lint_message = msg)
#> }
#> <bytecode: 0x55cacff50d60>
#> <environment: 0x55cacfbcd500>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "unneeded_concatenation_linter"
#>
#> $unreachable_code_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::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)
#> xml_nodes_to_lints(bad_expr[!is_nolint_end_comment], source_expression = source_expression,
#> lint_message = "Code and comments coming after a top-level return() or stop() should be removed.",
#> type = "warning")
#> }
#> <bytecode: 0x55cacff54cf0>
#> <environment: 0x55cacf7678d0>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "unreachable_code_linter"
#>
#> $unused_import_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "file")) {
#> return(list())
#> }
#> xml <- source_expression$full_xml_parsed_content
#> import_exprs <- xml2::xml_find_all(xml, import_xpath)
#> if (length(import_exprs) == 0L) {
#> return(list())
#> }
#> imported_pkgs <- xml2::xml_find_chr(import_exprs, "string(expr[STR_CONST|SYMBOL])")
#> imported_pkgs <- as.character(parse(text = imported_pkgs,
#> keep.source = FALSE))
#> used_symbols <- xml2::xml_text(xml2::xml_find_all(xml, xp_used_symbols))
#> is_used <- vapply(imported_pkgs, function(pkg) {
#> if (pkg %in% except_packages || !requireNamespace(pkg,
#> quietly = TRUE)) {
#> return(TRUE)
#> }
#> package_exports <- getNamespaceExports(pkg)
#> any(package_exports %in% used_symbols)
#> }, logical(1L))
#> is_ns_used <- vapply(imported_pkgs, function(pkg) {
#> ns_usage <- xml2::xml_find_first(xml, paste0("//SYMBOL_PACKAGE[text() = '",
#> pkg, "']"))
#> !identical(ns_usage, xml2::xml_missing())
#> }, logical(1L))
#> is_unused <- !is_used
#> if (allow_ns_usage) {
#> is_unused[is_ns_used] <- FALSE
#> }
#> import_exprs <- import_exprs[is_unused]
#> unused_packages <- get_r_string(import_exprs, xpath = "expr[STR_CONST | SYMBOL]")
#> lint_message <- ifelse(is_ns_used[is_unused][unused_packages],
#> paste0("Package '", unused_packages, "' is only used by namespace. ",
#> "Check that it is installed using loadNamespace() instead."),
#> paste0("Package '", unused_packages, "' is attached but never used."))
#> xml_nodes_to_lints(import_exprs, source_expression, lint_message,
#> type = "warning")
#> }
#> <bytecode: 0x55cacff5b118>
#> <environment: 0x55cacfe4e908>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "unused_import_linter"
#>
#> $vector_logic_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> xml_nodes_to_lints(bad_expr, source_expression = source_expression,
#> lint_message = "Conditional expressions require scalar logical operators (&& and ||)",
#> type = "warning")
#> }
#> <bytecode: 0x55cacf403718>
#> <environment: 0x55cacfab4d90>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "vector_logic_linter"
#>
#> $yoda_test_linter
#> function (source_expression)
#> {
#> if (!is_lint_level(source_expression, "expression")) {
#> return(list())
#> }
#> xml <- source_expression$xml_parsed_content
#> bad_expr <- xml2::xml_find_all(xml, xpath)
#> matched_call <- xp_call_name(bad_expr)
#> second_const <- xml2::xml_find_first(bad_expr, second_const_xpath)
#> lint_message <- ifelse(is.na(second_const), paste("Tests should compare objects in the order 'actual', 'expected', not the reverse.",
#> sprintf("For example, do %1$s(foo(x), 2L) instead of %1$s(2L, foo(x)).",
#> matched_call)), sprintf("Avoid storing placeholder tests like %s(1, 1)",
#> matched_call))
#> xml_nodes_to_lints(bad_expr, source_expression, lint_message,
#> type = "warning")
#> }
#> <bytecode: 0x55cad08a9690>
#> <environment: 0x55caceccf8d8>
#> attr(,"class")
#> [1] "linter" "function"
#> attr(,"name")
#> [1] "yoda_test_linter"
#>
# Get all linters tagged as "default" from lintr and mypkg
if (FALSE) linters_with_tags("default", packages = c("lintr", "mypkg"))