Lint non-stable lifecycle functions used in your code.

lifecycle_linter.R

db_lifecycles <- function(db) {
  lifecycle_patterns <- paste0("(?:",
    paste(collapse = "|",
      c("lifecycle::badge\\([\\\\]\"",
        "rlang:::lifecycle\\([\\\\]\"",
        "list\\(\"lifecycle-",
        "https://www.tidyverse.org/lifecycle/#"
      )),
    ")([\\w-]+)"
  )

  desc <- lapply(db, tools:::.Rd_get_metadata, "description")
  lapply(desc, function(x) {
    rematch2::re_match(x, lifecycle_patterns)[[1]]
  })
}

db_functions <- function(db) {
  usage <- lapply(db, tools:::.Rd_get_section, "usage")
  lapply(usage, get_rcode)
}

pkg_function_lifecycles <- function(pkg) {
  db <- tools::Rd_db(pkg)
  lc <- db_lifecycles(db)
  funs <- db_functions(db)

  res <- mapply(function(lc, f) list(fun = f, lifecycle = rep(lc, length(f))), lc, funs, SIMPLIFY = FALSE)

  do.call(rbind.data.frame, c(res, make.row.names = FALSE))
}

get_rcode <- function(x) {
  if (!length(x)) {
    character(1)
  } else {
    res <- tools:::.parse_usage_as_much_as_possible(x)
    vapply(res, function(x) {
      if (is.call(x)) as.character(x[[1]]) else character(1)
    }, character(1))
  }
}

tidyverse_lifecycles <- function(which) {
  pkgs <- purrr::set_names(tidyverse::tidyverse_packages())

  # Get function lifecycles
  res <- purrr::map_dfr(pkgs, pkg_function_lifecycles, .id = "package")

  # Filter funs without a lifecycle
  res <- na.omit(res)

  # Filter funs without a function name
  res <- res[nzchar(res$fun), ]

  # Filter method definitions
  res <- res[grep("[\\\\]method\\{", res$fun, invert = TRUE), ]

  # filter lifecycles not in which
  res[res$lifecycle %in% which, ]
}


# pak::pak("jimhester/lintr")
#' @param path The path to the files you want to search
#' @param which The lifecycle stages you want to lint
lint_tidyverse_lifecycle <- function(path, which = c("superseded", "deprecated", "questioning", "defunct", "experimental", "soft-deprecated", "retired")) {
  which <- match.arg(which, several.ok = TRUE)
  lc <- tidyverse_lifecycles(which)
  funs <- lc$fun
  msgs <- sprintf("`%s::%s` is %s", lc$package, lc$fun, lc$lifecycle)

  lifecycle_linter <- lintr::Linter(function(source_file) {
    lapply(
      lintr::ids_with_token(source_file, "SYMBOL_FUNCTION_CALL", fun = `%in%`),
      function(id) {
        token <- lintr::with_id(source_file, id)
        fun_name <- token[["text"]]
        if (fun_name %in% funs) {
          line_num <- token[["line1"]]
          start_col_num <- token[["col1"]]
          end_col_num <- token[["col2"]]
          msg <- msgs[fun_name == funs]
          lintr::Lint(
            filename = source_file[["filename"]],
            line_number = line_num,
            column_number = start_col_num,
            type = "warning",
            message = msg,
            line = source_file[["lines"]][[as.character(line_num)]],
            ranges = list(c(start_col_num, end_col_num))
          )
        }
      }
    )
  }, name = "lifecycle_linter")

  lintr::lint_dir(path = path, linters = lifecycle_linter)
}