Add functions to allow for styling of Rmd files

Author: jonmcalder

DESCRIPTION

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

NAMESPACE

@@ -27,5 +27,6 @@ importFrom(purrr,pwalk)
 importFrom(purrr,reduce)
 importFrom(purrr,when)
 importFrom(rlang,seq2)
+importFrom(tibble,lst)
 importFrom(utils,tail)
 importFrom(utils,write.table)

R/style_rmd.R

@@ -0,0 +1,68 @@
+#' 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
+#' @importFrom tibble lst
+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)
 }