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