Implement file globbing for workflowr functions.

R/wflow_commit.R

@@ -80,11 +80,12 @@ wflow_commit <- function(files = NULL, message = NULL, all = FALSE,
                          force = FALSE, dry_run = FALSE, project = ".") {
 
   if (!is.null(files)) {
-    if (!is.character(files)) {
+    if (!(is.character(files) && length(files) > 0))
       stop("files must be NULL or a character vector of filenames")
-    } else if (!all(file.exists(files))) {
+    files <- glob(files)
+    if (!all(file.exists(files)))
       stop("Not all files exist. Check the paths to the files")
-    }
+    # Change filepaths to relative paths
     files <- relative(files)
   }
 

R/wflow_convert.R

@@ -78,6 +78,7 @@ wflow_convert <- function(files,
   if (!is.logical(verbose) | length(verbose) != 1)
     stop("verbose must be a one element logical vector")
 
+  files <- glob(files)
   files <- relative(files)
 
   # Check file extensions

R/wflow_open.R

@@ -74,6 +74,7 @@ wflow_open <- function(files,
   if (!(is.null(project) || (is.character(project) && length(project) == 1)))
     stop("project must be NULL or a one element character vector")
 
+  files <- glob(files)
   files <- absolute(files)
   project <- absolute(project)
 

R/wflow_publish.R

@@ -76,11 +76,11 @@ wflow_publish <- function(
   # Check input arguments ------------------------------------------------------
 
   if (!is.null(files)) {
-    if (!is.character(files)) {
+    if (!(is.character(files) && length(files) > 0))
       stop("files must be NULL or a character vector of filenames")
-    } else if (!all(file.exists(files))) {
+    files <- glob(files)
+    if (!all(file.exists(files)))
       stop("Not all files exist. Check the paths to the files")
-    }
     # Change filepaths to relative paths
     files <- relative(files)
   }

R/wflow_remove.R

@@ -51,14 +51,13 @@ wflow_remove <- function(files,
 
   # Check input arguments ------------------------------------------------------
 
-  if (!(is.character(files) && length(files) > 0)) {
+  if (!(is.character(files) && length(files) > 0))
     stop("files must be a character vector of filenames")
-  } else if (!all(file.exists(files))) {
-    stop("files must exist")
-  } else {
-    # Change filepaths to relative paths
-    files <- relative(files)
-  }
+  files <- glob(files)
+  if (!all(file.exists(files)))
+    stop("Not all files exist. Check the paths to the files")
+  # Change filepaths to relative paths
+  files <- relative(files)
 
   if (is.null(message)) {
     message <- deparse(sys.call())
@@ -104,8 +103,9 @@ wflow_remove <- function(files,
   files_rmd <- files_rmd[absolute(files_rmd) ==
                          absolute(file.path(p$analysis, basename(files_rmd)))]
 
-  files_to_remove <- files
-  dirs_to_remove <- character()
+  is_dir <- dir.exists(files)
+  files_to_remove <- files[!is_dir]
+  dirs_to_remove <- files[is_dir]
 
   for (rmd in files_rmd) {
     # Corresponding HTML?

R/wflow_status.R

@@ -94,31 +94,40 @@
 #' }
 #' @export
 wflow_status <- function(files = NULL, project = ".") {
-  if (!(is.null(files) | is.character(files)))
-      stop("files must be NULL or a character vector")
-  if (!is.character(project) | length(project) != 1)
+
+  if (!is.null(files)) {
+    if (!(is.character(files) && length(files) > 0))
+      stop("files must be NULL or a character vector of filenames")
+    if (any(dir.exists(files)))
+      stop("files cannot include a path to a directory")
+    files <- glob(files)
+    if (!all(file.exists(files)))
+      stop("Not all files exist. Check the paths to the files")
+    # Change filepaths to relative paths
+    files <- relative(files)
+    # Check for valid file extensions
+    ext <- tools::file_ext(files)
+    ext_wrong <- !(ext %in% c("Rmd", "rmd"))
+    if (any(ext_wrong))
+      stop(wrap("File extensions must be either Rmd or rmd."))
+  }
+
+  if (!(is.character(project) && length(project) == 1))
     stop("project must be a one element character vector")
   if (!dir.exists(project))
     stop("project does not exist.")
-
-  files <- absolute(files)
   project <- absolute(project)
 
   # Obtain list of workflowr paths. Throw error if no Git repository.
   o <- wflow_paths(error_git = TRUE, project = project)
 
   # Gather analysis files
   # (files that start with an underscore are ignored)
-  files_all <- list.files(path = o$analysis, pattern = "^[^_]")
-  if (o$analysis != ".")
-    files_all <- file.path(o$analysis, files_all)
-  files_all_ext <- tools::file_ext(files_all)
-  files_analysis <- files_all[files_all_ext %in% c("Rmd", "rmd")]
+  files_analysis <- list.files(path = o$analysis, pattern = "^[^_].+Rmd$",
+                          full.names = TRUE)
+  files_analysis <- relative(files_analysis)
 
   if (!is.null(files)) {
-    # Don't know if file paths are relative or absolute, so ensure they are
-    # relative
-    files <- relative(files)
     files_analysis <- files_analysis[match(files, files_analysis)]
   }
   if (length(files_analysis) == 0)

R/wflow_view.R

@@ -63,8 +63,22 @@
 #' @export
 wflow_view <- function(files = NULL, recent = FALSE, dry_run = FALSE,
                        project = ".") {
-  if (!(is.null(files) || (is.character(files) && length(files) >= 1)))
-    stop("files must be NULL or a character vector.")
+
+  if (!is.null(files)) {
+    if (!(is.character(files) && length(files) > 0))
+      stop("files must be NULL or a character vector of filenames")
+    if (any(dir.exists(files)))
+      stop("files cannot include a path to a directory")
+    files <- glob(files)
+    # Change filepaths to relative paths
+    files <- relative(files)
+    # Check for valid file extensions
+    ext <- tools::file_ext(files)
+    ext_wrong <- !(ext %in% c("Rmd", "rmd", "html"))
+    if (any(ext_wrong))
+      stop(wrap("File extensions must be either Rmd, rmd, or html."))
+  }
+
   if (!(is.logical(recent) && length(recent) == 1))
     stop("recent must be a one element logical vector. You entered: ", recent)
   if (!(is.logical(dry_run) && length(dry_run) == 1))
@@ -74,7 +88,6 @@ wflow_view <- function(files = NULL, recent = FALSE, dry_run = FALSE,
   if (!dir.exists(project))
     stop("project does not exist. You entered: ", project)
 
-  files <- absolute(files)
   project <- absolute(project)
 
   p <- wflow_paths(project = project)

tests/testthat/test-glob.R

@@ -5,14 +5,10 @@ context("glob")
 # start project in a tempdir
 site_dir <- tempfile("test-glob-")
 suppressMessages(wflow_start(site_dir, change_wd = FALSE))
-on.exit(unlink(site_dir, recursive = TRUE, force = TRUE))
+if (!interactive()) on.exit(unlink(site_dir, recursive = TRUE, force = TRUE))
 site_dir <- workflowr:::absolute(site_dir)
 s <- wflow_status(project = site_dir)
-
-rmd <- rownames(s$status)
-stopifnot(length(rmd) > 0)
-# Expected html files
-html <- workflowr:::to_html(rmd, outdir = s$docs)
+rmd_glob <- file.path(s$analysis, "*Rmd")
 
 # Test detect_glob -------------------------------------------------------------
 
@@ -68,25 +64,22 @@ test_that("glob does nothing if no globbing detected", {
 })
 
 test_that("glob obtains the same results as Sys.glob for file globs", {
-  glob_str <- file.path(s$analysis, "*Rmd")
-  expected <- Sys.glob(glob_str)
-  actual <- workflowr:::glob(glob_str)
+  expected <- Sys.glob(rmd_glob)
+  actual <- workflowr:::glob(rmd_glob)
   expect_identical(actual, expected)
   expect_true(length(actual) > 0)
 })
 
 test_that("glob can process paths with and without globs", {
-  glob_str <- file.path(s$analysis, "*Rmd")
-  paths <- c(s$root, "a", glob_str, file.path(s$root, "README.md"))
-  expected <- c(s$root, "a", Sys.glob(glob_str), file.path(s$root, "README.md"))
+  paths <- c(s$root, "a", rmd_glob, file.path(s$root, "README.md"))
+  expected <- c(s$root, "a", Sys.glob(rmd_glob), file.path(s$root, "README.md"))
   actual <- workflowr:::glob(paths)
   expect_identical(actual, expected)
 })
 
 test_that("glob does not return duplicates", {
-  glob_str <- file.path(s$analysis, "*Rmd")
-  expected <- Sys.glob(glob_str)
-  actual <- workflowr:::glob(c(glob_str, glob_str))
+  expected <- Sys.glob(rmd_glob)
+  actual <- workflowr:::glob(c(rmd_glob, rmd_glob))
   expect_identical(actual, expected)
 })
 
@@ -101,10 +94,84 @@ test_that("glob throws error for invalid glob", {
 
 # Test file globbing -----------------------------------------------------------
 
+expected <- Sys.glob(rmd_glob)
+
 test_that("wflow_build accepts file globs", {
-  rmd_glob <- file.path(s$analysis, "*Rmd")
-  build_w_glob <- wflow_build(rmd_glob, project = site_dir)
-  expect_identical(Sys.glob(rmd_glob), build_w_glob$built)
-  expect_error(wflow_build(file.path(s$analysis, "bad*blob.Rmd"), project = site_dir),
+  actual <- wflow_build(rmd_glob, dry_run = TRUE, project = site_dir)
+  expect_identical(actual$files, expected)
+  expect_error(wflow_build(file.path(s$analysis, "bad*blob.Rmd"),
+                            dry_run = TRUE, project = site_dir),
+               "Invalid file glob:")
+})
+
+test_that("wflow_commit accepts file globs", {
+  actual <- wflow_commit(rmd_glob, dry_run = TRUE, project = site_dir)
+  expect_identical(actual$files, expected)
+  expect_error(wflow_commit(file.path(s$analysis, "bad*blob.Rmd"),
+                            dry_run = TRUE, project = site_dir),
+               "Invalid file glob:")
+})
+
+test_that("wflow_convert accepts file globs", {
+  actual <- wflow_convert(rmd_glob, dry_run = TRUE)
+  expect_identical(names(actual), expected)
+  expect_error(wflow_convert(file.path(s$analysis, "bad*blob.Rmd"),
+                            dry_run = TRUE),
+               "Invalid file glob:")
+})
+
+
+test_that("wflow_open accepts file globs", {
+  rmd_glob_expanded <- Sys.glob(rmd_glob)
+  open_w_glob <- wflow_open(rmd_glob, change_wd = FALSE, open_file = FALSE,
+                            project = site_dir)
+  expect_identical(open_w_glob, rmd_glob_expanded)
+
+  expect_error(wflow_open(file.path(s$analysis, "bad*blob.Rmd"), project = site_dir),
+               "Invalid file glob:")
+
+  if ("devtools_shims" %in% search())
+    skip("Must be run manually.")
+
+  rmd_new <- file.path(s$analysis, "new.Rmd")
+  on.exit(file.remove(rmd_new))
+  open_w_glob_new <- wflow_open(c(rmd_glob, rmd_new), change_wd = FALSE,
+                                open_file = FALSE, project = site_dir)
+  expect_identical(open_w_glob_new, c(rmd_glob_expanded, rmd_new))
+  expect_true(file.exists(rmd_new))
+})
+
+test_that("wflow_publish accepts file globs", {
+  actual <- wflow_publish(rmd_glob, dry_run = TRUE, project = site_dir)
+  expect_identical(actual$step2$files, expected)
+  expect_error(wflow_publish(file.path(s$analysis, "bad*blob.Rmd"),
+                             dry_run = TRUE, project = site_dir),
+               "Invalid file glob:")
+})
+
+test_that("wflow_remove accepts file globs", {
+  actual <- wflow_remove(rmd_glob, dry_run = TRUE, project = site_dir)
+  expect_identical(actual$files, expected)
+  expect_error(wflow_remove(file.path(s$analysis, "bad*blob.Rmd"),
+                            dry_run = TRUE, project = site_dir),
+               "Invalid file glob:")
+})
+
+test_that("wflow_status accepts file globs", {
+  actual <- wflow_status(rmd_glob, project = site_dir)
+  expect_identical(rownames(actual$status), expected)
+  expect_error(wflow_status(file.path(s$analysis, "bad*blob.Rmd"),
+                            project = site_dir),
+               "Invalid file glob:")
+})
+
+test_that("wflow_view accepts file globs", {
+  html <- workflowr:::to_html(expected, outdir = s$docs)
+  file.create(html)
+  on.exit(file.remove(html))
+  actual <- wflow_view(rmd_glob, dry_run = TRUE, project = site_dir)
+  expect_identical(actual, html)
+  expect_error(wflow_view(file.path(s$analysis, "bad*blob.Rmd"),
+                            dry_run = TRUE, project = site_dir),
                "Invalid file glob:")
 })

tests/testthat/test-wflow_remove.R

@@ -125,7 +125,7 @@ test_that("wflow_remove requires valid argument: files", {
   expect_error(wflow_remove(TRUE),
                "files must be a character vector of filenames")
   expect_error(wflow_remove("nonexistent.Rmd"),
-               "files must exist")
+               "Not all files exist. Check the paths to the files")
 })
 
 test_that("wflow_remove requires valid argument: message", {

tests/testthat/test-wflow_view.R

@@ -70,15 +70,12 @@ test_that("wflow_view ignores paths to files.", {
 
 # Warnings and errors ----------------------------------------------------------
 
-test_that("wflow_view sends warning for wrong file extension.", {
-  expected <- file.path(p$docs, "about.html")
-  expect_warning(actual <- wflow_view(files = c("about.html", "license.x"),
-                       dry_run = TRUE, project = site_dir),
-                 "The following files had invalid extensions and cannot be viewed:")
-  expect_identical(actual, expected)
+test_that("wflow_view throws error for wrong file extension.", {
+  expect_error(wflow_view(files = c("about.html", "license.x"),
+                          dry_run = TRUE, project = site_dir),
+               "File extensions must be either Rmd, rmd, or html.")
 })
 
-
 test_that("wflow_view sends warning for missing file.", {
   expected <- file.path(p$docs, "about.html")
   expect_warning(actual <- wflow_view(files = c("about.html", "missing.html"),
@@ -93,7 +90,7 @@ test_that("wflow_view throws error if no files to view.", {
                "No HTML files were able to viewed.")
   expect_error(suppressWarnings(wflow_view(files = "missing.x",
                                            dry_run = TRUE, project = site_dir)),
-               "None of the files had valid extensions.")
+               "File extensions must be either Rmd, rmd, or html.")
   unlink(file.path(p$docs, "index.html"))
   expect_error(suppressWarnings(wflow_view(dry_run = TRUE, project = site_dir)),
                "No HTML files were able to viewed.")