Provide `check_pkg_dependencies`

I think this package could be a superb tool to detect unspecified dependencies.
I started to write the following for myself to check Depends: R. If it's something that you'd be interested in, I'd be happy to contribute a PR.
library(magrittr)
library(data.table)

check_pkg_dependencies <- function(pkg_root = NULL,
                                   on_success = NULL,
                                   on_fail = stop,
                                   reader = readLines) {

  if (!exists("startsWith", mode = "function")) {
    stop("`startsWith` not present, possibly due to insufficient R version.\n\t", 
         "Current:\t", getRversion(), "\n\t",
         "Required:\t", "3.3.0", ".")
  }
  if (!requireNamespace("rcheology", quietly = TRUE)) {
    stop("package:rcheology not installed, but required. ",
         "Run `install.packages('rcheology')` and try again.")
  }
  if (is.null(pkg_root)) {
    if (file.exists("DESCRIPTION")) {
      pkg_root <- "."
    } else if (file.exists("../DESCRIPTION")) {
      pkg_root <- ".."
    } else if (file.exists("../../DESCRIPTION")) {
      pkg_root <- "../.."
    } else {
      stop("`pkg_root = NULL` but unable to locate package root. ", 
           "Current working directory:\n\t",
           normalizePath(getwd(), winslash = "/"), "\n")
    }
  } else {
    if (length(pkg_root) > 1L) {
      return(sapply(pkg_root, check_pkg_dependencies, on_success = on_success, on_fail = on_fail, reader = reader))
    }

    if (!file.exists(file.path(pkg_root, "DESCRIPTION"))) {
      return(on_fail("Unable to find DESCRIPTION"))
    }
  }

  strSplitter <- function(x) {
    if (!is.character(x)) {
      warning("strSplitter provided with non-character object.")
      return("")
    }
    unlist(strsplit(x, split = "(?<=\\()\\b", perl = TRUE))
  }

  rFunsDefined <-
    lapply(dir(file.path(pkg_root, "R"),
               pattern = "\\.R",
               full.names = TRUE),
           reader) %>%
    lapply(trimws) %>%
    lapply(function(x) x[!startsWith(x, "#")]) %>%
    lapply(function(x) {
      sub("^([A-Za-z0-9_\\.]+)\\s*([=]|<-)\\s*function\\(.*$", 
          "\\1",
          grep("^([A-Za-z0-9_\\.]+)\\s*([=]|<-)\\s*function\\(.*$", 
               x,
               perl = FALSE,
               value = TRUE))
    }) %>%
    unlist %>% 
    unique

  rFunsUsed <- 
    lapply(dir(file.path(pkg_root, "R"),
               pattern = "\\.R",
               full.names = TRUE),
           reader) %>%
    lapply(trimws) %>%
    lapply(function(x) x[!startsWith(x, "#")]) %>%
    lapply(strSplitter) %>%
    .[!vapply(., is.null, FALSE)] %>%
    lapply(function(x) x[endsWith(x, "(")]) %>%

    # . is a \b
    lapply(function(x) gsub(".", "DOTDOT", x, fixed = TRUE)) %>%
    lapply(function(x) {
      gsub("^.*\\b([A-Za-z0-9\\._]+)\\(",
           "\\1",
           grep("\\b([A-Za-z0-9\\._]+)\\(", x, value = TRUE, perl = TRUE),
           perl = TRUE)
    }) %>%
    lapply(function(x) gsub("DOTDOT", ".", x, fixed = TRUE)) %>%
    unlist %>%
    unique %>%
    setdiff(rFunsDefined) %>%
    intersect(ls(envir = asNamespace("base"), all.names = TRUE)) %>%
    sort

  stated_R_dep <- 
    desc::desc_get_deps(file = pkg_root) %>%
    as.data.table %>%
    .[type == "Depends" & package == "R"] %>%
    .[["version"]]

  if (length(stated_R_dep)) {
    if (length(stated_R_dep) != 1L) {
      warning("Multiple stated R dependencies, using first...")
      stated_R_dep <- stated_R_dep[1]
    }
  } else {
    stated_R_dep <- ">= 1.0.0"
  }

  # ">= 3.9.9  => ">=" "3.9.9"
  stated_R_dep <- strsplit(stated_R_dep, split = " ")[[1L]]
  R_dep_comparator <- stated_R_dep[1]
  stated_R_dep <- stated_R_dep[2]

  Rversion <- NULL
  all_base_funs <- 
    rcheology::rcheology %>%
    as.data.table %>%
    .[package == "base"] %>%
    .[, .(Rversion = min(Rversion)), keyby = "name"]

  base_funs_used_by_version_introduced <- 
    data.table(base_funs = rFunsUsed) %>%
    .[all_base_funs, on = "base_funs==name", nomatch=0L] %>%
    setkey(Rversion)

  base_funs_introduced_later_than_stated_dep <-
    switch(R_dep_comparator,
           "<" = base_funs_used_by_version_introduced[Rversion <= stated_R_dep],
           "<=" = base_funs_used_by_version_introduced[Rversion < stated_R_dep],
           ">=" = base_funs_used_by_version_introduced[Rversion > stated_R_dep],
           ">" = base_funs_used_by_version_introduced[Rversion >= stated_R_dep],
           stop("Unexpected R dependency: ", stated_R_dep, "."))

  if (nrow(base_funs_introduced_later_than_stated_dep)) {
    cat(basename(pkg_root), ":\n")
    print(base_funs_introduced_later_than_stated_dep)
    return(on_fail("Base function not respecting dependency:\n\t",
                   base_funs_introduced_later_than_stated_dep[1][[1L]], "\t", 
                   base_funs_introduced_later_than_stated_dep[1][[2L]]))
  }
  on_success
}
hughjonesd / rcheology

Provide `check_pkg_dependencies` #5
