Merge pull request #54 from lorenzwalthert/parse_comments

* correctly deal with comments (spacing before comments, start comment with space)
* T more flexibly (`test_collection()` and friends now support `...`)

Author: lorenzwalthert

API

@@ -3,8 +3,8 @@
 ## Exported functions
 
 get_transformers(flat, ...)
-get_transformers_flat(strict = TRUE)
-get_transformers_nested(strict = TRUE, indent_by = 2)
+get_transformers_flat(strict = TRUE, start_comments_with_one_space = FALSE)
+get_transformers_nested(strict = TRUE, indent_by = 2, start_comments_with_one_space = FALSE)
 style_pkg(pkg = ".", flat = FALSE, transformers = get_transformers(flat = flat))
 style_src(path = ".", flat = FALSE, recursive = TRUE, transformers = get_transformers(flat = flat))
 style_text(text, flat = FALSE, transformers = get_transformers(flat = flat))

R/get_transformers.R

@@ -18,11 +18,15 @@ get_transformers <- function(flat, ...) {
 #'
 #' @param strict A logical value indicating whether a set of strict
 #'   or not so strict transformer functions should be returned.
+#' @param start_comments_with_one_space Whether or not comments should start
+#'   with only one space (see [start_comments_with_space()]).
 #' @return A list of transformer functions that operate on flat parse
 #'   tables.
 #' @export
 #' @family obtain transformers
-get_transformers_flat <- function(strict = TRUE) {
+#' @importFrom purrr partial
+get_transformers_flat <- function(strict = TRUE,
+                                  start_comments_with_one_space = FALSE) {
   c(
     fix_quotes,
     remove_space_before_closing_paren,
@@ -33,6 +37,8 @@ get_transformers_flat <- function(strict = TRUE) {
     if (strict) set_space_after_comma else add_space_after_comma,
     remove_space_after_unary_pm,
     remove_space_after_opening_paren,
+    partial(start_comments_with_space,
+            force_one = start_comments_with_one_space),
     NULL)
 }
 
@@ -46,12 +52,15 @@ get_transformers_flat <- function(strict = TRUE) {
 #' @family obtain transformers
 #' @importFrom purrr partial
 #' @export
-get_transformers_nested <- function(strict = TRUE, indent_by = 2) {
+get_transformers_nested <- function(strict = TRUE,
+                                    indent_by = 2,
+                                    start_comments_with_one_space = FALSE) {
   c(create_filler,
     partial(indent_round, indent_by = indent_by),
     partial(indent_curly, indent_by = indent_by),
     strip_eol_spaces,
-    get_transformers_flat(strict),
+    get_transformers_flat(strict, start_comments_with_one_space),
+    set_space_before_comments,
     set_space_between_levels
     )
 }

R/nested.R

@@ -47,6 +47,24 @@ tokenize <- function(text) {
   parse_data
 }
 
+#' Helper for setting spaces
+#'
+#' @param spaces_after_prefix An integer vector with the number of spaces
+#'   after the prefix.
+#' @param force_one Whether spaces_after_prefix should be set to one in all
+#'   cases.
+#' @return An integer vector of length spaces_after_prefix, which is either
+#'   one (if `force_one = TRUE`) or `space_after_prefix` with all values
+#'   below one set to one.
+set_spaces <- function(spaces_after_prefix, force_one) {
+  if (force_one) {
+    n_of_spaces <- rep(1, length(spaces_after_prefix))
+  } else {
+    n_of_spaces <- if_else(spaces_after_prefix < 1L, 1L, spaces_after_prefix)
+  }
+  n_of_spaces
+}
+
 
 #' Nest a flat parse table
 #'

R/rules.R

@@ -106,3 +106,41 @@ set_space_between_levels <- function(pd_flat) {
   pd_flat
 }
 
+#' Start comments with a space
+#'
+#' Forces comments to start with a space, that is, after the regular expression
+#'   "^#+'*", at least one space must follow. Multiple spaces may be legit for
+#'   indention in some situations.
+#'
+#' @param pd A parse table.
+#' @param force_one Wheter or not to force one space or allow multiple spaces
+#'   after the regex "^#+'*".
+start_comments_with_space <- function(pd, force_one = FALSE) {
+  comments <- pd %>%
+    filter(token == "COMMENT")
+
+  if (nrow(comments) == 0) return(pd)
+
+  non_comments <- pd %>%
+    filter(token != "COMMENT")
+
+  comments <- comments %>%
+    extract(text, c("prefix", "space_after_prefix", "text"),
+            regex = "^(#+'*)( *)(.*)$") %>%
+    mutate(space_after_prefix = nchar(space_after_prefix),
+           space_after_prefix = set_spaces(space_after_prefix, force_one),
+           text = paste0(prefix, rep_char(" ", space_after_prefix), text),
+           short = substr(text, 1, 5)) %>%
+    select(-space_after_prefix, -prefix)
+  bind_rows(comments, non_comments) %>%
+    arrange(line1, col1)
+}
+
+
+set_space_before_comments <- function(pd_flat) {
+  comment_after <- pd_flat$token == "COMMENT"
+  comment_before <- lead(comment_after, default = FALSE)
+  pd_flat$spaces[comment_before & (pd_flat$newlines == 0L)] <- 1L
+  pd_flat
+
+}

R/serialized_tests.R

@@ -24,7 +24,8 @@
 test_collection <- function(test, sub_test = NULL,
                             write_back = FALSE,
                             write_tree = TRUE,
-                            transformer) {
+                            transformer,
+                            ...) {
   path <- rprojroot::find_testthat_root_file(test)
 
   pattern <- if_else(!is.null(sub_test),
@@ -48,7 +49,8 @@ test_collection <- function(test, sub_test = NULL,
        transform_and_check,
        transformer = transformer,
        write_back = write_back,
-       write_tree = write_tree)
+       write_tree = write_tree,
+       ...)
 }
 
 #' Construct *-out.R from a *-in.R
@@ -83,21 +85,22 @@ construct_tree <- function(in_paths, suffix = "_tree") {
 #'   to the output file.
 #' @param write_tree Whether or not the tree structure of the test should be
 #'   computed and written to a file.
+#' @param ... Parameters passed to transformer function.
 #' @param out_tree Name of tree file if written out.
 #' @importFrom utils write.table
 transform_and_check <- function(in_item, out_item,
                                 in_name = in_item, out_name = out_item,
                                 transformer, write_back,
                                 write_tree = FALSE,
-                                out_tree = "_tree") {
+                                out_tree = "_tree", ...) {
 
   read_in <- utf8::read_lines_enc(in_item)
   if (write_tree) {
     create_tree(read_in) %>%
       write.table(out_tree, col.names = FALSE, row.names = FALSE, quote = FALSE)
   }
   transformed <- read_in %>%
-    transformer()
+    transformer(...)
   transformed <- suppressMessages(utf8::transform_lines_enc(out_item,
     function(x) transformed,
     write_back = write_back))