1#' @include on-failure.r
2NULL
3
4path_is_not <- function(thing, var = "x") {
5  function(call, env) {
6    paste0("Path '", eval(call[[var]], env), "' is not ", thing)
7  }
8}
9
10#' Useful test related to files
11#'
12#' @param path a file path to examine
13#' @name assertions-file
14#' @examples
15#' see_if(is.dir(1))
16#'
17#' tmp <- tempfile()
18#' see_if(file.exists(tmp))
19#' see_if(is.dir(tmp))
20#'
21#' writeLines("x", tmp)
22#' see_if(file.exists(tmp))
23#' see_if(is.dir(tmp))
24#' see_if(is.writeable(tmp))
25#' see_if(is.readable(tmp))
26#' unlink(tmp)
27#'
28#' see_if(is.readable(tmp))
29NULL
30
31#' @export
32#' @rdname assertions-file
33is.dir <- function(path) {
34  assert_that(is.string(path), file.exists(path))
35  file.info(path)$isdir
36}
37on_failure(is.dir) <- path_is_not("a directory", "path")
38
39#' @export
40#' @rdname assertions-file
41is.writeable <- function(path) {
42  assert_that(is.string(path), file.exists(path))
43  file.access(path, mode = 2)[[1]] == 0
44}
45on_failure(is.writeable) <- path_is_not("writeable", "path")
46
47#' @export
48#' @rdname assertions-file
49is.readable <- function(path) {
50  assert_that(is.string(path), file.exists(path))
51  file.access(path, mode = 4)[[1]] == 0
52}
53on_failure(is.readable) <- path_is_not("readable", "path")
54
55#' @param ext extension to test for (\code{has_extension} only)
56#' @export
57#' @rdname assertions-file
58has_extension <- function(path, ext) {
59  tools::file_ext(path) == ext
60}
61on_failure(has_extension) <- function(call, env) {
62  path <- eval(call$path, env)
63  ext <- eval(call$ext, env)
64  paste0("File '", basename(path), "' does not have extension ", ext)
65}
66