R/import-standalone-utils-assert-path.R

In orderly: Lightweight Reproducible Reporting

# Standalone file: do not edit by hand
# Source: https://github.com/reside-ic/reside.utils/blob/awkward-readme/R/standalone-utils-assert-path.R
# Generated by: usethis::use_standalone("reside-ic/reside.utils", "utils-assert-path", ref = "awkward-readme")
# ----------------------------------------------------------------------
#
# ---
# repo: reside/reside.utils
# file: standalone-utils-assert-path.R
# dependencies: standalone-utils-assert.R
# imports: [cli, fs]
# ---
assert_file_exists <- function(files, name = "File", call = parent.frame(),
                               arg = NULL) {
  err <- !file.exists(files)
  ## TODO: throughout this file it would be nice to use cli's '.file'
  ## class and ector contraction, *but* it renders poorly on default
  ## black backgfrounds (dark blue) and makes testing a bit harder
  ## because the rendering depends on cli options.
  ##
  ## TODO: add a canonical case check, as for the relative path bit.
  if (any(err)) {
    ## Because we interpolate both 'name' and the file list, we need
    ## to disambiguate the quantity.
    n <- cli::qty(sum(err))
    cli::cli_abort(
      "{name}{n}{?s} {?does/do} not exist: {format_file_list(files[err])}",
      call = call, arg = arg)
  }
}


assert_file_exists_relative <- function(files, workdir, name,
                                        call = parent.frame(),
                                        arg = NULL) {
  assert_relative_path(files, name, workdir, call)

  assert_character(files, name, call = call)
  err <- !file_exists(files, workdir = workdir)
  if (any(err)) {
    n <- cli::qty(sum(err))
    cli::cli_abort(
      c("{name}{n}{?s} {?does/do} not exist: {format_file_list(files[err])}",
        i = "Looked within directory '{workdir}'"),
      call = call)
  }

  files_canonical <- file_canonical_case(files, workdir)
  err <- is.na(files_canonical) | fs::path(files) != files_canonical
  if (any(err)) {
    i <- err & !is.na(files_canonical)
    hint_case <- sprintf("For '%s', did you mean '%s'?",
                         files[i], files_canonical[i])
    names(hint_case) <- rep("i", length(hint_case))
    n <- cli::qty(sum(err))
    cli::cli_abort(
      c("{name}{n}{?s} {?does/do} not exist: {format_file_list(files[err])}",
        hint_case,
        i = paste("If you don't use the canonical case for a file, your code",
                  "is not portable across different platforms"),
        i = "Looked within directory '{workdir}'"),
      call = call)
  }
}


assert_is_directory <- function(path, name = "Directory", call = parent.frame(),
                                arg = NULL) {
  assert_scalar_character(path, arg = arg, call = call)
  assert_file_exists(path, name = name, arg = arg, call = call)
  if (!fs::is_dir(path)) {
    cli::cli_abort("Path exists but is not a directory: {path}",
                   call = call, arg = arg)
  }
}


assert_relative_path <- function(files, name, workdir, call = parent.frame(),
                                 arg = NULL) {
  err <- fs::is_absolute_path(files)
  if (any(err)) {
    n <- cli::qty(sum(err))
    files_err <- files[err]
    names(files_err) <- rep("x", length(files_err))
    cli::cli_abort(
      c("{name}{n}{?s} must be {?a/} relative path{?s}",
        files_err,
        i = "Path was relative to directory '{workdir}'"),
      call = call, arg = arg)
  }

  err <- vapply(fs::path_split(files), function(x) any(x == ".."), TRUE)
  if (any(err)) {
    n <- cli::qty(sum(err))
    files_err <- files[err]
    names(files_err) <- rep("x", length(files_err))
    cli::cli_abort(
      c("{name}{n}{?s} must not contain '..' (parent directory) components",
        files_err,
        i = "Path was relative to directory '{workdir}'"),
      call = call, arg = arg)
  }
}


assert_directory_does_not_exist <- function(x, name = "Directory", arg = NULL,
                                            call = parent.frame()) {
  ok <- !fs::dir_exists(x)
  if (!all(ok)) {
    cli::cli_abort("{name}{?s} already exists: {format_file_list(x[!ok])}",
                   call = call, arg = arg)
  }
  invisible(x)
}


file_canonical_case <- function(path, workdir) {
  if (length(path) != 1) {
    return(vapply(path, file_canonical_case, "", workdir, USE.NAMES = FALSE))
  }
  stopifnot(!fs::is_absolute_path(path))
  path_split <- fs::path_split(path)[[1]]
  base <- workdir
  ret <- character(length(path_split))
  for (i in seq_along(path_split)) {
    pos <- dir(base, all.files = TRUE, no.. = TRUE)
    el <- path_split[[i]]
    j <- which(tolower(el) == tolower(pos))
    if (length(j) == 1) {
      el <- pos[[j]]
    } else if (el %in% pos) {
      # We might want to warn here?
      # message("Multiple casings present; this is not portable")
    } else {
      return(NA_character_)
    }
    ret[[i]] <- el
    base <- file.path(base, el)
  }
  paste(ret, collapse = "/")
}


file_exists <- function(..., workdir = NULL) {
  files <- c(...)
  if (!is.null(workdir)) {
    assert_scalar_character(workdir)
    owd <- setwd(workdir) # nolint
    on.exit(setwd(owd)) # nolint
  }
  fs::file_exists(files)
}


format_file_list <- function(x) {
  cli::cli_vec(sprintf("'%s'", x),
               style = list("vec-sep2" = ", ", "vec-last" = ", "))
}