Merge pull request #279 from lorenzwalthert/use-next-non-comment

- Fix token insertion / comment interaction (#279).

Author: lorenzwalthert

R/expr-is.R

@@ -28,3 +28,32 @@ is_function_dec <- function(pd) {
   if (is.null(pd)) return(FALSE)
   pd$token[1] == "FUNCTION"
 }
+
+
+contains_else_expr <- function(pd) {
+  any(pd$token == "ELSE")
+}
+
+#' Check whether an else expression needs braces
+#'
+#' 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 statents with more than one alternative.
+#' @param pd A parse table
+contains_else_expr_that_needs_braces <- function(pd) {
+  else_idx <- which(pd$token == "ELSE")
+  if (length(else_idx) > 0) {
+    non_comment_after_else <- next_non_comment(pd, else_idx)
+    sub_expr <- pd$child[[non_comment_after_else]]
+    # needs braces if NOT if_condition, NOT curly expr
+    !is_cond_expr(sub_expr) &&  !is_curly_expr(sub_expr)
+  } else {
+    FALSE
+  }
+}
+
+
+is_cond_expr <- function(pd) {
+  pd$token[1] == "IF"
+}

R/indent.R

@@ -78,18 +78,21 @@ indent_without_paren_for_while_fun <- function(pd, indent_by) {
 #' @describeIn update_indention Is used to indent if and if-else statements.
 #' @importFrom rlang seq2
 indent_without_paren_if_else <- function(pd, indent_by) {
+  expr_after_if <- next_non_comment(pd, which(pd$token == "')'")[1])
   has_if_without_curly <-
-    pd$token[1] %in% c("IF", "WHILE") && pd$child[[5]]$token[1] != "'{'"
+    pd$token[1] %in% "IF" && pd$child[[expr_after_if]]$token[1] != "'{'"
   if (has_if_without_curly) {
-    pd$indent[5] <- indent_by
+    pd$indent[expr_after_if] <- indent_by
   }
 
+  else_idx <- which(pd$token == "ELSE")
+  expr_after_else_idx <- next_non_comment(pd, else_idx)
   has_else_without_curly_or_else_chid <-
     any(pd$token == "ELSE") &&
-    pd$child[[7]]$token[1] != "'{'" &&
-    pd$child[[7]]$token[1] != "IF"
+    pd$child[[expr_after_else_idx]]$token[1] != "'{'" &&
+    pd$child[[expr_after_else_idx]]$token[1] != "IF"
   if (has_else_without_curly_or_else_chid) {
-    pd$indent[seq(7, nrow(pd))] <- indent_by
+    pd$indent[seq(else_idx + 1, nrow(pd))] <- indent_by
   }
   pd
 }

R/rules-other.R

@@ -10,7 +10,8 @@ add_brackets_in_pipe_one <- function(pd, pos) {
     new_pos_ids <- create_pos_ids(pd$child[[next_non_comment]], 1, after = TRUE, n = 2)
     new_pd <- create_tokens(
       tokens = c("'('", "')'"), texts = c("(", ")"), pos_ids = new_pos_ids,
-      lag_newlines = rep(0, 2))
+      lag_newlines = rep(0, 2)
+    )
     pd$child[[next_non_comment]] <-
       bind_rows(pd$child[[next_non_comment]], new_pd) %>%
       arrange(pos_id)
@@ -26,26 +27,81 @@ add_brackets_in_pipe_one <- function(pd, pos) {
 #' @param indent_by The amont of spaces used to indent an expression in curly
 #'   braces. Used for unindention.
 wrap_if_else_multi_line_in_curly <- function(pd, indent_by = 2) {
-  if (pd$token[1] == "IF" &&
-    pd_is_multi_line(pd) &&
-    !is_curly_expr(pd$child[[5]])) {
-    pd$lag_newlines[5] <- 0L
-    pd$spaces[4] <- 1L
-    pd$spaces[5] <- 0L
+  if (is_cond_expr(pd)) {
+    pd <- pd %>%
+      wrap_if_multiline_curly(indent_by) %>%
+      wrap_else_multiline_curly(indent_by)
+  }
+  pd
+}
+
+
+wrap_if_multiline_curly <- function(pd, indent_by) {
+  if (if_part_requires_braces(pd)) {
+    closing_brace_ind <- which(pd$token == "')'")[1]
+    pd$spaces[closing_brace_ind] <- 1L
+
+    to_be_wrapped_expr_with_child <- next_non_comment(
+      pd,
+      which(pd$token == "')'")[1]
+    )
+
+    all_to_be_wrapped_ind <- seq2(
+      closing_brace_ind + 1L, to_be_wrapped_expr_with_child
+    )
+
+    pd <- wrap_subexpr_in_curly(
+      pd, all_to_be_wrapped_ind, indent_by
+    )
+
     if (nrow(pd) > 5) pd$lag_newlines[6] <- 0L
-    pd$indent[5] <- pd$indent[5] - indent_by
-    pd$child[[5]] <- wrap_expr_in_curly(pd$child[[5]], stretch_out = TRUE)
-    pd$multi_line[5] <- TRUE
   }
-  if (nrow(pd) > 6 &&
-    (pd$token[6] == "ELSE" && pd_is_multi_line(pd)) &&
-    pd$child[[7]]$token != "IF" &&
-    !is_curly_expr(pd$child[[7]])) {
-    pd$spaces[6] <- 1L
-    pd$spaces[7] <- 0L
-    pd$indent[7] <- pd$indent[7] - indent_by
-    pd$lag_newlines[7] <- 0L
-    pd$child[[7]] <- wrap_expr_in_curly(pd$child[[7]], stretch_out = TRUE)
+  pd
+}
+
+wrap_else_multiline_curly <- function(pd, indent_by = 2) {
+  if (contains_else_expr(pd) &&
+    pd_is_multi_line(pd) &&
+    contains_else_expr_that_needs_braces(pd)) {
+    else_idx <- which(pd$token == "ELSE")
+    pd$spaces[else_idx] <- 1L
+    all_to_be_wrapped_ind <- seq2(else_idx + 1L, nrow(pd))
+
+    pd <- wrap_subexpr_in_curly(
+      pd, all_to_be_wrapped_ind, indent_by
+    )
   }
   pd
 }
+
+#' Wrap a sub-expression in curly braces
+#'
+#' Wraps some rows of a parse table into a sub-expression.
+#' @inheritParams wrap_if_else_multi_line_in_curly
+#' @param ind_to_be_wrapped The indices of the rows that should be wrapped
+#'   into a new expression.
+wrap_subexpr_in_curly <- function(pd,
+                                  ind_to_be_wrapped,
+                                  indent_by) {
+  to_be_wrapped_starts_with_comment <-
+    pd$token[ind_to_be_wrapped[1]] == "COMMENT"
+  new_expr <- wrap_expr_in_curly(
+    pd[ind_to_be_wrapped, ],
+    stretch_out = c(!to_be_wrapped_starts_with_comment, TRUE)
+  )
+  new_expr$indent <- pd$indent[last(ind_to_be_wrapped)] - indent_by
+  new_expr_in_expr <- new_expr %>%
+    wrap_expr_in_expr() %>%
+    remove_attributes(c("token_before", "token_after"))
+
+  pd %>%
+    slice(-ind_to_be_wrapped) %>%
+    bind_rows(new_expr_in_expr) %>%
+    set_multi_line() %>%
+    arrange(pos_id)
+}
+
+if_part_requires_braces <- function(pd) {
+  pd_is_multi_line(pd) &&
+    !is_curly_expr(pd$child[[next_non_comment(pd, which(pd$token == "')'")[1])]])
+}

R/serialized_tests.R

@@ -211,3 +211,40 @@ stop_insufficient_r_version <- function() {
     "since data.tree not available. Needs at least R version 3.2."
   ), call. = FALSE)
 }
+
+#' Generate a comprehensive collection test cases for comment / insertion
+#' interaction
+#' Test consist of if / if-else / if-else-if-else caes, paired with various
+#' line-break and comment configurations. Used for internal testing.
+#' @return
+#' The function is called for its side effects, i.e. to write the
+#' test cases to *-in.R files that can be tested with [test_collection()]. Note
+#' that a few of the test cases are invalid and need to be removed / commented
+#' out manually.
+generate_test_samples <- function() {
+  gen <- function(x) {
+    if (length(x) == 0) ""
+    else {
+      c(
+        paste0(x[1], gen(x[-1])),
+        paste0(x[1], " # comment\n", paste(x[-1], collapse = ""))
+      )
+    }
+  }
+
+  collapse <- function(x) paste(x, collapse = "\n\n")
+
+  cat(
+    collapse(gen(c("if", "(", "TRUE", ")", "NULL"))),
+    file = "tests/testthat/insertion_comment_interaction/just_if-in.R"
+  )
+  cat(
+    collapse(gen(c("if", "(", "TRUE", ")", "NULL", " else", " NULL"))),
+    file = "tests/testthat/insertion_comment_interaction/if_else-in.R"
+  )
+  cat(collapse(gen(c(
+    "if", "(", "TRUE", ")", "NULL", " else", " if", "(", "FALSE", ")", "NULL",
+    " else", " NULL"))),
+    file = "tests/testthat/insertion_comment_interaction/if_else_if_else-in.R"
+  )
+}

R/token-create.R

@@ -112,29 +112,27 @@ validate_new_pos_ids <- function(new_ids, after) {
 #' Wrap an expression in curly braces
 #'
 #' Adds curly braces to an expression (represented as a parse table) if there
-#' are none. Because of the nature of the nested parse table, curly braces only appear
-#' with a single expression between them, so `wrap_expr_in_curly()` actually
-#' first wraps the expression to wrap in curly braces into a new expression and
-#' then adds curly braces around this new expression.
+#' are none.
 #' @param pd A parse table.
 #' @param stretch_out Whether or not to create a line break after the opening
 #'   curly brace and before the closing curly brace.
-wrap_expr_in_curly <- function(pd, stretch_out = FALSE) {
+wrap_expr_in_curly <- function(pd, stretch_out = c(FALSE, FALSE)) {
   if (is_curly_expr(pd)) return(pd)
-  if (stretch_out) {
+  if (stretch_out[1]) {
     pd$lag_newlines[1] <- 1L
   }
 
-  expr <- wrap_expr_in_expr(pd)
   opening <- create_tokens(
     "'{'", "{",
-    pos_ids = create_pos_ids(expr, 1, after = FALSE)
+    pos_ids = create_pos_ids(pd, 1, after = FALSE),
+    spaces = 1 - as.integer(stretch_out[1])
   )
 
   closing <- create_tokens(
-    "'}'", "}", spaces = 1, lag_newlines = as.integer(stretch_out),
+    "'}'", "}", spaces = 1, lag_newlines = as.integer(stretch_out[2]),
     pos_ids = create_pos_ids(pd, nrow(pd), after = TRUE)
   )
 
-  bind_rows(opening, expr, closing)
+  bind_rows(opening, pd, closing) %>%
+    set_multi_line()
 }

R/utils.R

@@ -67,6 +67,21 @@ is_unsaved_file <- function(path) {
 #' @param pos The position of the token to start the search from.
 #' @importFrom rlang seq2
 next_non_comment <- function(pd, pos) {
+  if (length(pos) < 1 || is.na(pos) || pos >= nrow(pd)) return(integer(0))
   candidates <- seq2(pos + 1L, nrow(pd))
+  if (all(candidates %in% which(pd$token == "COMMENT"))) return(integer(0))
   setdiff(candidates, which(pd$token == "COMMENT"))[1]
 }
+
+#' Find the index of the last comment in the sequence of comments-only tokens
+#' after the token that has position `pos` in `pd`.
+#' @param pd A parse table.
+#' @param pos The position of the token to start the search from.
+extend_if_comment <- function(pd, pos) {
+  if (pos == nrow(pd)) return(pos)
+  if (pd$token[pos + 1] == "COMMENT") {
+    extend_if_comment(pd, pos + 1L)
+  } else {
+    pos
+  }
+}