Merge pull request #516 from kcphila/revised-add-spaces

Revised add spaces
lorenzwalthert · Oct 12, 2023 · e989416 · e989416
2 parents 98cb63a + 44ed0e2
commit e989416
Show file tree

Hide file tree

Showing 21 changed files with 121 additions and 9 deletions.
diff --git a/API b/API
@@ -11,6 +11,7 @@ open_config(root = here::here())
 open_wordlist(root = here::here())
 path_pre_commit_exec(check_if_exists = TRUE)
 path_precommit_exec(check_if_exists = TRUE)
+precommit_docopt(doc, args = commandArgs(trailingOnly = TRUE), ...)
 robust_purl(path)
 roxygen_assert_additional_dependencies()
 roxygenize_with_cache(key, dirs)

diff --git a/NAMESPACE b/NAMESPACE
@@ -9,6 +9,7 @@ export(open_config)
 export(open_wordlist)
 export(path_pre_commit_exec)
 export(path_precommit_exec)
+export(precommit_docopt)
 export(robust_purl)
 export(roxygen_assert_additional_dependencies)
 export(roxygenize_with_cache)

diff --git a/R/testing.R b/R/testing.R
@@ -146,6 +146,11 @@ hook_state_create <- function(tempdir,
   withr::local_dir(tempdir)
   files <- fs::path_rel(path_candidate_temp, tempdir)
   # https://stat.ethz.ch/pipermail/r-devel/2018-February/075507.html
+
+  # quote any individual filenames with spaces so the shell identifies them
+  # each as a single term
+  files <- shQuote(files)
+
   system2(paste0(Sys.getenv("R_HOME"), "/bin/Rscript"),
     args = as.character(c(path_executable, cmd_args, files)),
     stderr = path_stderr, stdout = path_stdout, env = env

diff --git a/R/utils.R b/R/utils.R
@@ -83,6 +83,27 @@ git_init <- function(path = ".") {
   )
 }
 
+#' Provide a singular interface for hook calls to docopt
+#'
+#' docopt provides different processing for a single string
+#' than an array/vector. As `"string"`` and `c("string")`
+#' are semantically equivalent in R, this can create problems
+#' when a single parameter is provided. Thus, this function
+#' wraps docopt to ensure that the args will always be
+#' interpreted as a vector.
+#'
+#' This function is only exported for use in hook scripts, but it's not intended
+#' to be called by the end-user directly.
+#' @param doc `character` vector with command line specification.
+#' @param args `character` vector of command line arguments.
+#'   Defaults to `commandArgs(trailingOnly=TRUE)`.
+#' @param ... Additional parameters passed to `docopt`.
+#' @family hook script helpers
+#' @keywords internal
+#' @export
+precommit_docopt <- function(doc, args = commandArgs(trailingOnly = TRUE), ...) {
+  docopt::docopt(doc, c(args, ""), ...)
+}
 
 #' Read the refs corresponding to a hooks repo
 #' @keywords internal

diff --git a/inst/hooks/exported/codemeta-description-updated.R b/inst/hooks/exported/codemeta-description-updated.R
@@ -13,7 +13,7 @@ Options:
 " -> doc
 
 
-arguments <- docopt::docopt(doc)
+arguments <- precommit::precommit_docopt(doc)
 setwd(arguments$root)
 
 # adapted from https://github.com/lorenzwalthert/precommit/blob/f4413cfe6282c84f7176160d06e1560860c8bd3d/inst/hooks/exported/readme-rmd-rendered

diff --git a/inst/hooks/exported/deps-in-desc.R b/inst/hooks/exported/deps-in-desc.R
@@ -17,7 +17,7 @@ pre_installed <- c(
   "survival", "tcltk", "tools", "utils"
 )
 
-arguments <- docopt::docopt(doc)
+arguments <- precommit::precommit_docopt(doc)
 arguments$files <- normalizePath(arguments$files) # because working directory changes to root
 setwd(normalizePath(arguments$root))
 deps_in_desc <- function(file, arguments) {

diff --git a/inst/hooks/exported/lintr.R b/inst/hooks/exported/lintr.R
@@ -10,7 +10,7 @@ Options:
                Otherwise, lints will never be shown to the user.
 " -> doc
 
-arguments <- docopt::docopt(doc)
+arguments <- precommit::precommit_docopt(doc)
 
 lintr_staged <- grepl(
   "modified:.*\\.lintr", system2("git", "status", stdout = TRUE)

diff --git a/inst/hooks/exported/roxygenize.R b/inst/hooks/exported/roxygenize.R
@@ -21,7 +21,7 @@ Options:
   --root=<root_>  Path relative to the git root that contains the R package root [default: .].
 
 " -> doc
-arguments <- docopt::docopt(doc)
+arguments <- precommit::precommit_docopt(doc)
 arguments$files <- normalizePath(arguments$files) # because working directory changes to root
 setwd(arguments$root)
 

diff --git a/inst/hooks/exported/spell-check.R b/inst/hooks/exported/spell-check.R
@@ -9,7 +9,7 @@ Options:
 
 " -> doc
 
-arguments <- docopt::docopt(doc)
+arguments <- precommit::precommit_docopt(doc)
 path_wordlist <- file.path("inst", "WORDLIST")
 files <- arguments$files
 if (file.exists(path_wordlist)) {

diff --git a/inst/hooks/exported/style-files.R b/inst/hooks/exported/style-files.R
@@ -38,7 +38,7 @@ if (length(keys) > 0) {
   doc <- gsub("<files>...", insert, paste0(doc, paste(key_value_pairs, collapse = "\n")))
 }
 
-arguments <- docopt::docopt(doc, args)
+arguments <- precommit::precommit_docopt(doc, args)
 if (packageVersion("styler") < "1.3.2") {
   stop(
     "Your styler version is outdated. ",

diff --git a/inst/hooks/exported/use-tidy-description.R b/inst/hooks/exported/use-tidy-description.R
@@ -12,7 +12,7 @@ Options:
 " -> doc
 
 
-arguments <- docopt::docopt(doc)
+arguments <- precommit::precommit_docopt(doc)
 setwd(arguments$root)
 
 if (!file.exists("DESCRIPTION")) {

diff --git a/inst/hooks/local/consistent-release-tag.R b/inst/hooks/local/consistent-release-tag.R
@@ -6,7 +6,7 @@ Usage:
   consistent-release-tag [--release-mode] [<files>...]
 
 " -> doc
-arguments <- docopt::docopt(doc)
+arguments <- precommit::precommit_docopt(doc)
 
 
 # This hook checks that all versions in config files and the git tag that

diff --git a/man/diff_requires_run_roxygenize.Rd b/man/diff_requires_run_roxygenize.Rd
diff --git a/man/dirs_R.cache.Rd b/man/dirs_R.cache.Rd
diff --git a/man/may_require_permanent_cache.Rd b/man/may_require_permanent_cache.Rd
diff --git a/man/precommit_docopt.Rd b/man/precommit_docopt.Rd
diff --git a/man/robust_purl.Rd b/man/robust_purl.Rd
diff --git a/man/roxygen_assert_additional_dependencies.Rd b/man/roxygen_assert_additional_dependencies.Rd
diff --git a/man/roxygenize_with_cache.Rd b/man/roxygenize_with_cache.Rd
diff --git a/tests/testthat/test-docopt.R b/tests/testthat/test-docopt.R
@@ -0,0 +1,39 @@
+test_that("custom docopt interface parses as expected", {
+  args_variants <- list(
+    "file a.R",
+    c("file a.R", "file-B.R"),
+    c("File A.R", "File c.R"),
+    c("Another file with spaces.R", "--warn_only"),
+    c("Another file with spaces.R", "Yet another file with spaces (YAFWS).R", "--warn_only"),
+    c("--warn_only", "Another file with spaces.R"),
+    c("--warn_only", "Another file with spaces.R", "Yet another file with spaces (YAFWS).R"),
+    c("Another file with spaces.R", "--warn_only", "Yet another file with spaces (YAFWS).R")
+  )
+
+  "Run lintr on R files during a precommit.
+Usage:
+  cmdtest [--warn_only] <files>...
+Options:
+  --warn_only  Placeholder for test.
+" -> doc
+
+  for (args in args_variants) {
+    new_args <- precommit_docopt(doc, args)
+
+    # to show failures in vanilla docopt, use this:
+    # new_args <- docopt::docopt(doc, args)
+
+    expect_equal(length(new_args), 4)
+    if ("--warn_only" %in% args) {
+      expect_equal(length(new_args$files), length(args) - 1)
+      expect_equal(length(new_args$`<files>`), length(args) - 1)
+      expect_true(new_args$warn_only)
+      expect_true(new_args$`--warn_only`)
+    } else {
+      expect_equal(length(new_args$files), length(args))
+      expect_equal(length(new_args$`<files>`), length(args))
+      expect_false(new_args$warn_only)
+      expect_false(new_args$`--warn_only`)
+    }
+  }
+})
diff --git a/tests/testthat/test-hooks.R b/tests/testthat/test-hooks.R
@@ -140,7 +140,6 @@ run_test("style-files",
   )
 )
 
-
 ### . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ..
 ### no-browser-statement                                                    ####
 # success
@@ -214,6 +213,7 @@ run_test(
   std_err = "1 1"
 )
 
+
 ### . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ..
 ### spell-check                                                             ####
 # success