Merge pull request #195 from jmbarbone/160-fs

160 fs
jmbarbone · Jul 4, 2023 · fac18d4 · fac18d4
2 parents f301540 + b067d88
commit fac18d4
Show file tree

Hide file tree

Showing 8 changed files with 80 additions and 100 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -21,7 +21,7 @@ Depends:
     R (>= 3.6)
 Imports:
     cli,
-    fs,
+    fs (>= 1.6.2),
     fuj (>= 0.1.1),
     magrittr (>= 2.0.1),
     stats (>= 3.6),
@@ -43,7 +43,8 @@ Suggests:
     testthat (>= 3.0.0),
     tibble (>= 3.0.4),
     waldo (>= 0.2.5),
-    withr (>= 2.3.0)
+    withr (>= 2.3.0),
+    xopen
 RoxygenNote: 7.2.3
 Roxygen: list(markdown = TRUE)
 Config/testthat/edition: 3

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,6 @@
 # mark (development version)
 
+* adds greater use of `{fs}` over base file functions [#160](https://github.com/jmbarbone/mark/issues/160)
 * improvements in `todos()` and `fixmes()`
   * File extension can now be set [#170](https://github.com/jmbarbone/mark/issues/170), which by default includes `qmd` ([#163]((https://github.com/jmbarbone/mark/issues/163))) and `py` files
   * new parameter `ignore` to ignore any files

diff --git a/R/directory.R b/R/directory.R
@@ -118,8 +118,8 @@ remove_temp_files <- function(x) {
 norm_path <- function(x = ".", check = FALSE, remove = check) {
   stopifnot(is.character(x))
 
-  paths <- normalizePath(x, winslash = .Platform$file.sep, mustWork = FALSE)
-  ind <- !file.exists(paths)
+  paths <- fs::path_norm(x)
+  ind <- !fs::file_exists(paths)
 
   if (check && any(ind)) {
     warning(cond_norm_path_found(paths[ind]))
@@ -135,14 +135,14 @@ norm_path <- function(x = ".", check = FALSE, remove = check) {
 #' @export
 #' @rdname norm_path
 file_path <- function(..., check = FALSE, remove = check) {
-  fp <- file.path(..., fsep = .Platform$file.sep)
-  norm_path(fp, check = check, remove = remove)
+  norm_path(fs::path(...), check = check, remove = remove)
 }
 
 #' @export
 #' @rdname norm_path
 user_file <- function(..., check = FALSE, remove = check) {
-  file_path(Sys.getenv("R_USER"), ..., check = check, remove = remove)
+  r_user <- norm_path(Sys.getenv("R_USER"), check = TRUE)
+  file_path(r_user, ..., check = check, remove = remove)
 }
 
 #' File information utils
@@ -203,17 +203,17 @@ smallest_file <- function(x) {
 #'
 #' Opens the given files(s)
 #'
-#' @details
-#' `open_file` is an alternative to `shell.exec()` that can take take
-#'   multiple files.
-#' `list_files` and `list_dirs` are mostly wrappers for [base::list.files()] and
-#'   [base::list.dirs()] with preferred defaults and pattern searching on the
-#'   full file path.
+#' @details `open_file` is an alternative to `shell.exec()` that can take take
+#' multiple files. `list_files` and `list_dirs` are mostly wrappers for
+#' [fs::dir_ls()] with preferred defaults and pattern searching on the full file
+#' path.
 #'
 #' `file_open` is simply an alias.
 #'
 #' @inheritParams norm_path
-#' @inheritParams base::list.files
+#' @inheritParams fs::dir_ls
+#' @param pattern,glob Pattern to search for files.  `glob` is absorbed into
+#'   `pattern`, through [utils::glob2rx()].
 #' @param ignore_case logical. Should pattern-matching be case-insensitive?
 #' @param all a logical value. If FALSE, only the names of visible files are
 #'   returned (following Unix-style visibility, that is files whose name does
@@ -223,12 +223,15 @@ smallest_file <- function(x) {
 #' @param negate Logical, if `TRUE` will inversely select files that do not
 #'   match the provided pattern
 #'
-#' @export
 #' @return
 #' * `open_file()`, `shell_exec()`: A logical vector where `TRUE` successfully
-#'   opened, `FALSE` did not and `NA` did not try to open (file not found)
+#' opened, `FALSE` did not and `NA` did not try to open (file not found)
 #' * `list_files()`, `list_dirs()`: A vector of full paths
 #' @name file_utils
+NULL
+
+#' @export
+#' @rdname file_utils
 open_file <- function(x) {
   x <- norm_path(x, check = TRUE)
   out <- rep(NA, length(x))
@@ -243,67 +246,62 @@ file_open <- open_file
 #' @rdname file_utils
 #' @export
 shell_exec <- function(x) {
-  open_fun <- switch(
-    Sys.info()[["sysname"]],
-    Windows = shell.exec, # nolint: object_usage_linter.
-    Linux   = function(file) system2("xdg-open", shQuote(file, "sh")),
-    Darwin  = function(file) system2("xdg-open", shQuote(file, "sh")),
-    stop(cond_shell_exec(Sys.info()[["sysname"]]))
-  )
+  if (is_windows()) {
+    open_fun <- function(path) shell.exec(file = path) # nolint: object_usage_linter, line_length_linter.
+  } else {
+    require_namespace("xopen")
+    open_fun <- function(path) xopen::xopen(target = path)
+  }
 
-  open_fun <- match.fun(open_fun)
   x <- norm_path(x, check = TRUE)
 
-  FUN <- function(file) { # nolint: object_name_linter.
+  do_open_fun <- function(file) {
     inherits(try(open_fun(x), silent = TRUE), "try-error")
   }
 
-  invisible(!vap_lgl(x, FUN))
+  invisible(!vap_lgl(x, do_open_fun))
 }
 
 #' @rdname file_utils
 #' @export
 list_files <- function(
   x = ".",
-  pattern = NULL,
+  pattern = utils::glob2rx(glob),
+  glob = NULL,
   ignore_case = FALSE,
   all = FALSE,
   negate = FALSE,
   basename = FALSE
 ) {
 
+  pattern <- force(pattern) %|||% NULL
   path <- norm_path(x, check = TRUE)
 
   if (length(path) == 1L && is.na(path)) {
     return(NA_character_)
   }
 
-  files <- if (basename && !negate) {
-    # default behavior
-    list.files(
-      path         = path,
-      pattern      = pattern,
-      all.files    = all,
-      full.names   = TRUE,
-      recursive    = all,
-      ignore.case  = ignore_case,
-      include.dirs = FALSE,
-      no..         = TRUE
-    )
-  } else {
-    # If we want the regular expression applied to the entire file
-    # Or if we want to negate the expression
-    list.files(
-      path         = path,
-      pattern      = NULL,
-      all.files    = all,
-      full.names   = TRUE,
-      recursive    = all,
-      ignore.case  = FALSE,
-      include.dirs = FALSE,
-      no..         = FALSE
-    )
-  }
+  files <-
+    if (basename) {
+      # default behavior
+      fs::dir_ls(
+        path        = path,
+        regexp      = pattern,
+        all         = all,
+        recurse     = all,
+        ignore.case = ignore_case,
+        invert      = negate,
+        type        = "file"
+      )
+    } else {
+      # If we want the regular expression applied to the entire file
+      fs::dir_ls(
+        path    = path,
+        all     = all,
+        recurse = all,
+        type    = "file"
+      )
+    }
 
   files <- norm_path(files)
   files <- files[is_file(files)]
@@ -346,13 +344,8 @@ list_dirs <- function(
     return(NA_character_)
   }
 
-  dirs <- norm_path(
-    list.dirs(
-      path         = path,
-      full.names   = TRUE,
-      recursive    = all
-    )
-  )
+  dirs <- fs::dir_ls(path = path, type = "directory", recurse = TRUE)
+  dirs <- norm_path(dirs)
 
   if (is.null(pattern)) {
     return(dirs)
@@ -398,7 +391,7 @@ is_dir <- function(x) {
 #' @export
 is_file <- function(x) {
   stopifnot(!no_length(x), is.character(x))
-  isdir <- file.info(x, extra_cols = FALSE)$isdir
+  isdir <- file.info(x, extra_cols = FALSE)[["isdir"]]
   !is.na(isdir) & !isdir
 }
 
@@ -410,26 +403,23 @@ file_create <- function(x, overwrite = FALSE) {
   }
 
   if (overwrite) {
-    file.remove(x[is_file(x)])
+    fs::file_delete(x[is_file(x)])
   }
 
-  invisible(file.create(x, showWarnings = TRUE))
+  invisible(fs::file_create(x))
 }
 
 dir_create <- function(x, overwrite = FALSE) {
   if (overwrite) {
-    e <- is_dir(x)
-
-    if (any(e)) {
-      for (i in x[e]) {
-        if (dir.exists(i)) {
-          unlink(i, recursive = TRUE)
-        }
+    e <- which(is_dir(x))
+    for (i in e) {
+      if (fs::dir_exists(i)) {
+        fs::dir_delete(i)
       }
     }
   }
 
-  invisible(dir.create(x, showWarnings = TRUE, recursive = TRUE))
+  invisible(fs::dir_create(x))
 }
 
 #' File name
@@ -474,13 +464,13 @@ add_file_timestamp <- function(
   }
 
   bn <- file_name(x)
-  ext <- tools::file_ext(x)
+  ext <- fs::path_ext(x)
 
   if (length(sep) > 1) {
     sep <- collapse0(sep)
   }
 
-  file.path(dirname(x), paste0(bn, sep, ts, if (ext != "") ".", ext))
+  fs::path(dirname(x), paste0(bn, sep, ts, if (ext != "") ".", ext))
 }
 
 # conditions --------------------------------------------------------------
@@ -497,13 +487,6 @@ cond_norm_path_found <- function(paths) {
   )
 }
 
-cond_shell_exec <- function(x) {
-  new_condition(
-    paste0("sysname not recognized:", toString(x)),
-    "shell_exec_sysname"
-  )
-}
-
 cond_file_create_dir <- function(x) {
   new_condition(
     paste0(

diff --git a/R/sourcing.R b/R/sourcing.R
@@ -31,7 +31,7 @@ ksource <- function(file, ..., quiet = TRUE, cd = FALSE, env = parent.frame()) {
   require_namespace("knitr")
   stopifnot(is.environment(env))
   o <- mark_temp("R")
-  on.exit(file.remove(o), add = TRUE)
+  on.exit(fs::file_delete(o), add = TRUE)
   source(knitr::purl(file, output = o, quiet = quiet), chdir = cd, local = env)
 }
 
@@ -136,7 +136,7 @@ eval_named_chunk <- function(rmd_file, label_name) {
 #' @name source_files
 
 source_r_dir <- function(dir, echo = FALSE, quiet = FALSE, ...) {
-  files <- list.files(dir, pattern = "\\.[rR]$", full.names = TRUE)
+  files <- fs::dir_ls(dir, regexp = "\\.[rR]$")
   invisible(lapply(sort(files), source_r_file, q = quiet, ...))
 }
 

diff --git a/R/todos.R b/R/todos.R
@@ -100,25 +100,20 @@ do_todo <- function( # nolint: cyclocomp_linter.
     stop(cond_do_todo_path())
   }
 
-  stopifnot(file.exists(path), length(text) == 1L)
+  stopifnot(fs::file_exists(path), length(text) == 1L)
 
   ls <- list(...)
 
   if (is_dir(path)) {
     if (
       !has_char(path) ||
-      !(force || any(tolower(tools::file_ext(list.files(path))) == "rproj"))
+      !(force || any(tolower(tools::file_ext(fs::dir_ls(path))) == "rproj"))
     ) {
       message("Did not search for TODOS in ", norm_path(path))
       return(invisible(NULL))
     }
 
-    files <- list.files(
-      path,
-      recursive = TRUE,
-      ignore.case = TRUE,
-      full.names = TRUE
-    )
+    files <- fs::dir_ls(path, recurse = TRUE, ignore.case = TRUE)
 
     if (!is.null(ext)) {
       files <- files[tolower(tools::file_ext(files)) %in% tolower(ext)]

diff --git a/man/file_utils.Rd b/man/file_utils.Rd
diff --git a/man/reexports.Rd b/man/reexports.Rd
diff --git a/tests/testthat/test-directory.R b/tests/testthat/test-directory.R
@@ -1,8 +1,8 @@
 
 test_that("tests with temp dir", {
   expect_equal_path <- function(x, y) {
-    x_short <- file.path(basename(dirname(x)), basename(x))
-    y_short <- file.path(basename(dirname(y)), basename(y))
+    x_short <- fs::path(basename(dirname(x)), basename(x))
+    y_short <- fs::path(basename(dirname(y)), basename(y))
 
     expect_true(file.exists(y), info = "Expected path does not exist")
     expect_equal(x_short, y_short)