Merge pull request #233 from jonmcalder/rmd

- Allow styling of Rmd files(#233).

Author: lorenzwalthert

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,78 @@
+#' Transform code from R or Rmd files
+#'
+#' A wrapper for [utf8::transform_lines_enc()] which initiates the styling of
+#' either R or Rmd files by passing the relevant transformer function for each
+#' case.
+#'
+#' @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(path, " is not an R or Rmd file")
+  }
+}
+
+#' Transform Rmd contents
+#'
+#' Applies the supplied transformer function to code chunks identified within
+#' an Rmd file and recombines the resulting (styled) code chunks with the text
+#' chunks.
+#'
+#' @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 chunks within Rmd contents
+#'
+#' Identifies the code and text chunks within an Rmd file, and returns these
+#' as a nested list.
+#'
+#' @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

@@ -144,16 +144,6 @@ style_file <- function(path,
                        transformers = style(...)) {
   withr::with_dir(
     dirname(path),
-    prettify_one(transformers, basename(path))
+    transform_files(basename(path), transformers)
   )
 }
-
-#' Prettify one R file
-#'
-#' This is a helper function for style_dir.
-#' @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")
-  transform_files(path, transformers)
-}