Merge pull request #119 from lorenzwalthert/pr106_5_token_dep_ind

Re-indent token-dependent. #119

Author: lorenzwalthert

DESCRIPTION

@@ -40,6 +40,7 @@ Collate:
     'nested.R'
     'nested_to_tree.R'
     'parsed.R'
+    'reindent.R'
     'token.R'
     'relevel.R'
     'rules-line_break.R'

R/get_transformers.R

@@ -113,13 +113,19 @@ get_transformers_nested <- function(
     )
 
 
+  indention_modifier <-
+    c(
+      update_indention_ref_fun_dec,
+      update_indention_ref_fun_call
+    )
+
   list(
     # transformer functions
     filler            = create_filler,
     line_break        = line_break_manipulators,
     space             = space_manipulators,
     token             = token_manipulators,
-
+    indention         = indention_modifier,
     # transformer options
     use_raw_indention = use_raw_indention,
     NULL

R/parsed.R

@@ -92,7 +92,7 @@ create_filler <- function(pd_flat) {
   pd_flat$col2_nl <- if_else(pd_flat$newlines > 0L, 0L, pd_flat$col2)
   pd_flat$spaces <- pd_flat$col3 - pd_flat$col2_nl - 1L
   pd_flat$multi_line <- ifelse(pd_flat$terminal, FALSE, NA)
-
+  pd_flat$indention_ref_id <- NA
   ret <- pd_flat[, !(names(pd_flat) %in% c("line3", "col3", "col2_nl"))]
 
 

R/reindent.R

@@ -0,0 +1,134 @@
+
+#' Update the indention reference
+#'
+#' @param pd_nested A nested parse table.
+#' @name update_indention_ref
+NULL
+
+
+#' @describeIn update_indention_ref Updates the reference id for all
+#'   tokens in `pd_nested` if `pd_nested` contains a function call. Tokens that
+#'   start on the same line as the opening parenthesis, are not themselves
+#'   function calls or expressions wrapped in curly brackets are re-indented,
+#'   that is, they are indented up to the level at which the call ends in
+#'   terms of col2. We need to take the last from the first child because calls
+#'   like package::function() can have three elements.
+#' @examples
+#' \dontrun{
+#' # not re-indented
+#' call(call(
+#'   xyz
+#' ))
+#' # re-indented
+#' call(call(1,
+#'           2))
+#' }
+#' @importFrom purrr map_lgl
+update_indention_ref_fun_call <- function(pd_nested) {
+  current_is_call <- pd_nested$token_before[2] %in% c("SYMBOL_FUNCTION_CALL")
+  non_comment <- which(pd_nested$token != "COMMENT")
+  first_non_comment_after_call <- non_comment[non_comment > 2][1]
+  if ((current_is_call) &&
+      nrow(pd_nested) > 3 &&
+      pd_nested$lag_newlines[first_non_comment_after_call] == 0) {
+    candidates <- 3:(nrow(pd_nested) - 1)
+
+    child_is_call <- map_lgl(pd_nested$child, is_function_call)
+    child_is_curly_expr <- map_lgl(pd_nested$child, is_curly_expr)
+    child_is_on_same_line <- cumsum(pd_nested$lag_newlines) == 0
+    call_on_same_line <- child_is_call & child_is_on_same_line
+    to_indent <- setdiff(candidates, which(call_on_same_line | child_is_curly_expr))
+
+    pd_nested$indention_ref_id[to_indent] <- last(pd_nested$child[[1]]$id)
+  }
+  pd_nested
+}
+
+#' @describeIn update_indention_ref Updates the reference id for all
+#'   tokens in `pd_nested` if `pd_nested` contains a function declaration.
+#'   Tokens inside a function declaration are are re-indented,
+#'   that is, they are indented up to the level at which the token FUNCTION
+#'   ends in terms of col2.
+#' @examples
+#' \dontrun{
+#' a <- function(x,
+#'               y) {
+#' x + y
+#' }
+#' }
+update_indention_ref_fun_dec <- function(pd_nested) {
+  if (pd_nested$token[1] == "FUNCTION" &&
+      nrow(pd_nested) > 3) {
+    seq <- 3:(nrow(pd_nested) - 1)
+    pd_nested$indention_ref_id[seq] <- pd_nested$id[1]
+  }
+  pd_nested
+}
+
+#' Check whether a parse table corresponds to a a certain expression
+#'
+#' @param pd A parse table.
+#' @name pd_is
+NULL
+
+#' @describeIn pd_is Checks whether `pd` contains an expression wrapped in
+#'   curley brackets.
+is_curly_expr <- function(pd) {
+  if (is.null(pd)) return(FALSE)
+  pd$token[1] == "'{'"
+}
+
+#' @describeIn pd_is Checks whether `pd` is a function call.
+is_function_call <- function(pd) {
+  if (is.null(pd)) return(FALSE)
+  if (is.na(pd$token_before[2])) return(FALSE)
+  pd$token_before[2] == "SYMBOL_FUNCTION_CALL"
+}
+
+
+#' Apply reference indention to tokens
+#'
+#' Applies the reference indention created with functions
+#' [update_indention_ref()] to the flattened parse table. The indention
+#' is applied to all token that inherit from a reference token sequentially,
+#' i.e. by looping over the target tokens.
+#' @inheritParams apply_ref_indention_one
+apply_ref_indention <- function(flattened_pd) {
+  target_tokens <- which(flattened_pd$id %in% flattened_pd$indention_ref_id)
+  flattened_pd <- reduce(
+    target_tokens,
+    apply_ref_indention_one,
+    .init = flattened_pd
+  )
+  flattened_pd
+}
+
+#' Applying reference indention of a target token
+#'
+#' Applies the indention level of `target_token` to all tokens that have
+#' `target_token` as a reference. This includes adding spaces to the first
+#' tokens on a line and updating the column `col1` and `col2` for all tokens
+#' on that line so they are kept updated.
+#' @param flattened_pd A flattened parse table
+#' @param target_token The index of the token from wich the indention level
+#'   should be applied to other tokens.
+apply_ref_indention_one <- function(flattened_pd, target_token) {
+  token_points_to_ref <-
+    flattened_pd$indention_ref_id == flattened_pd$id[target_token]
+  first_token_on_line <- flattened_pd$lag_newlines > 0L
+  token_to_update <- which(token_points_to_ref & first_token_on_line)
+
+  # udate spaces
+  copied_spaces <- flattened_pd$col2[target_token] + 1
+  old_spaces <- flattened_pd$lag_spaces[token_to_update[1]]
+  shift <- copied_spaces - old_spaces
+  flattened_pd$lag_spaces[token_to_update] <-
+    flattened_pd$lag_spaces[token_to_update] + shift
+
+  # update col1 / col2
+  cols_to_update <- flattened_pd$line1 %in% flattened_pd$line1[token_to_update]
+  flattened_pd$col1[cols_to_update] <- flattened_pd$col1[cols_to_update] + shift
+  flattened_pd$col2[cols_to_update] <- flattened_pd$col2[cols_to_update] + shift
+  flattened_pd
+
+}

R/rules-spacing.R

@@ -105,7 +105,7 @@ set_space_after_comma <- function(pd_flat) {
 }
 
 remove_space_before_comma <- function(pd_flat) {
-  comma_after <- (pd_flat$token == "','") & (pd_flat$newlines == 0L)
+  comma_after <- pd_flat$token == "','"
   if (!any(comma_after)) return(pd_flat)
   comma_before <- lead(comma_after, default = FALSE)
   idx <- comma_before  & (pd_flat$newlines == 0L)

R/transform.R

@@ -86,7 +86,8 @@ parse_transform_serialize <- function(text, transformers) {
   transformed_pd <- apply_transformers(pd_nested, transformers)
   # TODO verify_roundtrip
   flattened_pd <- post_visit(transformed_pd, list(extract_terminals)) %>%
-    enrich_terminals(transformers$use_raw_indention)
+    enrich_terminals(transformers$use_raw_indention) %>%
+    apply_ref_indention()
 
   serialized_transformed_text <- serialize_parse_data_flattened(flattened_pd)
   serialized_transformed_text
@@ -119,14 +120,15 @@ apply_transformers <- function(pd_nested, transformers) {
 
   transformed_all <- pre_visit(
     transformed_updated_multi_line,
-    c(transformers$space, transformers$token)
+    c(transformers$space, transformers$token, transformers$indention)
   )
 
   transformed_absolute_indent <- context_to_terminals(
     transformed_all,
     outer_lag_newlines = 0,
     outer_indent = 0,
-    outer_spaces = 0
+    outer_spaces = 0,
+    outer_indention_refs = NA
   )
 
   transformed_absolute_indent

R/visit.R

@@ -56,18 +56,20 @@ visit_one <- function(pd_flat, funs) {
 context_to_terminals <- function(pd_nested,
                                  outer_lag_newlines,
                                  outer_indent,
-                                 outer_spaces) {
+                                 outer_spaces,
+                                 outer_indention_refs) {
 
   if (is.null(pd_nested)) return()
 
   pd_transformed <- context_towards_terminals(
-    pd_nested, outer_lag_newlines, outer_indent, outer_spaces
+    pd_nested, outer_lag_newlines, outer_indent, outer_spaces, outer_indention_refs
   )
 
   pd_transformed$child <- pmap(list(pd_transformed$child,
                                     pd_transformed$lag_newlines,
                                     pd_transformed$indent,
-                                    pd_transformed$spaces),
+                                    pd_transformed$spaces,
+                                    pd_transformed$indention_ref_id),
                                context_to_terminals)
   pd_transformed
 }
@@ -84,13 +86,18 @@ context_to_terminals <- function(pd_nested,
 #' @param outer_lag_newlines The lag_newlines to be propagated inwards.
 #' @param outer_indent The indention depth to be propagated inwards.
 #' @param outer_spaces The number of spaces to be propagated inwards.
+#' @param outer_indention_refs The reference id that should be propagated
+#'   inwards.
 #' @return An updated parse table.
 #' @seealso context_to_terminals
 context_towards_terminals <- function(pd_nested,
                                       outer_lag_newlines,
                                       outer_indent,
-                                      outer_spaces) {
+                                      outer_spaces,
+                                      outer_indention_refs) {
   pd_nested$indent <- pd_nested$indent + outer_indent
+  ref_id_is_na <- !is.na(pd_nested$indention_ref_id)
+  pd_nested$indention_ref_id[!ref_id_is_na] <- outer_indention_refs
   pd_nested$lag_newlines[1] <- pd_nested$lag_newlines[1] + outer_lag_newlines
   pd_nested$spaces[nrow(pd_nested)] <-
     pd_nested$spaces[nrow(pd_nested)] + outer_spaces
@@ -119,10 +126,15 @@ extract_terminals <- function(pd_nested) {
 #'  which the token starts. `line1` has the same meaning as `line1` that can be
 #'  found in a flat parse table (see [tokenize()]), just that the `line1`
 #'  created by `enrich_terminals()` is the updated version of the former
-#'  `line1`. The same applies for `col1` and `col2`.
+#'  `line1`. The same applies for `col1` and `col2`. Note that this function
+#'  does remove the columns `indent` and `spaces.` All information of the former
+#'  is stored in `lag_spaces` now. The later was removed because it is redundant
+#'  after adding the column `lag_spaces`, which is more convenient to work with,
+#'  in particular when serializing the parse table.
 #' @inheritParams choose_indention
 enrich_terminals <- function(flattened_pd, use_raw_indention = FALSE) {
   flattened_pd$lag_spaces <- lag(flattened_pd$spaces, default = 0L)
+  flattened_pd$spaces <- NULL # depreciate spaces
   flattened_pd <- choose_indention(flattened_pd, use_raw_indention)
   flattened_pd$line1 <-
     cumsum(flattened_pd$lag_newlines) + flattened_pd$line1[1]