Import orderly2's file utilities

R/standalone-utils-assert-path.R

@@ -0,0 +1,146 @@
+# ---
+# 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 <- tolower(fs::path_split(path)[[1]])
+  base <- workdir
+  ret <- character(length(path_split))
+  for (i in seq_along(path_split)) {
+    pos <- dir(base)
+    j <- which(path_split[[i]] == tolower(pos))
+    if (length(j) != 1) {
+      return(NA_character_)
+    }
+    ret[[i]] <- pos[[j]]
+    base <- file.path(base, pos[[j]])
+  }
+  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" = ", "))
+}

tests/testthat/test-util-assert-path.R

@@ -0,0 +1,118 @@
+test_that("assert_file_exists", {
+  tmp <- withr::local_tempdir()
+  expect_error(assert_file_exists(file.path(tmp, "a")),
+               "File does not exist")
+  expect_error(assert_file_exists(file.path(tmp, c("a", "b"), "File")),
+               "Files do not exist")
+  file.create(file.path(tmp, c("a", "b")))
+  expect_no_error(assert_file_exists(file.path(tmp, "a")))
+  expect_no_error(assert_file_exists(file.path(tmp, c("a", "b"))))
+})
+
+
+test_that("assert_file_exists_relative works checks if files exist", {
+  tmp <- withr::local_tempdir()
+  file.create(file.path(tmp, "c"))
+  expect_error(assert_file_exists_relative("a", tmp, "File"),
+               "File does not exist: 'a'")
+  expect_error(assert_file_exists_relative(c("a", "b"), tmp, "File"),
+               "Files do not exist: 'a', 'b'")
+  expect_error(assert_file_exists_relative(c("a", "b", "c", "d"), tmp, "File"),
+               "Files do not exist: 'a', 'b', 'd'")
+  expect_silent(assert_file_exists_relative("c", tmp, "File"))
+})
+
+
+test_that("assert_file_exists_relative informs about case mismatch", {
+  testthat::skip_if_not_installed("mockery")
+  mock_file_exists <- mockery::mock(TRUE, cycle = TRUE)
+  mockery::stub(assert_file_exists_relative, "file_exists", mock_file_exists)
+
+  tmp <- withr::local_tempdir()
+  file.create(file.path(tmp, "a"))
+  fs::dir_create(file.path(tmp, "b/c"))
+  file.create(file.path(tmp, "b/c/d"))
+
+  err <- expect_error(
+    assert_file_exists_relative("A", tmp, "File"),
+    "File does not exist: 'A'")
+  expect_length(err$body, 3)
+  expect_equal(names(err$body), c("i", "i", "i"))
+  expect_equal(err$body[[1]], "For 'A', did you mean 'a'?")
+  expect_match(err$body[[2]], "If you don't use the canonical case for a file")
+  expect_match(err$body[[3]], "Looked within directory '.+'")
+
+  err <- expect_error(
+    assert_file_exists_relative(c("A", "b/C/d"), tmp, "File"),
+    "Files do not exist: 'A', 'b/C/d'")
+  expect_length(err$body, 4)
+  expect_equal(names(err$body), c("i", "i", "i", "i"))
+  expect_equal(err$body[[1]], "For 'A', did you mean 'a'?")
+  expect_equal(err$body[[2]], "For 'b/C/d', did you mean 'b/c/d'?")
+  expect_match(err$body[[3]], "If you don't use the canonical case for a file")
+  expect_match(err$body[[4]], "Looked within directory '.+'")
+
+  err <- expect_error(
+    assert_file_exists_relative(c("A", "b/X/d"), tmp, "File"),
+    "Files do not exist: 'A', 'b/X/d'")
+  expect_length(err$body, 3)
+  expect_equal(names(err$body), c("i", "i", "i"))
+  expect_equal(err$body[[1]], "For 'A', did you mean 'a'?")
+  expect_match(err$body[[2]], "If you don't use the canonical case for a file")
+  expect_match(err$body[[3]], "Looked within directory '.+'")
+})
+
+
+test_that("assert_is_directory", {
+  tmp <- withr::local_tempdir()
+  path <- file.path(tmp, "foo")
+  expect_error(assert_is_directory(path), "Directory does not exist")
+  file.create(path)
+  expect_error(assert_is_directory(path),
+               "Path exists but is not a directory")
+  expect_silent(assert_is_directory("."))
+})
+
+
+test_that("assert_relative_path", {
+  workdir <- getwd()
+  expect_error(assert_relative_path(getwd(), "File", workdir),
+               "File must be a relative path",
+               fixed = TRUE)
+  expect_silent(assert_relative_path("relpath", "File", workdir))
+  expect_silent(assert_relative_path("a/b/c", "File", workdir))
+
+  expect_error(
+    assert_relative_path("../my/path", "File", workdir),
+    "must not contain '..' (parent directory) components",
+    fixed = TRUE)
+  expect_error(
+    assert_relative_path("my/../../path", "File", workdir),
+    "must not contain '..' (parent directory) components",
+    fixed = TRUE)
+})
+
+
+test_that("can convert files to canonical case", {
+  tmp <- withr::local_tempdir()
+  p <- file.path(tmp, "a", "b", "c")
+  fs::dir_create(dirname(p))
+  file.create(p)
+  expect_equal(file_canonical_case("a/b/c", tmp), "a/b/c")
+  expect_equal(file_canonical_case("a//b//c", tmp), "a/b/c")
+  expect_equal(file_canonical_case("a/B/c", tmp), "a/b/c")
+  expect_equal(file_canonical_case("A/B/C", tmp), "a/b/c")
+  expect_equal(file_canonical_case("A/win~1/C", tmp), NA_character_)
+  expect_equal(file_canonical_case(c("a/b/c", "a/b/d"), tmp), c("a/b/c", NA))
+})
+
+
+test_that("can check directories do not exist", {
+  tmp <- withr::local_tempdir()
+  path <- file.path(tmp, "a")
+  expect_no_error(assert_directory_does_not_exist(path))
+  dir.create(path)
+  expect_error(
+    assert_directory_does_not_exist(path),
+    "Directory already exists")
+})