except_regex argument for todo_comment_linter() to skip valid TODO comments

NEWS.md

@@ -41,6 +41,7 @@
 * `unreachable_code_linter()` has an argument `allow_comment_regex` for customizing which "terminal" comments to exclude (#2327, @MichaelChirico). `# nolint end` comments are always excluded, as are {covr} exclusions (e.g. `# nocov end`) by default.
 * `format()` and `print()` methods for `lint` and `lints` classes get a new option `width` to control the printing width of lint messages (#1884, @MichaelChirico). The default is controlled by a new option `lintr.format_width`; if unset, no wrapping occurs (matching earlier behavior).
 * New function node caching for big efficiency gains to most linters (e.g. overall `lint_package()` improvement of 14-27% and core linting improvement up to 30%; #2357, @AshesITR). Most linters are written around function usage, and XPath performance searching for many functions is poor. The new `xml_find_function_calls()` entry in the `get_source_expressions()` output caches all function call nodes instead. See the vignette on creating linters for more details on how to use it.
+* `todo_comment_linter()` has a new argument `except_regex` for setting _valid_ TODO comments, e.g. for forcing TODO comments to be linked to GitHub issues like `TODO(#154)` (#2047, @MichaelChirico).
 
 ### New linters
 

R/todo_comment_linter.R

@@ -2,7 +2,9 @@
 #'
 #' Check that the source contains no TODO comments (case-insensitive).
 #'
-#' @param todo Vector of strings that identify TODO comments.
+#' @param todo Vector of case-insensitive strings that identify TODO comments.
+#' @param except_regex Vector of case-sensitive regular expressions that identify
+#'    _valid_ TODO comments.
 #'
 #' @examples
 #' # will produce lints
@@ -21,6 +23,11 @@
 #'   linters = todo_comment_linter(todo = c("todo", "fixme", "hack"))
 #' )
 #'
+#' lint(
+#'   text = "x <- TRUE # TODO(#1234): Fix this hack.",
+#'   linters = todo_comment_linter()
+#' )
+#'
 #' # okay
 #' lint(
 #'   text = "x + y # my informative comment",
@@ -37,28 +44,34 @@
 #'   linters = todo_comment_linter()
 #' )
 #'
+#' lint(
+#'   text = "x <- TRUE # TODO(#1234): Fix this hack.",
+#'   linters = todo_comment_linter(exclude_regex = "TODO\\(#[0-9]+\\):")
+#' )
+#'
 #' @evalRd rd_tags("todo_comment_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
-todo_comment_linter <- function(todo = c("todo", "fixme")) {
+todo_comment_linter <- function(todo = c("todo", "fixme"), except_regex = NULL) {
   todo_comment_regex <- rex(one_or_more("#"), any_spaces, or(todo))
-  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 = "Remove TODO comments.",
-          line = source_expression[["lines"]][[as.character(token[["line1"]])]],
-          ranges = list(c(token[["col1"]], token[["col2"]]))
-        )
-      }
+  valid_todo_regex <-
+    if (!is.null(except_regex)) paste0("#+", rex::shortcuts$any_spaces, "(?:", paste(except_regex, collapse = "|"), ")")
+
+  Linter(linter_level = "file", function(source_expression) {
+    xml <- source_expression$full_xml_parsed_content
+
+    comment_expr <- xml_find_all(xml, "//COMMENT")
+    comment_text <- xml_text(comment_expr)
+    invalid_todo <- re_matches(comment_text, todo_comment_regex, ignore.case = TRUE)
+    if (!is.null(valid_todo_regex)) {
+      invalid_todo <- invalid_todo & !re_matches(comment_text, valid_todo_regex)
+    }
+
+    xml_nodes_to_lints(
+      comment_expr[invalid_todo],
+      source_expression = source_expression,
+      lint_message = "Remove TODO comments.",
+      type = "style"
     )
   })
 }

tests/testthat/test-todo_comment_linter.R

@@ -2,7 +2,7 @@ test_that("returns the correct linting", {
   linter <- todo_comment_linter(todo = c("todo", "fixme"))
   lint_msg <- rex::rex("Remove TODO comments.")
 
-  expect_lint("a <- \"you#need#to#fixme\"", NULL, linter)
+  expect_lint('a <- "you#need#to#fixme"', NULL, linter)
   expect_lint("# something todo", NULL, linter)
   expect_lint(
     "cat(x) ### fixme",
@@ -15,11 +15,46 @@ test_that("returns the correct linting", {
     linter
   )
   expect_lint(
-    "function() {\n# TODO\n  function() {\n  # fixme\n  }\n}",
+    trim_some("
+      function() {
+        # TODO
+        function() {
+          # fixme
+        }
+      }
+    "),
     list(
-      list(message = lint_msg, line_number = 2L, column_number = 1L),
-      list(message = lint_msg, line_number = 4L, column_number = 3L)
+      list(message = lint_msg, line_number = 2L, column_number = 3L),
+      list(message = lint_msg, line_number = 4L, column_number = 5L)
     ),
     linter
   )
 })
+
+test_that("except_regex= excludes valid TODO", {
+  linter <- todo_comment_linter(except_regex = "TODO\\(#[0-9]+\\):")
+  lint_msg <- rex::rex("Remove TODO comments.")
+
+  expect_lint("foo() # TODO(#1234): Deprecate foo.", NULL, linter)
+  # Non-excepted lints
+  expect_lint(
+    trim_some("
+      foo() # TODO()
+      bar() # TODO(#567): Deprecate bar.
+    "),
+    list(lint_msg, line_number = 1L),
+    linter
+  )
+  # Only TODO() is excepted
+  mixed_lines <- trim_some("
+    foo() # TODO(#1234): Deprecate foo.
+    bar() # fixme(#567): Deprecate bar.
+  ")
+
+  expect_lint(mixed_lines, list(lint_msg, line_number = 2L), linter)
+  expect_lint(
+    mixed_lines,
+    NULL,
+    todo_comment_linter(except_regex = c("TODO\\(#[0-9]+\\):", "fixme\\(#[0-9]+\\):"))
+  )
+})