R/check_documentation.R

In inbo/checklist: A Thorough and Strict Set of Checks for R Packages and Source Code

#' Check the documentation
#'
#' The function make sure that the documentation is up to date.
#' Rules:
#' - You must use [`roxygen2`](https://roxygen2.r-lib.org) to document the
#'   functions.
#' - If you use a `README.Rmd`, it should be rendered.
#'   You need at least a `README.md`.
#' - Don't use a `NEWS.Rmd` but a `NEWS.md`.
#' - `NEWS.md` must contain an entry for the current package version.
#'
#' @details
#'
#' The function generates the help files from the `roxygen2` tag in the R code.
#' Then it checks whether any of the help files changed.
#' We use the same principle with the `README.Rmd`.
#' If any file changed, the documentation does not match the code.
#' Hence `check_documentation()` returns an error.
#'
#' A side effect of running `check_documentation()` locally, is that it
#' generates all the documentation.
#' So the only thing left for you to do, is to commit these changes.
#' Pro tip: make sure RStudio renders the `roxygen2` tags whenever you install
#' and restart the package.
#' We describe this in `vignette("getting_started")` under "Prepare local
#' setup".
#'
#' @section Required format for `NEWS.md`:
#'
#' ```
#' # package_name version
#'
#' * Description of something that changed.
#' * Lines should not exceed 80 characters.
#'   Start a new line with two space to continue an item.
#' * Add a single blank line before and after each header.
#'
#' ## Second level heading
#'
#' * You can use second level headings when you want to add more structure.
#'
#'  # `package_name` version
#'
#'  * Adding back ticks around the package name is allowed.
#' ```
#' @inheritParams read_checklist
#' @inheritParams rcmdcheck::rcmdcheck
#' @export
#' @importFrom devtools build_readme document
#' @importFrom fs is_file path
#' @importFrom gert git_status
#' @importFrom utils data
#' @family package
check_documentation <- function(x = ".", quiet = FALSE) {
  assert_that(is.flag(quiet), noNA(quiet))
  x <- read_checklist(x = x)
  assert_that(
    x$package,
    msg = "`check_documentation()` is only relevant for packages.
`checklist.yml` indicates this is not a package."
  )

  rd_files <- c(
    path(x$get_path, "NAMESPACE"),
    list.files(
      path(x$get_path, "man"), pattern = "Rd$", full.names = TRUE
    )
  )
  start <- vapply(rd_files, readLines, character(1), n = 1)
  ok <- grepl("roxygen2", start) & grepl("do not edit by hand", start)
  doc_error <- sprintf(
    "Documentation in %s not generated by `roxygen2`", rd_files[!ok]
  )

  repo <- x$get_path
  status_before <- git_status(repo = repo)
  document(x$get_path, quiet = quiet)
  detect_changes <- unchanged_repo(repo, status_before)
  si <- session_info(pkgs = "roxygen2")
  doc_error <- c(
    doc_error,
    sprintf(
      "Running `checklist::check_documentation()` with roxygen2 %s %s",
      si$packages$loadedversion[si$packages$package == "roxygen2"],
      attr(detect_changes, "files")
    )[!detect_changes]
  )

  namespace <- readLines(rd_files[1])
  namespace[grepl("^export.*\\(", namespace)] |>
    gsub(pattern = "export.*\\(\"?(.*?)\"?\\)", replacement = "\\1") -> exported
  vapply(rd_files[-1], rd_extract_function, vector("list", 1L)) |>
    unlist() |>
    unique() |>
    sort() -> documented
  unexported <- documented[!documented %in% exported]
  pkgname <- desc(x$get_path)$get_field("Package")
  unexported <- unexported[!unexported %in% paste0(pkgname, c("", "-package"))]
  datasets <- data(package = pkgname)
  unexported <- unexported[!unexported %in% datasets$results[, "Item"]]
  unexported <- unexported[unexported != "reexports"]
  paste(unexported, collapse = ", ") |>
    sprintf(fmt = "documented but unexported functions: %s") -> doc_warnings
  doc_warnings <- doc_warnings[length(unexported) > 0]

  if (is_file(path(x$get_path, "README.Rmd"))) {
    build_readme(x$get_path, encoding = "UTF-8")
    doc_error <- c(
      doc_error,
      paste(
        "Rendering `README.Rmd` updated `README.md`.",
        "Run `checklist::check_documentation()` locally."[!interactive()],
        "Please commit `README.md`. "
      )[
        !is_tracked_not_modified("README.md", repo = repo)
      ]
    )
  }

  md_files <- path(x$get_path, "README.md")
  ok <- is_file(md_files)
  doc_error <- c(doc_error, sprintf("Missing %s", basename(md_files[!ok])))

  doc_error <- c(doc_error, check_news(x))

  x$add_error(doc_error, item = "documentation", keep = FALSE)
  x$add_warnings(doc_warnings, item = "documentation")
  return(x)
}

#' @importFrom fs is_file path
check_news <- function(x) {
  doc_error <- "Don't use NEWS.Rmd"[is_file(path(x$get_path, "NEWS.Rmd"))]
  md_file <- path(x$get_path, "NEWS.md")
  if (!is_file(md_file)) {
    return(c(doc_error, "Missing NEWS.md"))
  }

  description <- desc::description$new(file = path(x$get_path, "DESCRIPTION"))
  news_file <- readLines(md_file)
  version_location <- grep(paste0("#.*", description$get("Package")), news_file)
  if (length(version_location) == 0) {
    return(
      c(
        doc_error,
        paste(
          "No reference to a package version in NEWS.md.",
          "See the details in ?pkgdown::build_news for the required format.",
          sep = "\n"
        )
      )
    )
  }
  ok <- grepl(
    paste0(
      "# `?", description$get("Package"), "`? [0-9]+\\.[0-9]+(\\.[0-9]+)?"
    ),
    news_file[version_location]
  )
  doc_error <- c(
    doc_error,
    sprintf(
      "Package version in NEWS.md in incorrect format.
  \"%s\"
  Use `# name version` format",
      news_file[version_location[!ok]]
    ),
    "NEWS.md doesn't start with the current package version"[
      !grepl(
        paste0(
          "# `?", description$get("Package"), "`? ",
          as.character(description$get_version())
        ),
        news_file[1]
      )
    ],
    "NEWS.md should not contain level 3+ headings"[
      any(grepl("^##(#)+", news_file))
    ]
  )

  # remove URLs to avoid long line linters
  news_file <- gsub(
    "(https?|ftp):\\/{2}(\\w|\\.|\\/|#|-|=|\\?|:|_|\\(|\\))+", "", news_file
  )

  headings <- grep("^#", news_file)
  blank_line_before <- news_file[tail(headings, -1) - 1] == ""
  blank_line_after <- news_file[headings + 1] == ""
  doc_error <- c(
    doc_error,
    "NEWS.md needs a blank line before each heading."[any(!blank_line_before)],
    "NEWS.md needs a blank line after each heading."[any(!blank_line_after)]
  )
  # remove headings and the surrounding blank lines
  news_file <- news_file[-c(
    headings,                                  # heading
    tail(headings, -1)[blank_line_before] - 1, #blank line before
    headings[blank_line_after] + 1             #blank line after
  )]

  doc_error <- c(
    doc_error,
    "NEWS.md should only contain a single blank line before or after a heading"[
      any(news_file == "" | grepl("^\\w+$", news_file))
    ],
    "NEWS.md has a line longer than 80 characters (excluding URLs)."[
      any(nchar(news_file) > 80)
    ],
    paste(
      "Items in NEWS.md must start with `* ` or `    * `.",
      "Extra lines of items start with `  ` or `      `."
    )[
      !all(grepl("^(\\s{4})?(\\*|\\s)\\s\\S+", news_file, perl = TRUE))
    ]
  )

  return(doc_error)
}

rd_extract_function <- function(rd_file) {
  content <- readLines(rd_file)
  if (any(grepl("^\\\\method\\{(.*)\\}", content))) {
    return(list(character(0)))
  }
  rd_regexp <- "^\\\\(name|alias)\\{(.*?)(,.*)?\\}$"
  content[grepl(rd_regexp, content)] |>
    gsub(pattern = rd_regexp, replacement = "\\2") |>
    unique() |>
    gsub(pattern = "-class", replacement = "") |>
    list()
}