Update to allow styling of Rmd files

DESCRIPTION

@@ -54,6 +54,7 @@ Collate:
     'serialize.R'
     'serialized_tests.R'
     'style_guides.R'
+    'style_rmd.R'
     'styler.R'
     'token-create.R'
     'transform.R'

R/style_rmd.R

@@ -0,0 +1,67 @@
+#' Transform code from R or Rmd files
+#'
+#' @inheritParams utf8::transform_lines_enc
+#' @param ... Further arguments passed to `utf8::transform_lines_enc()`.
+transform_code <- function(path, fun, verbose, ...) {
+  if (grepl("\\.R$", path, ignore.case = TRUE)) {
+    utf8::transform_lines_enc(path, fun = fun, ...)
+  } else if (grepl("\\.Rmd$", path, ignore.case = TRUE)) {
+    utf8::transform_lines_enc(path, fun = partial(transform_rmd, transformer_fun = fun), ...)
+  } else {
+    stop("")
+  }
+}
+
+#' Transform Rmd contents with a transformer function
+#'
+#' @param lines A character vector of lines from an Rmd file
+#' @param transformer_fun A styler transformer function
+#' @importFrom purrr flatten_chr
+transform_rmd <- function(lines, transformer_fun) {
+  chunks <- identify_chunks(lines)
+  chunks$r_chunks <- map(chunks$r_chunks, transformer_fun)
+
+  map2(chunks$text_chunks, c(chunks$r_chunks, list(character(0))), c) %>%
+    flatten_chr()
+}
+
+
+#' Identify R and text chunks within an Rmd
+#'
+#' @param lines a character vector of lines from an Rmd file
+#'
+#' @importFrom purrr map2
+#' @importFrom rlang seq2
+identify_chunks <- function(lines) {
+  pattern <- get_knitr_pattern(lines)
+  if (is.null(pattern$chunk.begin) || is.null(pattern$chunk.end)) {
+    stop("Unrecognized chunk pattern!", call. = FALSE)
+  }
+
+  starts <- grep(pattern$chunk.begin, lines, perl = TRUE)
+  ends <- grep(pattern$chunk.end, lines, perl = TRUE)
+
+  if (length(starts) != length(ends)) {
+    stop("Malformed file!", call. = FALSE)
+  }
+
+  r_chunks <- map2(starts, ends, ~lines[seq2(.x + 1, .y - 1)])
+
+  text_chunks <- map2(c(1, ends), c(starts, length(lines)), ~lines[seq2(.x, .y)])
+
+  lst(r_chunks, text_chunks)
+}
+
+#' Get chunk pattern
+#'
+#' Determine a regex pattern for identifying R code chunks
+#'
+#' @inheritParams identify_chunks
+get_knitr_pattern <- function(lines) {
+  pattern <- knitr:::detect_pattern(lines, "rmd")
+  if (!is.null(pattern)) {
+    knitr::all_patterns[[pattern]]
+  } else {
+    NULL
+  }
+}

R/transform.R

@@ -27,9 +27,9 @@ transform_files <- function(files, transformers) {
   invisible(changed)
 }
 
-#' Transform a file an give customized message
+#' Transform a file and output a customized message
 #'
-#' Wraps `utf8::transform_lines_enc()` and gives customized messages.
+#' Wraps `utf8::transform_lines_enc()` and outputs customized messages.
 #' @param max_char_path The number of characters of the longest path. Determines
 #'   the indention level of `message_after`.
 #' @param message_before The message to print before the path.
@@ -51,7 +51,7 @@ transform_file <- function(path,
   n_spaces_before_message_after <-
     max_char_after_message_path - char_after_path
   message(message_before, path, ".", appendLF = FALSE)
-  changed <- utf8::transform_lines_enc(path, fun = fun, verbose = verbose, ...)
+  changed <- transform_code(path, fun = fun, verbose = verbose, ...)
 
   message(
     rep(" ", max(0, n_spaces_before_message_after)),

R/ws.R

@@ -155,6 +155,7 @@ style_file <- function(path,
 #' @inheritParams style_dir
 #' @param path The path to a file that should be styled.
 prettify_one <- function(transformers, path) {
-  if (!grepl("\\.[Rr]$", path)) stop(path, " is not a .R file")
+  if (!grepl("\\.[r](md)?$", path, ignore.case = TRUE))
+    stop(path, " is not an R or Rmd file")
   transform_files(path, transformers)
 }

tests/testthat/public-api/xyzfile_rmd/random.Rmd

@@ -0,0 +1,18 @@
+Some text
+```{r}
+# Some R code
+f <- function(x) {
+  x
+}
+```
+More text
+```{r}
+# More R code
+g <- function(y) {
+  y
+}
+```
+Final text
+```{r}
+1 + 2
+```

tests/testthat/public-api/xyzfile_rmd/random2.Rmd

@@ -0,0 +1,18 @@
+```{r}
+# Start with chunk
+```
+Some text before empty chunk
+```{r}
+
+```
+Final text before longer code chunk
+This text chunk has multiple lines
+```{r}
+# random
+this(is_a_call(x))
+if (x) {
+  r()
+  a    <- 3
+  bcds <- 5
+}
+```

tests/testthat/public-api/xyzfile_rmd/random3.Rmd

@@ -0,0 +1,17 @@
+Some text
+```{r}
+# Some R code
+f <- function(x) {
+  x
+}
+```
+More text before malformed chunk
+# More R code
+g <- function(y) {
+  y
+}
+```
+Final text
+```{r}
+1 + 2
+```

tests/testthat/public-api/xyzfile_rmd/random4.Rmd

@@ -0,0 +1,17 @@
+Some text
+```{r}
+# Some R code
+f <- function(x) {
+  x
+}
+```
+More text
+```{r}
+# More R code which is invalid
+g <- function(y) {
+  y
+```
+Final text
+```{r}
+1 + 2
+```

tests/testthat/test-public_api.R

@@ -27,3 +27,23 @@ test_that("styler does not return error when there is no file to style", {
 
 # styling active region cannot be tested automatically since
 # rstudioapi::insertText() needs the context id.
+
+context("public API - Rmd")
+
+test_that("styler can style Rmd file", {
+  expect_false(
+    style_file(testthat_file("public-api", "xyzfile_rmd", "random.Rmd"), strict = FALSE)
+  )
+  expect_false(
+    style_file(testthat_file("public-api", "xyzfile_rmd", "random2.Rmd"), strict = FALSE)
+  )
+})
+
+test_that("styler handles malformed Rmd file and invalid R code in chunk", {
+  expect_warning(
+    style_file(testthat_file("public-api", "xyzfile_rmd", "random3.Rmd"), strict = FALSE)
+  )
+  expect_warning(
+    style_file(testthat_file("public-api", "xyzfile_rmd", "random4.Rmd"), strict = FALSE)
+  )
+})