
#' @include lists.R

CHECKS$no_description_depends <- make_check(

  description = 'No "Depends" in DESCRIPTION',
  tags = c("info", "DESCRIPTION"),
  preps = "description",

  gp = 'not use {.field Depends} in {.file DESCRIPTION}, as it can cause name
        clashes, and poor interaction with other packages. Use {.field Imports}
        instead.',

  check = function(state) {
    if(inherits(state$description, "try-error")) return(na_result())

    deps <- state$description$get_deps()
    ## Remove 'methods' and R, these are OK
    deps <- deps[! deps$package %in% c("methods", "R"), , drop = FALSE]
    check_result(! 'Depends' %in% deps$type)
  }
)

## --------------------------------------------------------------------

CHECKS$no_description_date <- make_check(

  description = 'No "Date" in DESCRIPTION',
  tags = c("info", "DESCRIPTION"),
  preps = "description",

  gp = 'omit the {.field Date} field in {.file DESCRIPTION}.
        It is not required and it gets invalid quite often.
        A build date will be added to the package when you
        perform {.code R CMD build} on it.',

  check = function(state) {
    if(inherits(state$description, "try-error")) return(na_result())

    check_result(! state$description$has_fields('Date'))
  }
)

## --------------------------------------------------------------------

CHECKS$description_url <- make_check(

  description = 'URL in DESCRIPTION',
  tags = c("info", 'DESCRIPTION'),
  preps = 'description',

  gp = 'add a {.field URL} field to {.file DESCRIPTION}.
        It helps users find information about your package
        online. If your package does not have a homepage,
        add an URL to GitHub, or the CRAN package page.',

  check = function(state) {
    if(inherits(state$description, "try-error")) return(na_result())

    check_result(state$description$has_fields("URL"))
  }
)

## --------------------------------------------------------------------

CHECKS$description_not_start_with_package <- make_check(

  description = 'Description does not start with package name reference',
  tags = c("info", "DESCRIPTION"),
  preps = "description",

  gp = 'not start the {.field Description} field by referring to the package
        itself, e.g. "This package ...", "This is a package ...",
        or "The FooBar package ...". Describe what the package does
        directly, e.g. "Provides tools for ..." instead of
        "This package provides tools for ...".',

  check = function(state) {
    if(inherits(state$description, "try-error")) return(na_result())

    desc_text <- state$description$get_field("Description")
    pkg_name <- state$description$get_field("Package")
    starts_this_pkg <- grepl(
      "^This\\s+(is\\s+a\\s+)?package\\b",
      desc_text, ignore.case = TRUE
    )
    starts_the_pkg <- grepl(
      paste0("^The\\s+", pkg_name, "\\s+package\\b"),
      desc_text, ignore.case = TRUE
    )
    check_result(!(starts_this_pkg || starts_the_pkg))
  }
)

## --------------------------------------------------------------------

CHECKS$description_urls_in_angle_brackets <- make_check(

  description = "URLs in Description are enclosed in angle brackets",
  tags = c("info", "DESCRIPTION"),
  preps = "description",

  gp = 'enclose URLs in the {.field Description} field in angle brackets,
        e.g. <https://example.com>. CRAN requires angle brackets
        around URLs for auto-linking.',

  check = function(state) {
    if(inherits(state$description, "try-error")) return(na_result())

    desc_text <- state$description$get_field("Description")
    bare_url <- "(?<!<)(https?://[^\\s,)>]+)"
    check_result(!grepl(bare_url, desc_text, perl = TRUE))
  }
)

## --------------------------------------------------------------------

CHECKS$description_doi_format <- make_check(

  description = "DOIs in Description use <doi:...> format",
  tags = c("info", "DESCRIPTION"),
  preps = "description",

  gp = 'use the {.code <doi:10.prefix/suffix>} format for DOIs in the
        {.field Description} field instead of a full URL like
        {.code <https://doi.org/10.prefix/suffix>}. CRAN requires
        the {.code <doi:...>} notation for auto-linking.',

  check = function(state) {
    if(inherits(state$description, "try-error")) return(na_result())

    desc_text <- state$description$get_field("Description")
    check_result(!grepl("https?://doi\\.org/", desc_text))
  }
)

## --------------------------------------------------------------------

CHECKS$description_urls_not_http <- make_check(

  description = "URLs in Description use https not http",
  tags = c("info", "DESCRIPTION"),
  preps = "description",

  gp = 'consider using {.code https://} instead of
        {.code http://} for URLs in the {.field Description}
        field. CRAN prefers secure URLs where available.
        Check if there might be a secure
        {.code https://} alternative.',

  check = function(state) {
    if(inherits(state$description, "try-error")) return(na_result())

    desc_text <- state$description$get_field("Description")
    check_result(!grepl("http://", desc_text, fixed = TRUE))
  }
)

## --------------------------------------------------------------------

CHECKS$no_description_duplicate_deps <- make_check(

  description = "No duplicate dependencies in DESCRIPTION",
  tags = c("info", "DESCRIPTION"),
  preps = "description",

  gp = 'not list the same package in multiple dependency fields
        (e.g. both {.field Imports} and
        {.field Suggests}). Each dependency should appear
        only once.',

  check = function(state) {
    if(inherits(state$description, "try-error")) return(na_result())

    deps <- state$description$get_deps()
    deps <- deps[deps$package != "R" & deps$type != "LinkingTo", , drop = FALSE]
    check_result(!anyDuplicated(deps$package))
  }
)

## --------------------------------------------------------------------

CHECKS$description_valid_roles <- make_check(

  description = "Authors have valid roles in DESCRIPTION",
  tags = c("info", "DESCRIPTION"),
  preps = "description",

  gp = 'use only standard R author roles in {.field Authors@R}. Valid roles are:
        aut (author), com (compiler), cph (copyright holder),
        cre (maintainer), ctb (contributor), ctr (contractor),
        dtc (data contributor), fnd (funder), rev (reviewer),
        ths (thesis advisor), trl (translator).',

  check = function(state) {
    if(inherits(state$description, "try-error")) return(na_result())

    authors_r <- state$description$get_field("Authors@R", default = NA)
    if (is.na(authors_r)) return(na_result())

    valid_roles <- tryCatch(utils:::MARC_relator_db$code, error = function(e) NULL)
    if (is.null(valid_roles)) return(na_result())

    roles_env <- new.env(parent = emptyenv())
    roles_env$roles <- character()
    capture_person <- function(..., role = NULL) {
      roles_env$roles <- c(roles_env$roles, role)
      NULL
    }
    env <- new.env(parent = baseenv())
    env$person <- capture_person
    env$c <- c

    ok <- tryCatch({
      eval(parse(text = authors_r), envir = env)
      TRUE
    }, error = function(e) FALSE)
    if (!ok) return(na_result())

    check_result(all(roles_env$roles %in% valid_roles))
  }
)

## --------------------------------------------------------------------

CHECKS$description_pkgname_single_quoted <- make_check(

  description = "Package names in Title/Description are single-quoted",
  tags = c("info", "DESCRIPTION"),
  preps = "description",

  gp = 'single-quote package names in the
        {.field Title} and {.field Description} fields,
        e.g. {.pkg dplyr} not dplyr. CRAN requires that
        software names are single-quoted.',

  check = function(state) {
    if(inherits(state$description, "try-error")) return(na_result())

    deps <- state$description$get_deps()
    pkg_names <- deps$package[deps$package != "R"]
    # Base packages shipped with R (alphabetical, matching r-source).
    # Excluded: "translations" (not a loadable package).
    # https://github.com/wch/r-source/tree/trunk/src/library
    base_pkgs <- c(
      "base", "compiler", "datasets", "grDevices",
      "graphics", "grid", "methods", "parallel",
      "splines", "stats", "stats4", "tcltk",
      "tools", "utils"
    )
    pkg_names <- setdiff(pkg_names, base_pkgs)
    if (length(pkg_names) == 0) return(check_result(TRUE))

    title <- state$description$get_field("Title")
    desc_text <- state$description$get_field("Description")
    text <- paste(title, desc_text)

    for (pkg in pkg_names) {
      unquoted <- paste0("(?<!')\\b", pkg, "\\b(?!')")
      if (grepl(unquoted, text, perl = TRUE)) return(check_result(FALSE))
    }
    check_result(TRUE)
  }
)

## --------------------------------------------------------------------

CHECKS$description_bugreports <- make_check(

  description = "BugReports in DESCRIPTION",
  tags = c("info", 'DESCRIPTION'),
  preps = 'description',

  gp = 'add a {.field BugReports} field to
        {.file DESCRIPTION}, and point it to a bug tracker.
        Many online code hosting services provide bug
        trackers for free, {.url https://github.com},
        {.url https://gitlab.com}, etc.',

  check = function(state) {
    if(inherits(state$description, "try-error")) return(na_result())

    check_result(state$description$has_fields('BugReports'))
  }
)

## --------------------------------------------------------------------
