R/utils.R

In roxygen2: In-Line Documentation for R

internal_f <- function(p, f) {
  stopifnot(is.character(p), length(p) == 1)
  stopifnot(is.character(f), length(f) == 1)

  get(f, envir = asNamespace(p))
}

"%||%" <- function(a, b) {
  if (length(a) > 0) a else b
}

subs <- matrix(ncol = 2, byrow = T, c(
  # Common special function names
  '[<-', 'subset',
  '[', 'sub',
  '<-', 'set',

  # Infix verbs
  '!', 'not',
  '&', 'and',
  '|', 'or',
  '*', 'times',
  '+', 'plus',
  '^', 'pow',

  # Others
  '"', 'quote',
  '#', 'hash',
  '$', 'cash',
  '%', 'grapes',
  "'", 'single-quote',
  '(', 'open-paren',
  ')', 'close-paren',
  ':', 'colon',
  ';', 'semi-colon',
  '<', 'less-than',
  '==', 'equals',
  '=', 'equals',
  '>', 'greater-than',
  '?', 'help',
  '@', 'at',
  ']', 'close-brace',
  '\\', 'backslash',
  '/', 'slash',
  '`', 'tick',
  '{', 'open-curly',
  '}', 'close',
  '~', 'twiddle'
))
subs[, 2] <- paste0("-", subs[, 2], "-")

nice_name <- function(x) {
  x <- stringi::stri_replace_all_fixed(x, subs[, 1], subs[, 2],
    vectorize_all = FALSE)

  # Clean up any remaining
  x <- str_replace_all(x, "[^A-Za-z0-9_.-]+", "-")
  x <- str_replace_all(x, "-+", "-")
  x <- str_replace_all(x, "^-|-$", "")
  x <- str_replace_all(x, "^\\.", "dot-")
  x
}

write_if_different <- function(path, contents, href = NULL, check = TRUE) {
  if (!file.exists(dirname(path))) {
    dir.create(dirname(path), showWarnings = FALSE)
  }

  name <- basename(path)
  if (check && !made_by_roxygen(path)) {
    cli::cli_warn(c(
      "Skipping {.path {name}}",
      x = "It already exists and was not generated by roxygen2."
    ))
    return(FALSE)
  }

  line_ending <- detect_line_ending(path)
  contents <- paste0(paste0(contents, collapse = line_ending), line_ending)
  contents <- enc2utf8(gsub("\r?\n", line_ending, contents))
  if (same_contents(path, contents)) return(FALSE)

  if (!str_detect(name, "^[a-zA-Z][a-zA-Z0-9_.-]*$")) {
    cli::cli_warn(c(
      "Skipping {.path {name}}",
      x = "Invalid file name"
    ))
    FALSE
  } else {
    if (!is.null(href)) {
      name <- cli::style_hyperlink(name, href)
    }
    cli::cli_inform("Writing {.path {name}}")

    writeBin(charToRaw(contents), path)
    TRUE
  }
}

same_contents <- function(path, contents) {
  if (length(contents) != 1) {
    cli::cli_abort("`contents` must be character(1)", .internal = TRUE)
  }
  if (!file.exists(path)) return(FALSE)

  text_hash <- cli::hash_sha256(contents)

  path <- normalizePath(path, mustWork = TRUE)
  file_hash <- cli::hash_file_sha256(path)

  identical(text_hash, file_hash)
}

compact <- function(x) {
  x[!map_lgl(x, is.null)]
}

invert <- function(x) {
  if (length(x) == 0) return()
  stacked <- utils::stack(x)
  tapply(as.character(stacked$ind), stacked$values, list)
}

is_namespaced <- function(x) {
  tryCatch({
    expr <- parse_expr(x)
    is_call(expr, "::", n = 2)
  }, error = function(err) FALSE)
}

# Collapse the values associated with duplicated keys
collapse <- function(key, value, fun, ...) {
  stopifnot(is.character(key))
  stopifnot(length(key) == length(value))

  dedup <- tapply(value, key, fun, ..., simplify = FALSE)
  # tapply orders alphabetically, so reorder to match original order
  dedup <- dedup[unique(key)]

  list(
    key = names(dedup),
    value = unname(dedup)
  )
}

cat_line <- function(...) {
  cat(paste0(..., "\n", collapse = ""))
}

tag_aliases <- function(f) {
  paste0("@aliases ", paste0("@", names(f()), collapse = " "))
}

pkg_env <- function() {
  env <- new.env(parent = globalenv())
  env$.packageName <- "roxygen2"
  env
}

uuid <- function(nchar = 8) {
  paste(
    sample(c(letters, LETTERS, 0:9), nchar, replace = TRUE),
    collapse = ""
  )
}

# quoting -----------------------------------------------------------------
auto_backtick <- function(x) {
  needs_backtick <- !has_quotes(x) & !is_syntactic(x)
  x[needs_backtick] <- encodeString(x[needs_backtick], quote = "`")
  x
}

auto_quote <- function(x) {
  needs_quotes <- !has_quotes(x) & !is_syntactic(x)
  x[needs_quotes] <- encodeString(x[needs_quotes], quote = '"')
  x
}

is_syntactic <- function(x) make.names(x) == x
has_quotes <- function(x) str_detect(x, "^(`|'|\").*\\1$")