Merge pull request #292 from jonmcalder/style-dir

- `style_dir()` and `style_pkg()` now also handle `.Rmd` files (#292, @jonmcalder).

Author: krlmlr

API

@@ -6,9 +6,9 @@ create_style_guide(initialize = initialize_attributes, line_break = NULL, space
 regex_none()
 specify_math_token_spacing(zero = NULL, one = c("'+'", "'-'", "'*'", "'/'", "'^'"))
 specify_reindention(regex_pattern = regex_none(), indention = 0, comments_only = TRUE)
-style_dir(path = ".", ..., style = tidyverse_style, transformers = style(...), recursive = TRUE, exclude_files = NULL)
+style_dir(path = ".", ..., style = tidyverse_style, transformers = style(...), filetype = "R", recursive = TRUE, exclude_files = NULL)
 style_file(path, ..., style = tidyverse_style, transformers = style(...))
-style_pkg(pkg = ".", ..., style = tidyverse_style, transformers = style(...), exclude_files = "R/RcppExports.R")
+style_pkg(pkg = ".", ..., style = tidyverse_style, transformers = style(...), filetype = "R", exclude_files = "R/RcppExports.R")
 style_text(text, ..., style = tidyverse_style, transformers = style(...))
 tidyverse_math_token_spacing()
 tidyverse_reindention()

DESCRIPTION

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

R/expr-is.R

@@ -1,4 +1,4 @@
-#' Check whether a parse table corresponds to a a certain expression
+#' Check whether a parse table corresponds to a certain expression
 #'
 #' @param pd A parse table.
 #' @name pd_is
@@ -39,7 +39,7 @@ contains_else_expr <- function(pd) {
 #' Checks whether an else expression in a nest needs braces. Note that for
 #' if-else-if expressions, there is no need to add braces since the if in
 #' else-if will be visited separately with the visitor. This applies to all
-#' conditional statmements with more than one alternative.
+#' conditional statements with more than one alternative.
 #' @param pd A parse table
 contains_else_expr_that_needs_braces <- function(pd) {
   else_idx <- which(pd$token == "ELSE")

R/serialized_tests.R

@@ -187,6 +187,7 @@ testthat_file <- function(...) {
   file.path(rprojroot::find_testthat_root_file(), ...)
 }
 
+
 #' Copy a file to a temporary directory
 #'
 #' Takes the path to a file as input and returns the path where the temporary
@@ -201,25 +202,6 @@ copy_to_tempdir <- function(path_perm = testthat_file()) {
 }
 
 
-#' Set arguments
-#' @param write_tree Whether or not to write tree.
-#' @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-assert-args.R

@@ -0,0 +1,73 @@
+#' Set the write_tree argument
+#'
+#' 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.
+#' @param write_tree Whether or not to write tree.
+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 the file type argument
+#'
+#' Sets and asserts the file type argument to a standard format for further internal
+#' processing.
+#' @param filetype A character vector with file types to convert to the internal
+#'   standard format.
+#' @examples
+#' styler:::set_and_assert_arg_filetype("rMd")
+#' \dontrun{
+#' styler:::set_and_assert_arg_filetype("xyz")
+#' }
+set_and_assert_arg_filetype <- function(filetype) {
+  without_dot <- gsub("^\\.", "", tolower(filetype))
+  assert_filetype(without_dot)
+  paste0("\\.", without_dot)
+}
+
+#' Make sure all supplied file types are allowed
+#'
+#' @param lowercase_filetype A vector with file types to check, all lower case.
+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
+    )
+  }
+}
+
+
+#' Assert text to be of positive length and replace it with the empty
+#' string otherwise.
+#' @param text The input to style.
+assert_text <- function(text) {
+  if (length(text) < 1) {
+    text <- ""
+  }
+  text
+}
+
+
+#' Check token validity
+#'
+#' Check whether one or more tokens exist and have a unique token-text mapping
+#' @param tokens Tokens to check.
+assert_tokens <- function(tokens) {
+  invalid_tokens <- tokens[!(tokens %in% lookup_tokens()$token)]
+  if (length(invalid_tokens) > 0) {
+    stop(
+      "Token(s) ", paste0(invalid_tokens, collapse = ", "), " are invalid. ",
+      "You can lookup all valid tokens and their text ",
+      "with styler:::lookup_tokens(). Make sure you supply the values of ",
+      "the column 'token', not 'text'."
+    )
+  }
+}
+

R/style_guides.R

@@ -285,19 +285,3 @@ specify_math_token_spacing <-
 tidyverse_math_token_spacing <- function() {
   specify_math_token_spacing(one = c("'+'", "'-'", "'*'", "'/'", "'^'"))
 }
-
-#' Check token validity
-#'
-#' Check whether one or more tokens exist and have a unique token-text mapping
-#' @param tokens Tokens to check.
-assert_tokens <- function(tokens) {
-  invalid_tokens <- tokens[!(tokens %in% lookup_tokens()$token)]
-  if (length(invalid_tokens) > 0) {
-    stop(
-      "Token(s) ", paste0(invalid_tokens, collapse = ", "), " are invalid. ",
-      "You can lookup all valid tokens and their text ",
-      "with styler:::looup_tokens(). Make sure you supply the values of ",
-      "the column 'token', not 'text'."
-    )
-  }
-}

R/ui.R

@@ -18,6 +18,9 @@ NULL
 #' @param transformers A set of transformer functions. This argument is most
 #'   conveniently constructed via the `style` argument and `...`. See
 #'   'Examples'.
+#' @param filetype Vector of file extensions indicating which filetypes should
+#'   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:
@@ -37,25 +40,36 @@ style_pkg <- function(pkg = ".",
                       ...,
                       style = tidyverse_style,
                       transformers = style(...),
+                      filetype = "R",
                       exclude_files = "R/RcppExports.R") {
   pkg_root <- rprojroot::find_package_root_file(path = pkg)
-  changed <- withr::with_dir(pkg_root, prettify_local(transformers, exclude_files))
+  changed <- withr::with_dir(pkg_root,
+    prettify_pkg(transformers, filetype, exclude_files)
+  )
   invisible(changed)
 }
 
-prettify_local <- function(transformers, exclude_files) {
-  r_files <- dir(
-    path = "R", pattern = "[.][rR]$", recursive = TRUE, full.names = TRUE
-  )
+prettify_pkg <- function(transformers, filetype, exclude_files) {
 
-  r_files <- grep("/RcppExports[.]R$", r_files, invert = TRUE, value = TRUE)
-  test_files <- dir(
-    path = "tests/testthat", pattern = "[.][rR]$",
-    recursive = TRUE, full.names = TRUE
-  )
+  filetype <- set_and_assert_arg_filetype(filetype)
+  r_files <- vignette_files <- readme <- NULL
 
-  files <- setdiff(c(r_files, test_files), exclude_files)
+  if ("\\.r" %in% filetype) {
+    r_files <- dir(
+      path = c("R", "tests", "data-raw"), pattern = "\\.r$",
+      ignore.case = TRUE, recursive = TRUE, full.names = TRUE
+    )
+  }
 
+  if ("\\.rmd" %in% filetype) {
+    vignette_files <- dir(
+      path = "vignettes", pattern = "\\.rmd$",
+      ignore.case = TRUE, recursive = TRUE, full.names = TRUE
+    )
+    readme <- dir(pattern = "^readme\\.rmd$", ignore.case = TRUE)
+  }
+
+  files <- setdiff(c(r_files, vignette_files, readme), exclude_files)
   transform_files(files, transformers)
 }
 
@@ -103,10 +117,11 @@ style_dir <- function(path = ".",
                       ...,
                       style = tidyverse_style,
                       transformers = style(...),
+                      filetype = "R",
                       recursive = TRUE,
                       exclude_files = NULL) {
   changed <- withr::with_dir(
-    path, prettify_any(transformers, recursive, exclude_files)
+    path, prettify_any(transformers, filetype, recursive, exclude_files)
   )
   invisible(changed)
 }
@@ -117,12 +132,12 @@ style_dir <- function(path = ".",
 #' @inheritParams style_pkg
 #' @param recursive A logical value indicating whether or not files in subdirectories
 #'   should be styled as well.
-prettify_any <- function(transformers, recursive, exclude_files) {
+prettify_any <- function(transformers, filetype, recursive, exclude_files) {
   files <- dir(
-    path = ".", pattern = "[.][rR]$", recursive = recursive, full.names = TRUE
+    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

@@ -40,16 +40,6 @@ calls_sys <- function(sys_call, ...) {
   }
 }
 
-#' Assert text to be of positive length and replace it with the empty
-#' string otherwise.
-#' @param text The input to style.
-assert_text <- function(text) {
-  if (length(text) < 1) {
-    text <- ""
-  }
-  text
-}
-
 is_plain_r_file <- function(path) {
   grepl("\\.R$", path, ignore.case = TRUE)
 }
@@ -85,3 +75,12 @@ extend_if_comment <- function(pd, pos) {
     pos
   }
 }
+
+#' Map the file type to a corresponding regular expression
+#'
+#' @param filetype The file type to map to a regex.
+#' @examples
+#' styler:::map_filetype_to_pattern(c(".rMd", "R"))
+map_filetype_to_pattern <- function(filetype) {
+  paste0("(", paste(set_and_assert_arg_filetype(filetype), collapse = "|"), ")$")
+}