From b15344536520e1b5b787228e3bbf5ab9c18f4f3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sat, 19 Oct 2024 20:05:33 +0200 Subject: [PATCH 1/4] Adapt to single indent semantics in style guide --- R/rules-indention.R | 3 ++- R/rules-line-breaks.R | 4 +++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/R/rules-indention.R b/R/rules-indention.R index 30cf7b246..178cc319f 100644 --- a/R/rules-indention.R +++ b/R/rules-indention.R @@ -23,7 +23,8 @@ unindent_fun_dec <- function(pd, indent_by = 2L) { idx_closing_brace <- which(pd$token == "')'") fun_dec_head <- seq2(2L, idx_closing_brace) if (is_double_indent_function_declaration(pd, indent_by = indent_by)) { - pd$indent[fun_dec_head] <- 2L * indent_by + pd$indent[fun_dec_head] <- indent_by + pd$indent[idx_closing_brace] <- 0L } else { pd$indent[fun_dec_head] <- 0L } diff --git a/R/rules-line-breaks.R b/R/rules-line-breaks.R index ecbea2dfe..319929d6d 100644 --- a/R/rules-line-breaks.R +++ b/R/rules-line-breaks.R @@ -242,9 +242,11 @@ remove_line_breaks_in_fun_dec <- function(pd) { ) & pd$token_before != "COMMENT" pd$lag_newlines[pd$lag_newlines > 1L] <- 1L - pd$lag_newlines[round_after] <- 0L if (is_double_indention) { pd$lag_newlines[lag(pd$token == "'('")] <- 1L + pd$lag_newlines[round_after] <- 1L + } else { + pd$lag_newlines[round_after] <- 0L } } pd From 5e5eb3aa5ce20ffe99136045f849a6522d8a421d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sat, 19 Oct 2024 20:05:40 +0200 Subject: [PATCH 2/4] Adapt tests --- .../testthat/fun_dec/line_break_fun_dec-out.R | 7 ++-- .../eq_formals_complex_indention-out.R | 30 +++++++------- .../eq_formals_complex_tokens-out.R | 39 +++++++++++-------- .../eq_sub_complex_indention-out.R | 4 +- tests/testthat/unindention/mixed-double-out.R | 32 ++++++++------- 5 files changed, 61 insertions(+), 51 deletions(-) diff --git a/tests/testthat/fun_dec/line_break_fun_dec-out.R b/tests/testthat/fun_dec/line_break_fun_dec-out.R index f9d494561..f910b6b43 100644 --- a/tests/testthat/fun_dec/line_break_fun_dec-out.R +++ b/tests/testthat/fun_dec/line_break_fun_dec-out.R @@ -40,8 +40,9 @@ a <- function(x, } a <- function( - # - x, - y) { + # + x, + y +) { x - 1 } diff --git a/tests/testthat/indention_operators/eq_formals_complex_indention-out.R b/tests/testthat/indention_operators/eq_formals_complex_indention-out.R index 305fe6e1c..a2e1d79b8 100644 --- a/tests/testthat/indention_operators/eq_formals_complex_indention-out.R +++ b/tests/testthat/indention_operators/eq_formals_complex_indention-out.R @@ -1,27 +1,27 @@ function(a = - 33, - b - ) {} + 33, + b +) {} function(a = - 33, - b) {} + 33, + b) {} function(a, - b, - c - ) {} + b, + c +) {} function(a, - b, - c) {} + b, + c) {} function(ss, - a = - 3, - er = - 4 - ) {} + a = + 3, + er = + 4 +) {} function(a = b, diff --git a/tests/testthat/indention_operators/eq_formals_complex_tokens-out.R b/tests/testthat/indention_operators/eq_formals_complex_tokens-out.R index 27b8d7e7c..9c001e666 100644 --- a/tests/testthat/indention_operators/eq_formals_complex_tokens-out.R +++ b/tests/testthat/indention_operators/eq_formals_complex_tokens-out.R @@ -1,29 +1,34 @@ function( - a = - 33, - b) {} + a = + 33, + b +) {} function( - a = - 33, - b) {} + a = + 33, + b +) {} function( - a, - b, - c) {} + a, + b, + c +) {} function( - a, - b, - c) {} + a, + b, + c +) {} function( - ss, - a = - 3, - er = - 4) {} + ss, + a = + 3, + er = + 4 +) {} function(a = b, diff --git a/tests/testthat/indention_operators/eq_sub_complex_indention-out.R b/tests/testthat/indention_operators/eq_sub_complex_indention-out.R index 02b322973..03c121d81 100644 --- a/tests/testthat/indention_operators/eq_sub_complex_indention-out.R +++ b/tests/testthat/indention_operators/eq_sub_complex_indention-out.R @@ -10,8 +10,8 @@ b # multiple nested levels { v <- function(x = - 122, - y) { + 122, + y) { } } diff --git a/tests/testthat/unindention/mixed-double-out.R b/tests/testthat/unindention/mixed-double-out.R index a1c7e24d2..44591e1f2 100644 --- a/tests/testthat/unindention/mixed-double-out.R +++ b/tests/testthat/unindention/mixed-double-out.R @@ -37,29 +37,33 @@ function(x, # double function( - x, - y) { + x, + y +) { 1 } function( - x, - y, - k) { + x, + y, + k +) { 1 } function( - x, - y) { + x, + y +) { 1 } function( - x, y) { + x, y +) { 1 } @@ -72,23 +76,23 @@ function(x, # last brace function( - x, y) { + x, y) { NULL } function( - x, y) { + x, y) { NULL } function( - x, - y) { + x, + y) { NULL } function( - x, - y) { + x, + y) { NULL } From 8b9a4a088800d50c16daf0eb7c1823aed8d3c199 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sat, 19 Oct 2024 20:10:42 +0200 Subject: [PATCH 3/4] double -> single --- R/rules-indention.R | 13 +++++++------ R/rules-line-breaks.R | 2 +- ....Rd => is_single_indent_function_declaration.Rd} | 10 +++++----- 3 files changed, 13 insertions(+), 12 deletions(-) rename man/{is_double_indent_function_declaration.Rd => is_single_indent_function_declaration.Rd} (60%) diff --git a/R/rules-indention.R b/R/rules-indention.R index 178cc319f..3e953d76e 100644 --- a/R/rules-indention.R +++ b/R/rules-indention.R @@ -15,14 +15,14 @@ indent_braces <- function(pd, indent_by) { #' #' Necessary for consistent indention of the function declaration header. #' @param pd A parse table. -#' @inheritParams is_double_indent_function_declaration +#' @inheritParams is_single_indent_function_declaration #' @seealso set_unindention_child update_indention_ref_fun_dec #' @keywords internal unindent_fun_dec <- function(pd, indent_by = 2L) { if (is_function_declaration(pd)) { idx_closing_brace <- which(pd$token == "')'") fun_dec_head <- seq2(2L, idx_closing_brace) - if (is_double_indent_function_declaration(pd, indent_by = indent_by)) { + if (is_single_indent_function_declaration(pd, indent_by = indent_by)) { pd$indent[fun_dec_head] <- indent_by pd$indent[idx_closing_brace] <- 0L } else { @@ -32,20 +32,21 @@ unindent_fun_dec <- function(pd, indent_by = 2L) { pd } -#' Is the function declaration double indented? +#' Is the function declaration single indented? #' #' Assumes you already checked if it's a function with -#' `is_function_declaration`. It is double indented if the first token +#' `is_function_declaration`. It is single indented if the first token #' after the first line break that is a `"SYMBOL_FORMALS"`. #' @param pd A parse table. #' @inheritParams tidyverse_style #' @keywords internal -is_double_indent_function_declaration <- function(pd, indent_by = 2L) { +is_single_indent_function_declaration <- function(pd, indent_by = 2L) { head_pd <- vec_slice(pd, -nrow(pd)) line_break_in_header <- which(head_pd$lag_newlines > 0L & head_pd$token == "SYMBOL_FORMALS") if (length(line_break_in_header) > 0L) { # indent results from applying the rules, spaces is the initial spaces # (which is indention if a newline is ahead) + # The 2L factor is kept to convert double indent to single indent pd$spaces[line_break_in_header[1L] - 1L] <= 2L * indent_by } else { FALSE @@ -133,7 +134,7 @@ NULL #' #' @keywords internal update_indention_ref_fun_dec <- function(pd_nested) { - if (is_function_declaration(pd_nested) && !is_double_indent_function_declaration(pd_nested)) { + if (is_function_declaration(pd_nested) && !is_single_indent_function_declaration(pd_nested)) { seq <- seq2(3L, nrow(pd_nested) - 2L) pd_nested$indention_ref_pos_id[seq] <- pd_nested$pos_id[2L] } diff --git a/R/rules-line-breaks.R b/R/rules-line-breaks.R index 319929d6d..0afc8e45d 100644 --- a/R/rules-line-breaks.R +++ b/R/rules-line-breaks.R @@ -236,7 +236,7 @@ remove_line_break_before_round_closing_after_curly <- function(pd) { remove_line_breaks_in_fun_dec <- function(pd) { if (is_function_declaration(pd)) { - is_double_indention <- is_double_indent_function_declaration(pd) + is_double_indention <- is_single_indent_function_declaration(pd) round_after <- ( pd$token == "')'" | pd$token_before == "'('" ) & diff --git a/man/is_double_indent_function_declaration.Rd b/man/is_single_indent_function_declaration.Rd similarity index 60% rename from man/is_double_indent_function_declaration.Rd rename to man/is_single_indent_function_declaration.Rd index d9a36a367..b186ec201 100644 --- a/man/is_double_indent_function_declaration.Rd +++ b/man/is_single_indent_function_declaration.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/rules-indention.R -\name{is_double_indent_function_declaration} -\alias{is_double_indent_function_declaration} -\title{Is the function declaration double indented?} +\name{is_single_indent_function_declaration} +\alias{is_single_indent_function_declaration} +\title{Is the function declaration single indented?} \usage{ -is_double_indent_function_declaration(pd, indent_by = 2L) +is_single_indent_function_declaration(pd, indent_by = 2L) } \arguments{ \item{pd}{A parse table.} @@ -14,7 +14,7 @@ operators such as '('.} } \description{ Assumes you already checked if it's a function with -\code{is_function_declaration}. It is double indented if the first token +\code{is_function_declaration}. It is single indented if the first token after the first line break that is a \code{"SYMBOL_FORMALS"}. } \keyword{internal} From ff785eabbe9c9130efbc0794b5471f8672d8386e Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 24 Nov 2024 23:54:05 +0100 Subject: [PATCH 4/4] rename for consistency --- R/rules-line-breaks.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/rules-line-breaks.R b/R/rules-line-breaks.R index 0afc8e45d..07229ebc9 100644 --- a/R/rules-line-breaks.R +++ b/R/rules-line-breaks.R @@ -236,13 +236,13 @@ remove_line_break_before_round_closing_after_curly <- function(pd) { remove_line_breaks_in_fun_dec <- function(pd) { if (is_function_declaration(pd)) { - is_double_indention <- is_single_indent_function_declaration(pd) + is_single_indention <- is_single_indent_function_declaration(pd) round_after <- ( pd$token == "')'" | pd$token_before == "'('" ) & pd$token_before != "COMMENT" pd$lag_newlines[pd$lag_newlines > 1L] <- 1L - if (is_double_indention) { + if (is_single_indention) { pd$lag_newlines[lag(pd$token == "'('")] <- 1L pd$lag_newlines[round_after] <- 1L } else {