Add (file) IO checks

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: pacta.workflow.utils
 Title: Utility functions for PACTA workflows
-Version: 0.0.0.9011
+Version: 0.0.0.9012
 Authors@R: 
     c(person(given = "Alex",
              family = "Axthelm",

NAMESPACE

@@ -1,5 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
+export(check_dir_writable)
+export(check_file)
+export(check_io)
 export(export_manifest)
 export(parse_raw_params)
 importFrom(logger,log_debug)

R/file_checks.R

@@ -0,0 +1,97 @@
+#' check_dir_writable
+#'
+#' Check if a directory is writable. Check is performed by attempting to write
+#' a 0-byte file (`.test`) to the directory (and removing afterwards). Emits a
+#' warning on windows, since file permissions on Windows systems are difficult
+#' to test, but _should_ be accurate.
+#'
+#' @param dir directory to check writiblity
+#' @return logical, can a file be written to the directory?
+#' @export
+check_dir_writable <- function(dir) {
+  log_trace("Checking if directory is writable: ", dir)
+  if (tolower(Sys.info()[["sysname"]]) == "windows") {
+    log_warn("Function check_dir_writable is not tested on Windows.")
+    warning("check_dir_writable may return incorrect results on Windows.")
+  }
+  if (dir.exists(dir)) {
+    log_trace("Directory exists.")
+    test_path <- file.path(dir, ".test")
+    dir_is_writable <- file.create(test_path, showWarnings = FALSE)
+    if (dir_is_writable) {
+      file.remove(test_path)
+    }
+  } else {
+    log_error("Directory \"{dir}\" does not exist.")
+    warning("Directory does not exist.")
+    dir_is_writable <- FALSE
+  }
+  return(dir_is_writable)
+}
+
+#' check_file
+#'
+#' check a filepath for existence, non-zero size, and non-directory status.
+#'
+#' @param filepath path to file
+#' @return logical(1L), is the file valid?
+#' @export
+check_file <- function(filepath) {
+  log_trace("Checking if file exists: ", filepath)
+  pass <- FALSE
+  info <- file.info(filepath, extra_cols = FALSE)
+  if (all(is.na(info))) {
+    log_error("File \"{filepath}\" does not exist.")
+    warning("File does not exist.")
+  } else if (is.na(info[["isdir"]]) || info[["isdir"]]) {
+    log_error("File \"{filepath}\" is a directory.")
+    warning("File is a directory.")
+  } else if (info[["size"]] == 0L || is.na(info[["size"]])) {
+    log_warn("File \"{filepath}\" is empty.")
+    warning("File is empty.")
+  } else {
+    log_trace("File exists and is non-zero size.")
+    pass <- TRUE
+  }
+  return(invisible(pass))
+}
+
+#' check_io
+#'
+#' check `input_files` using \code{\link{check_file}} and `output_dirs` using
+#' \code{\link{check_dir_writable}}.
+#'
+#' @param input_files list or vector of file paths to check with
+#' \code{\link{check_file}}
+#' @param output_dirs list or vector of directories to check with
+#' \code{\link{check_dir_writable}}
+#' @return logical(1L), are all files and directories valid? Note that function
+#' will throw an error in situations where this is not TRUE.
+#' @export
+check_io <- function(
+  input_files = NULL,
+  output_dirs = NULL
+) {
+  input_checks <- vapply(
+    X = input_files,
+    FUN = check_file,
+    FUN.VALUE = logical(1L)
+  )
+  output_checks <- vapply(
+    X = output_dirs,
+    FUN = check_dir_writable,
+    FUN.VALUE = logical(1L)
+  )
+  if (!all(c(input_checks, output_checks))) {
+    invalid_input_idx <- which(!input_checks)
+    for (ii in invalid_input_idx) {
+      log_error("Invalid input file: ", input_files[[ii]])
+    }
+    invalid_output_idx <- which(!output_checks)
+    for (ii in invalid_output_idx) {
+      log_error("Invalid output directory: ", output_dirs[[ii]])
+    }
+    stop("IO checks failed.")
+  }
+  return(invisible(all(input_checks, output_checks)))
+}

tests/testthat/test-check_dir_writable.R

@@ -0,0 +1,48 @@
+## save current settings so that we can reset later
+threshold <- logger::log_threshold()
+appender  <- logger::log_appender()
+layout    <- logger::log_layout()
+on.exit({
+  ## reset logger settings
+  logger::log_threshold(threshold)
+  logger::log_layout(layout)
+  logger::log_appender(appender)
+})
+
+logger::log_appender(logger::appender_stdout)
+logger::log_threshold(logger::FATAL)
+logger::log_layout(logger::layout_simple)
+
+# TESTS BEGIN
+
+test_that("check_dir_writable correctly registers writable directory", {
+  skip_on_os("windows")
+  test_dir <- withr::local_tempdir()
+  expect_true(check_dir_writable(test_dir))
+})
+
+test_that("check_dir_writable correctly errors on missing directory", {
+  skip_on_os("windows")
+  test_dir <- withr::local_tempdir()
+  dne_dir <- file.path(test_dir, "does_not_exist")
+  expect_warning(
+    check_dir_writable(dne_dir),
+    regexp = "^Directory does not exist.$"
+  )
+})
+
+test_that("check_dir_writable correctly registers un-writable directory", {
+  skip_on_os("windows")
+  test_dir <- withr::local_tempdir()
+  Sys.chmod(test_dir, mode = "000")
+  expect_false(check_dir_writable(test_dir))
+})
+
+test_that("check_dir_writable emits warning on windows.", {
+  skip_on_os(c("mac", "linux", "solaris"))
+  test_dir <- withr::local_tempdir()
+  expect_warning(
+    check_dir_writable(test_dir),
+    regexp = "^check_dir_writable may return incorrect results on Windows.$"
+  )
+})

tests/testthat/test-check_file.R

@@ -0,0 +1,49 @@
+## save current settings so that we can reset later
+threshold <- logger::log_threshold()
+appender  <- logger::log_appender()
+layout    <- logger::log_layout()
+on.exit({
+  ## reset logger settings
+  logger::log_threshold(threshold)
+  logger::log_layout(layout)
+  logger::log_appender(appender)
+})
+
+logger::log_appender(logger::appender_stdout)
+logger::log_threshold(logger::FATAL)
+logger::log_layout(logger::layout_simple)
+
+test_that("check_dir_writable correctly identifies missing files", {
+  test_file <- withr::local_tempfile()
+  expect_warning(
+    {results <- check_file(test_file)},
+    regexp = "^File does not exist.$"
+  )
+  expect_false(results)
+})
+
+test_that("check_dir_writable correctly identifies missing files", {
+  test_file <- withr::local_tempdir()
+  expect_warning(
+    {results <- check_file(test_file)},
+    regexp = "^File is a directory.$"
+  )
+  expect_false(results)
+})
+
+test_that("check_dir_writable correctly identifies 0-byte files", {
+  test_file <- withr::local_tempfile()
+  file.create(test_file)
+  expect_warning(
+    {results <- check_file(test_file)},
+    regexp = "^File is empty.$"
+  )
+  expect_false(results)
+})
+
+test_that("check_dir_writable correctly identifies extant, non-empty files", {
+  test_file <- withr::local_tempfile()
+  saveRDS(object = mtcars, file = test_file)
+  results <- check_file(test_file)
+  expect_true(results)
+})