keyword_quote_linter for unnecessary quoting (#2030)

Author: MichaelChirico

DESCRIPTION

@@ -113,6 +113,7 @@ Collate:
     'inner_combine_linter.R'
     'is_lint_level.R'
     'is_numeric_linter.R'
+    'keyword_quote_linter.R'
     'length_levels_linter.R'
     'lengths_linter.R'
     'library_call_linter.R'

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(length_levels_linter)
 export(lengths_linter)
 export(library_call_linter)
@@ -163,4 +164,5 @@ importFrom(xml2,xml_find_all)
 importFrom(xml2,xml_find_chr)
 importFrom(xml2,xml_find_first)
 importFrom(xml2,xml_find_num)
+importFrom(xml2,xml_name)
 importFrom(xml2,xml_text)

NEWS.md

@@ -25,6 +25,7 @@
 
 ### New linters
 
+* `keyword_quote_linter()` for finding unnecessary or discouraged quoting of symbols in assignment, function arguments, or extraction (part of #884, @MichaelChirico). Quoting is unnecessary when the target is a valid R name, e.g. `c("a" = 1)` can be `c(a = 1)`. The same goes to assignment (`"a" <- 1`) and extraction (`x$"a"`). Where quoting is necessary, the linter encourages doing so with backticks (e.g. `` x$`a b` `` instead of `x$"a b"`).
 * `length_levels_linter()` for using the specific function `nlevels()` instead of checking `length(levels(x))` (part of #884, @MichaelChirico).
 
 ## Changes to defaults

R/keyword_quote_linter.R

@@ -0,0 +1,166 @@
+#' 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.
+#'
+#' Similar reasoning applies to extractions with `$` or `@`.
+#'
+#' @examples
+#' # will produce lints
+#' lint(
+#'   text = 'data.frame("a" = 1)',
+#'   linters = keyword_quote_linter()
+#' )
+#'
+#' lint(
+#'   text = "data.frame(`a` = 1)",
+#'   linters = keyword_quote_linter()
+#' )
+#'
+#' lint(
+#'   text = 'my_list$"key"',
+#'   linters = keyword_quote_linter()
+#' )
+#'
+#' lint(
+#'   text = 's4obj@"key"',
+#'   linters = keyword_quote_linter()
+#' )
+#'
+#' # okay
+#' lint(
+#'   text = "data.frame(`a b` = 1)",
+#'   linters = keyword_quote_linter()
+#' )
+#'
+#' lint(
+#'   text = 'my_list$`a b`',
+#'   linters = keyword_quote_linter()
+#' )
+#'
+#' @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_candidate_cond <- "
+    not(OP-DOLLAR or OP-AT)
+    and (STR_CONST or SYMBOL[starts-with(text(), '`')])
+  "
+  assignment_xpath <- glue("
+  (//EQ_ASSIGN | //LEFT_ASSIGN[text() != ':='])
+    /preceding-sibling::expr[{ assignment_candidate_cond }]
+  | //RIGHT_ASSIGN/following-sibling::expr[{ assignment_candidate_cond }]
+  ")
+
+  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(), '`')]
+  "
+
+  no_quote_msg <- "Use backticks to create non-syntactic names, not quotes."
+  clarification <- "i.e., if the name is not a valid R symbol (see ?make.names)."
+
+  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 = paste("Only quote named arguments to functions if necessary,", clarification),
+      type = "warning"
+    )
+
+    assignment_expr <- xml_find_all(xml, assignment_xpath)
+
+    invalid_assignment_quoting <- is_valid_r_name(get_r_string(assignment_expr))
+    # NB: XPath is such that there is exactly 1 node per match, making xml_children() ideal.
+    #   xml_child() gets it wrong for 0 (an error) and >1 match.
+    assignment_to_string <- xml_name(xml2::xml_children(assignment_expr)) == "STR_CONST"
+
+    string_assignment_lints <- xml_nodes_to_lints(
+      assignment_expr[assignment_to_string & !invalid_assignment_quoting],
+      source_expression = source_expression,
+      lint_message = no_quote_msg,
+      type = "warning"
+    )
+
+    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,", clarification),
+      type = "warning"
+    )
+
+    extraction_expr <- xml_find_all(xml, extraction_xpath)
+
+    invalid_extraction_quoting <- is_valid_r_name(get_r_string(extraction_expr))
+    extraction_of_string <- xml_name(extraction_expr) == "STR_CONST"
+
+    string_extraction_lints <- xml_nodes_to_lints(
+      extraction_expr[extraction_of_string & !invalid_extraction_quoting],
+      source_expression = source_expression,
+      lint_message = no_quote_msg,
+      type = "warning"
+    )
+
+    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,
+      source_expression = source_expression,
+      lint_message = paste(
+        "Only quote targets of extraction with", extractor, "if necessary,", clarification,
+        "Use backticks to create non-syntactic names, or use", gen_extractor, "to extract by string."
+      ),
+      type = "warning"
+    )
+
+    c(call_arg_lints, string_assignment_lints, assignment_lints, string_extraction_lints, extraction_lints)
+  })
+}
+
+#' Check if a string could be assigned as an R variable.
+#'
+#' See [make.names()] for the description of syntactically valid names in R.
+#'
+#' @noRd
+is_valid_r_name <- function(x) make.names(x) == x

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_attr 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_name xml_text as_list
 #' @importFrom cyclocomp cyclocomp
 #' @importFrom utils tail
 #' @rawNamespace

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
 length_levels_linter,readability best_practices consistency
 lengths_linter,efficiency readability best_practices
 library_call_linter,style best_practices readability