check-cran-incoming-checks.R

# These functions were borrowed from klmr/box
# https://github.com/klmr/box/tree/5e411d47/scripts

#+
verify_function_has_value = function (file) {
  rd = tools::parse_Rd(file)
  type = find_tag(rd, 'docType')
  (length(type) != 0L && type != 'function') || length(find_tag(rd, 'value')) != 0L
}

find_tag = function (rd, tag) {
  Filter(function (x) attr(x, 'Rd_tag') == paste0('\\', tag), rd)
}

pkg = "."

rd_files = dir(file.path(pkg, 'man'), pattern = '\\.[Rr]d$', full.names = TRUE)

ok = vapply(rd_files, verify_function_has_value, logical(1L))
if (! all(ok)) {
  msg = '\n* [ ] Add `@return` to the following files:\n  * [ ] %s'
  failed = basename(rd_files[! ok])
  stop(sprintf(msg, paste(failed, collapse = ',\n  * [ ] ')))
}


# Not missing examples ----------------------------------------------------
#+

verify_function_has_examples = function (file) {
  rd = tools::parse_Rd(file)
  type = find_tag(rd, 'docType')
  (length(type) != 0L && type != 'function') || length(find_tag(rd, 'examples')) != 0L
}

ok = vapply(rd_files, verify_function_has_examples, logical(1L))
if (! all(ok)) {
  msg = '\n* [ ] Missing `@examples`:\n  * [ ] %s'
  failed = fs::path_ext_remove(basename(rd_files[!ok]))
  stop(sprintf(msg, paste(failed, collapse = '\n  * [ ] ')))
}


# No LazyData wihout data/ ------------------------------------------------
#+

lazy_data <- read.dcf("DESCRIPTION", "LazyData")["LazyData"]

if (!is.na(lazy_data)) {
  if (! dir.exists(file.path(pkg, 'data'))) {
    stop('\'LazyData\' is specified without a \'data\' directory')
  }
}

# Internal functions don't have examples ----------------------------------
#+

verify_is_not_internal = function (file) {
  rd = tools::parse_Rd(file)
  keywords = find_tag(rd, 'keyword')
  is_internal = ! all(vapply(keywords, `!=`, logical(1L), 'internal'))
  ! is_internal || length(find_tag(rd, 'examples')) == 0L
}

find_tag = function (rd, tag) {
  Filter(function (x) attr(x, 'Rd_tag') == paste0('\\', tag), rd)
}

rd_files = dir(file.path(pkg, 'man'), pattern = '\\.[Rr]d$', full.names = TRUE)

ok = vapply(rd_files, verify_is_not_internal, logical(1L))
if (! all(ok)) {
  msg = '\n* [ ] Remove or hide examples in internal functions:\n  * [ ] %s'
  failed = basename(rd_files[! ok])
  stop(sprintf(msg, paste(failed, collapse = ',\n  * [ ] ')))
}