R/document.R

In cnd: Create and Register Conditions

# exports -----------------------------------------------------------------

#' Document your conditions
#'
#' Documents your [conditions()] and [cnd::conditions()]
#'
#' @param package The package to document
#' @param registry The name of the registry
#' @param file The file to save the documentation.  This can be a file path, a
#'   connection object, or `NULL`.  When `file` is a path, the directory of the
#'   path is searched for files containing `# % Generated by cnd: do not edit by
#'   hand`. These are removed if they are not the same as the generated
#'   documentation.
#' @param cleanup If `FALSE` will not remove files containing `# % Generated by
#'   cnd: do not edit by hand`
#'
#' @section conditions:
#'
#'   `r cnd_section(cnd_document)`
#'
#' @export
#' @returns
#'  - [cnd_document()] Conditional on the `file` argument:
#'    - when `file` is a connection, the connection object
#'    - when `file` is a path, the path
#'    - when `file` is `NULL`, a `character` vector of the documentation
#'     - if no conditions are found, a warning is thrown and `NULL` is returned
#' @examples
#' file <- file()
#' cnd_document("cnd", file = file)
#' readLines(file)
#'
#' cnd_section("cnd")
cnd_document <- function(
  package = get_package(),
  registry = package,
  file = file.path("R", paste0(package, "-cnd-conditions.R")),
  cleanup = TRUE
) {
  op <- options(cnd.cli.override = "off")
  on.exit(options(op), add = TRUE)
  force(package)
  force(registry)

  if (is.null(package) || is.null(registry)) {
    cnd(cond_cnd_document_pkg_reg(package, registry))
  }

  force(file)
  conds <- conditions(package = package, registry = registry)

  if (is.null(conds)) {
    cnd(cond_cnd_document_conds())
    return()
  }

  text <- fmt(
    cnd_documentation_fmt,
    package = package,
    # nolint start: line_length_linter.
    aliases1 = collapse(vapply(conds, cget, NA_character_, "class"), sep = " "),
    aliases2 = collapse(
      vapply(conds, cget, NA_character_, ".class"),
      sep = " "
    ),
    aliases3 = collapse(
      vapply(conds, `format.cnd::condition_generator`, NA_character_),
      sep = " "
    ),
    # nolint end: line_length_linter.
    cnd_section_describe = collapse(
      vapply(
        conds,
        function(c) {
          fmt(
            cnd_section_describe_fmt,
            form = format(c),
            pkg = cget(c, "package"),
            cls = cget(c, "class"),
            typ = cget(c, "type"),
            help = if (is.null(h <- cget(c, "help"))) {
              "  _no help documentation provided_"
            } else {
              paste0("  ", clean_text(h), collapse = "\n")
            }
          )
        },
        NA_character_
      )
    )
  )

  temp <- file()
  on.exit(if (isOpen(temp)) close(temp), add = TRUE)
  cat(text, sep = "\n", file = temp)
  res <- c(paste("#'", readLines(temp)), "NULL")
  res <- trimws(res)

  if (is.null(file)) {
    return(res)
  }

  if (inherits(file, "connection")) {
    cat(res, sep = "\n", file = file)
    return(invisible(file))
  }

  if (!is.character(file)) {
    cnd(cond_cnd_document_file(file))
  }

  gen_text <- "# % Generated by cnd: do not edit by hand"
  res <- c(gen_text, "", res)

  dir <- dirname(file)
  if (dir.exists(dir)) {
    cnd_files <- list.files(dir, full.names = TRUE)
    cnd_files <- cnd_files[cnd_files != file]
    cnd_files <- filter2(
      cnd_files,
      function(p) {
        identical(
          readLines(p, n = 1, warn = FALSE),
          gen_text
        )
      }
    )

    if (length(cnd_files)) {
      cnd(cond_cnd_generated_cleanup(cnd_files))
      try(file.remove(cnd_files), silent = TRUE)
    }
  }

  if (file.exists(file) && identical(res, readLines(file))) {
    return(invisible(file))
  }

  cnd(cond_cnd_generated_write(file))
  cat(res, sep = "\n", file = file)
  invisible(file)
}

#' @export
#' @rdname cnd_document
#' @param fun The name of a function
#' @returns
#' - [cnd_section()] A `character` vector of the documentation
cnd_section <- function(fun) {
  conds <- conditions(fun = fun)
  fmt(
    cnd_section_fmt,
    conds = collapse(
      vapply(
        conds,
        function(c) {
          fmt(
            cnd_section_item_fmt,
            pkg = cget(c, "package"),
            form = format(c),
            help = cget(c, "help") %||% ""
          )
        },
        NA_character_
      )
    ),
    pkgs = collapse(
      vapply(
        unique(vapply(conds, cget, NA_character_, "package")),
        function(p) fmt("[{pkg}-cnd-conditions]", pkg = p),
        NA_character_
      )
    ),
    sep = ", "
  )
}


# fmts --------------------------------------------------------------------

## cnd_document() ----

cnd_documentation_fmt <- "@name {package}-cnd-conditions
@aliases {package}-cnd-conditions {aliases1} {aliases2} {aliases3}
@title Conditions for `{package}`

@details
  The following conditions are defined in the `{{package}}` package.

@section [`{cnd}`][cnd-package]:
  These conditions are made with the `{cnd}` package though the use of
  [cnd::condition()].

@section `{{package}}` conditions:
{cnd_section_describe}

@seealso [cnd::cnd-package] [cnd::condition]
@keywords internal
"

# the keyword here is added so that roxygen2 doesn't accidentally pick
# it up as something that needs some Rd
cnd_section_describe_fmt <- "
  \\subsection{`{form}`}{
  \\describe{
    \\item{package}{`{{pkg}}`}
    \\item{class}{`{cls}`}
    \\item{type}{**{typ}**}
  }
{help}
 }"

## cnd_section() ----

cnd_section_fmt <- "
Conditions are generated through the [`{cnd}`][cnd::cnd-package] package.
The following conditions are associated with this function:

\\describe{
  {conds}
}

For more conditions, see: {pkgs}
"

cnd_section_item_fmt <- "
  \\item{[`{form}`][{pkg}-cnd-conditions]}{
    {help}
  }
"

# conditions --------------------------------------------------------------

# fmt: skip
cond_cnd_generated_cleanup <- function() {}
delayedAssign(
  "cond_cnd_generated_cleanup",
  condition(
    "cnd_generated_cleanup",
    type = "message",
    package = "cnd",
    exports = "cnd_document",
    # nolint next: brace_linter.
    message = function(paths)
      c(
        "Removing the following cnd generated files:",
        paste0("  ", paths)
      )
  )
)

# fmt: skip
cond_cnd_generated_write <- function() {}
delayedAssign(
  "cond_cnd_generated_write",
  condition(
    "cnd_generated_write",
    type = "condition",
    package = "cnd",
    exports = "cnd_document",
    # nolint next: brace_linter.
    message = function(path)
      cli_switch(
        cli_text(sprintf("Writing {.file %s}", path))
      ) %||%
        paste("Writing", path)
  )
)

# fmt: skip
cond_cnd_document_pkg_reg <- function() {}
delayedAssign(
  "cond_cnd_document_pkg_reg",
  condition(
    "cnd_document_pkg_reg",
    type = "error",
    exports = "cnd_document",
    package = "cnd",
    # nolint next: brace_linter.
    message = function(pkg, reg)
      fmt(
        "package and registry must be set\n",
        "  package: {pkg}\n",
        "  registry: {reg}",
        pkg = pkg,
        reg = reg
      )
  )
)

# fmt: skip
cond_cnd_document_conds <- function() {}
delayedAssign(
  "cond_cnd_document_conds",
  condition(
    "cnd_document_conditions",
    type = "warning",
    package = "cnd",
    exports = "cnd_document",
    message = "No conditions found to document"
  )
)

# fmt: skip
cond_cnd_document_file <- function() {}
delayedAssign(
  "cond_cnd_document_file",
  condition(
    "cnd_document_file",
    type = "error",
    package = "cnd",
    exports = "cnd_document",
    # nolint next: brace_linter.
    message = function(file)
      fmt(
        "`file` must be a `character`, `connection` object`, or `NULL`,",
        " not {class} ({type})",
        class = collapse(class(file), sep = "/"),
        type = typeof(file)
      )
  )
)