Set (and assert) filetype, handle optional dot in file extension & encapsulate/re-organise with helper functions plus extend tests

Author: jonmcalder

DESCRIPTION

@@ -54,6 +54,7 @@ Collate:
     'rules-spacing.R'
     'serialize.R'
     'serialized_tests.R'
+    'set-args.R'
     'style_guides.R'
     'styler.R'
     'token-create.R'

R/serialized_tests.R

@@ -206,20 +206,6 @@ copy_to_tempdir <- function(path_perm = testthat_file()) {
 #' @name set_args
 NULL
 
-#' @describeIn set_args Sets the argument `write_tree` in
-#'   [test_collection()] to be `TRUE` for R versions higher or equal to 3.2, and
-#'   `FALSE` otherwise since the second-level dependency `DiagrammeR` from
-#'   `data.table` is not available for R < 3.2.
-set_arg_write_tree <- function(write_tree) {
-  sufficient_version <- getRversion() >= 3.2
-  if (is.na(write_tree)) {
-    write_tree <- ifelse(sufficient_version, TRUE, FALSE)
-  } else if (!sufficient_version & write_tree) {
-    stop_insufficient_r_version()
-  }
-  write_tree
-}
-
 stop_insufficient_r_version <- function() {
   stop(paste0(
     "Can't write tree with R version ", getRversion(),

R/set-args.R

@@ -0,0 +1,29 @@
+
+#' @describeIn set_args Sets the argument `write_tree` in
+#'   [test_collection()] to be `TRUE` for R versions higher or equal to 3.2, and
+#'   `FALSE` otherwise since the second-level dependency `DiagrammeR` from
+#'   `data.table` is not available for R < 3.2.
+set_arg_write_tree <- function(write_tree) {
+  sufficient_version <- getRversion() >= 3.2
+  if (is.na(write_tree)) {
+    write_tree <- ifelse(sufficient_version, TRUE, FALSE)
+  } else if (!sufficient_version & write_tree) {
+    stop_insufficient_r_version()
+  }
+  write_tree
+}
+
+set_and_assert_filetype <- function(filetype) {
+  without_dot <- gsub("^\\.", "", tolower(filetype))
+  assert_filetype(without_dot)
+  paste0("\\.", without_dot)
+}
+
+assert_filetype <- function(lowercase_filetype) {
+  if (!all(lowercase_filetype %in% c("r", "rmd"))) {
+    stop(
+      "filetype must not contain other values than 'R'",
+      "or 'Rmd' (case is ignored).", call. = FALSE
+    )
+  }
+}

R/ui.R

@@ -19,7 +19,8 @@ NULL
 #'   conveniently constructed via the `style` argument and `...`. See
 #'   'Examples'.
 #' @param filetype Vector of file extensions indicating which filetypes should
-#'   be styled e.g. c("R", "Rmd")
+#'   be styled. Case is ignored, and the `.` is optional, e.g. c(".R", ".Rmd")
+#'   or c("r", "rmd").
 #' @param exclude_files Character vector with paths to files that should be
 #'   excluded from styling.
 #' @section Warning:
@@ -123,12 +124,10 @@ style_dir <- function(path = ".",
 #'   should be styled as well.
 prettify_any <- function(transformers, filetype, recursive, exclude_files) {
   files <- dir(
-    path = ".",
-    pattern = paste0("(", paste(filetype, collapse = "|"), ")$"),
+    path = ".", pattern = map_filetype_to_pattern(filetype),
     ignore.case = TRUE, recursive = recursive, full.names = TRUE
   )
   transform_files(setdiff(files, exclude_files), transformers)
-
 }
 
 #' Style `.R` and/or `.Rmd` files

R/utils.R

@@ -85,3 +85,7 @@ extend_if_comment <- function(pd, pos) {
     pos
   }
 }
+
+map_filetype_to_pattern <- function(filetype) {
+  paste0("(", paste(set_and_assert_filetype(filetype), collapse = "|"), ")$")
+}

man/prettify_any.Rd

@@ -97,11 +97,28 @@ test_that("messages (via cat()) of style_file are correct", {
 
 context("public API - Rmd in style_dir()")
 
-test_that("styler can style Rmd fie via style_dir()", {
+test_that("styler can style R and Rmd files via style_dir()", {
   msg <- capture_messages(
     style_dir(testthat_file("public-api", "xyz-r-and-rmd-dir"),
               filetype = c("R", "Rmd"))
   )
   expect_true(any(grepl("random-script-in-sub-dir.R", msg, fixed = TRUE)))
   expect_true(any(grepl("random-rmd-script.Rmd", msg, fixed = TRUE)))
 })
+
+test_that("styler can style Rmd files only via style_dir()", {
+  msg <- capture_messages(
+    style_dir(testthat_file("public-api", "xyz-r-and-rmd-dir"),
+              filetype = "Rmd")
+  )
+  expect_true(any(grepl("random-rmd-script.Rmd", msg, fixed = TRUE)))
+})
+
+test_that("styler can style .r and .rmd files via style_dir()", {
+  msg <- capture_messages(
+    style_dir(testthat_file("public-api", "xyz-r-and-rmd-dir"),
+              filetype = c(".r", ".rmd"))
+  )
+  expect_true(any(grepl("random-script-in-sub-dir.R", msg, fixed = TRUE)))
+  expect_true(any(grepl("random-rmd-script.Rmd", msg, fixed = TRUE)))
+})