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