customize lint message in literal_coercion_linter() (#1722)

* customize lint message in literal_coercion_linter()

* edit .lintr for new backports

* move rlang usage to soft dependency

* also accommodate in tests

* move test into suggested region

* remove redundant equal-assign

* further handling of non-attached rlang case

* scalar logical operator

* mention TODO

* onload typo

* reference correct linter in TODO comment

* separate string to evaluate from string to report

* expand NEWS item

Co-authored-by: AshesITR <alexander.rosenstock@web.de>

.lintr

@@ -1,7 +1,7 @@
 linters: linters_with_defaults(
    line_length_linter(120),
    implicit_integer_linter(),
-   backport_linter("oldrel-4", except = c("R_user_dir", "str2lang"))
+   backport_linter("oldrel-4", except = c("R_user_dir", "str2lang", "str2expression", "deparse1"))
  )
 exclusions: list(
   "inst/doc/creating_linters.R" = 1,

.lintr_new

@@ -1,7 +1,7 @@
 linters: linters_with_defaults(
     any_duplicated_linter(),
     any_is_na_linter(),
-    backport_linter("oldrel-4", except = c("R_user_dir", "str2lang")),
+    backport_linter("oldrel-4", except = c("R_user_dir", "str2lang", "str2expression", "deparse1")),
     consecutive_stopifnot_linter(),
     expect_comparison_linter(),
     expect_length_linter(),

DESCRIPTION

@@ -43,6 +43,7 @@ Suggests:
     mockery,
     patrick,
     pkgdown,
+    rlang,
     rmarkdown,
     rstudioapi (>= 0.2),
     testthat (>= 3.0.0),

NEWS.md

@@ -64,6 +64,9 @@
 
 * `object_name_linter()` gains parameter `regexes` to allow custom naming conventions (#822, #1421, @AshesITR)
 
+* `literal_coercion_linter()` reports a replacement in the lint message, e.g. code like `as.integer(1)` will
+  suggest using `1L` instead, and code like `as.numeric(NA)` will suggest using `NA_real_` instead (#1439, @MichaelChirico)
+
 ### New linters
 
 * `unnecessary_lambda_linter()`: detect unnecessary lambdas (anonymous functions), e.g.

R/literal_coercion_linter.R

@@ -45,14 +45,12 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 literal_coercion_linter <- function() {
-  coercers <- xp_text_in_table(
-    c(
-      # base coercers
-      paste0("as.", c("logical", "integer", "numeric", "double", "character")),
-      # rlang coercers
-      c("lgl", "int", "dbl", "chr")
-    )
-  )
+  rlang_coercers <- c("lgl", "int", "dbl", "chr")
+  coercers <- xp_text_in_table(c(
+    # base coercers
+    paste0("as.", c("logical", "integer", "numeric", "double", "character")),
+    rlang_coercers
+  ))
 
   # notes for clarification:
   #  - as.integer(1e6) is arguably easier to read than 1000000L
@@ -84,13 +82,40 @@ literal_coercion_linter <- function() {
 
     bad_expr <- xml2::xml_find_all(xml, xpath)
 
+    coercer <- xp_call_name(bad_expr)
+    # tiptoe around the fact that we don't require {rlang}
+    is_rlang_coercer <- coercer %in% rlang_coercers
+    if (any(is_rlang_coercer) && !requireNamespace("rlang", quietly = TRUE)) {
+      # NB: we _could_ do some extreme customization where each lint
+      #   gets a message according to whether the coercer is from rlang,
+      #   but this seems like overkill. Just use a generic message and move on.
+      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).",
+        "NB: this message can be improved to show a specific replacement if 'rlang' is installed."
+      )
+    } else {
+      # duplicate, unless we add 'rlang::' and it wasn't there originally
+      coercion_str <- report_str <- xml2::xml_text(bad_expr)
+      if (any(is_rlang_coercer) && !("package:rlang" %in% search())) {
+        needs_prefix <- is_rlang_coercer & !startsWith(coercion_str, "rlang::")
+        coercion_str[needs_prefix] <- paste0("rlang::", coercion_str[needs_prefix])
+      }
+      # the linter logic & rlang requirement should ensure that it's safe to run eval() here
+      # TODO(michaelchirico): this recommends '1' to replace as.numeric(1), where our
+      #   own implicit_integer_linter(), if active, would require this to be 1.0. Should
+      #   we recommend this instead, or offer it as an alternative?
+      literal_equivalent_str <- vapply(str2expression(coercion_str), function(expr) deparse1(eval(expr)), character(1L))
+      lint_message <- sprintf(
+        "Use %s instead of %s, i.e., use literals directly where possible, instead of coercion.",
+        literal_equivalent_str, report_str
+      )
+    }
+
     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)."
-      ),
+      lint_message = lint_message,
       type = "warning"
     )
   })

R/zzz.R

@@ -283,10 +283,15 @@ settings <- NULL
   toset <- !(names(op_lintr) %in% names(op))
   if (any(toset)) options(op_lintr[toset])
 
-  backports::import(pkgname, c("trimws", "lengths"))
+  backports::import(pkgname, c("trimws", "lengths", "deparse1"))
   # requires R>=3.6.0; see https://github.com/r-lib/backports/issues/68
-  if (!exists("str2lang", getNamespace("base"))) {
-    assign("str2lang", get("str2lang", getNamespace("backports")), getNamespace(pkgname))
+  base_ns <- getNamespace("base")
+  backports_ns <- getNamespace("backports")
+  lintr_ns <- getNamespace(pkgname)
+  for (base_fun in c("str2lang", "str2expression")) {
+    if (!exists(base_fun, base_ns)) {
+      assign(base_fun, get(base_fun, backports_ns), lintr_ns)
+    }
   }
 
   default_settings <<- list(

tests/testthat/test-literal_coercion_linter.R

@@ -35,59 +35,72 @@ test_that("literal_coercion_linter skips allowed rlang usages", {
   expect_lint("int(1.0e6)", NULL, linter)
 })
 
+test_that("literal_coercion_linter skips quoted keyword arguments", {
+  expect_lint("as.numeric(foo('a' = 1))", NULL, literal_coercion_linter())
+})
+
 skip_if_not_installed("tibble")
 patrick::with_parameters_test_that(
   "literal_coercion_linter blocks simple disallowed usages",
   expect_lint(
     sprintf("as.%s(%s)", out_type, input),
-    rex::rex("Use literals directly where possible, instead of coercion."),
+    lint_msg,
     literal_coercion_linter()
   ),
   .cases = tibble::tribble(
-    ~.test_name,     ~out_type,   ~input,
-    "lgl, from int", "logical",   "1L",
-    "lgl, from num", "logical",   "1",
-    "lgl, from chr", "logical",   '"true"',
-    "int, from num", "integer",   "1",
-    "num, from num", "numeric",   "1",
-    "dbl, from num", "double",    "1",
-    "chr, from num", "character", "1",
-    "chr, from chr", "character", '"e"',
-    "chr, from chr", "character", '"E"',
+    ~.test_name,     ~out_type,   ~input,   ~lint_msg,
+    "lgl, from int", "logical",   "1L",     rex::rex("Use TRUE instead of as.logical(1L)"),
+    "lgl, from num", "logical",   "1",      rex::rex("Use TRUE instead of as.logical(1)"),
+    "lgl, from chr", "logical",   '"true"', rex::rex('Use TRUE instead of as.logical("true")'),
+    "int, from num", "integer",   "1",      rex::rex("Use 1L instead of as.integer(1)"),
+    "num, from num", "numeric",   "1",      rex::rex("Use 1 instead of as.numeric(1)"),
+    "dbl, from num", "double",    "1",      rex::rex("Use 1 instead of as.double(1)"),
+    "chr, from num", "character", "1",      rex::rex('Use "1" instead of as.character(1)'),
+    "chr, from chr", "character", '"e"',    rex::rex('Use "e" instead of as.character("e")'),
+    "chr, from chr", "character", '"E"',    rex::rex('Use "E" instead of as.character("E")'),
     # affirmatively lint as.<type>(NA) should be NA_<type>_
-    "int, from NA",  "integer",   "NA",
-    "num, from NA",  "numeric",   "NA",
-    "dbl, from NA",  "double",    "NA",
-    "chr, from NA",  "character", "NA"
+    "int, from NA",  "integer",   "NA",     rex::rex("Use NA_integer_ instead of as.integer(NA)"),
+    "num, from NA",  "numeric",   "NA",     rex::rex("Use NA_real_ instead of as.numeric(NA)"),
+    "dbl, from NA",  "double",    "NA",     rex::rex("Use NA_real_ instead of as.double(NA)"),
+    "chr, from NA",  "character", "NA",     rex::rex("Use NA_character_ instead of as.character(NA)")
   )
 )
 
+skip_if_not_installed("rlang")
+test_that("multiple lints return custom messages", {
+  expect_lint(
+    "c(as.integer(1), lgl(1L))",
+    list(
+      rex::rex("Use 1L instead of as.integer(1)"),
+      rex::rex("Use TRUE instead of lgl(1L)")
+    ),
+    literal_coercion_linter()
+  )
+})
+
 patrick::with_parameters_test_that(
   "literal_coercion_linter blocks rlang disallowed usages",
   expect_lint(
     sprintf("%s(%s)", out_type, input),
-    rex::rex("Use literals directly where possible, instead of coercion."),
+    lint_msg,
     literal_coercion_linter()
   ),
   # even if `as.character(1)` works, `chr(1)` doesn't, so no corresponding test case
   .cases = tibble::tribble(
-    ~.test_name,  ~out_type, ~input,
-    "rlang::lgl", "lgl",     "1L",
-    "rlang::int", "int",     "1.0",
-    "rlang::dbl", "dbl",     "1L",
-    "rlang::chr", "chr",     '"e"',
-    "rlang::chr", "chr",     '"E"'
+    ~.test_name,      ~out_type,    ~input, ~lint_msg,
+    "rlang::lgl",     "lgl",        "1L",   rex::rex("Use TRUE instead of lgl(1L)"),
+    "rlang::lgl[ns]", "rlang::lgl", "1L",   rex::rex("Use TRUE instead of rlang::lgl(1L)"),
+    "rlang::int",     "int",        "1.0",  rex::rex("Use 1L instead of int(1.0)"),
+    "rlang::dbl",     "dbl",        "1L",   rex::rex("Use 1 instead of dbl(1L)"),
+    "rlang::chr",     "chr",        '"e"',  rex::rex('Use "e" instead of chr("e")'),
+    "rlang::chr",     "chr",        '"E"',  rex::rex('Use "E" instead of chr("E")')
   )
 )
 
 test_that("literal_coercion_linter blocks scalar rlang list2 construction", {
   expect_lint(
     "int(1, )",
-    "Use literals directly where possible, instead of coercion.",
+    rex::rex("Use 1L instead of int(1,)"),
     literal_coercion_linter()
   )
 })
-
-test_that("literal_coercion_linter skips quoted keyword arguments", {
-  expect_lint("as.numeric(foo('a' = 1))", NULL, literal_coercion_linter())
-})