From d90f05082790ff4093eddf49f8b39de22ba21d9e Mon Sep 17 00:00:00 2001 From: Lorenz Date: Fri, 16 Apr 2021 11:27:45 +0200 Subject: [PATCH 1/3] three layers should also work --- R/detect-alignment.R | 2 +- tests/testthat/alignment/named-in.R | 5 + tests/testthat/alignment/named-in_tree | 133 +++++++++++++++---------- tests/testthat/alignment/named-out.R | 5 + 4 files changed, 92 insertions(+), 53 deletions(-) diff --git a/R/detect-alignment.R b/R/detect-alignment.R index 5fa22dc4b..8856953b5 100644 --- a/R/detect-alignment.R +++ b/R/detect-alignment.R @@ -110,7 +110,7 @@ token_is_on_aligned_line <- function(pd_flat) { is_aligned <- length(unique(current_col)) == 1L if (is_aligned) { - previous_line <- nchar(by_line) + previous_line <- previous_line + nchar(by_line) next } # check 2: match by = (no extra spaces around it allowed.) diff --git a/tests/testthat/alignment/named-in.R b/tests/testthat/alignment/named-in.R index 94500cb3a..fa2a7c19a 100644 --- a/tests/testthat/alignment/named-in.R +++ b/tests/testthat/alignment/named-in.R @@ -204,3 +204,8 @@ gell( p = 2, g = gg(x), n = 3 * 3, # 31, fds = -1, gz = f / 3 + 1, ) + +xgle( + 1212, 232, f(n = 2), + 1, 2, "kFlya" +) diff --git a/tests/testthat/alignment/named-in_tree b/tests/testthat/alignment/named-in_tree index 8130c9c77..4367e9c41 100644 --- a/tests/testthat/alignment/named-in_tree +++ b/tests/testthat/alignment/named-in_tree @@ -814,55 +814,84 @@ ROOT (token: short_text [lag_newlines/spaces] {pos_id}) ¦ ¦ °--STR_CONST: "stuf [0/0] {809} ¦ °--')': ) [1/0] {811} ¦--COMMENT: # ali [2/0] {812} - °--expr: gell( [1/0] {813} - ¦--expr: gell [0/0] {815} - ¦ °--SYMBOL_FUNCTION_CALL: gell [0/0] {814} - ¦--'(': ( [0/2] {816} - ¦--SYMBOL_SUB: p [1/1] {817} - ¦--EQ_SUB: = [0/1] {818} - ¦--expr: 2 [0/0] {820} - ¦ °--NUM_CONST: 2 [0/0] {819} - ¦--',': , [0/3] {821} - ¦--SYMBOL_SUB: g [0/1] {822} - ¦--EQ_SUB: = [0/1] {823} - ¦--expr: gg(x) [0/0] {824} - ¦ ¦--expr: gg [0/0] {826} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: gg [0/0] {825} - ¦ ¦--'(': ( [0/0] {827} - ¦ ¦--expr: x [0/0] {829} - ¦ ¦ °--SYMBOL: x [0/0] {828} - ¦ °--')': ) [0/0] {830} - ¦--',': , [0/1] {831} - ¦--SYMBOL_SUB: n [0/1] {832} - ¦--EQ_SUB: = [0/1] {833} - ¦--expr: 3 * 3 [0/0] {834} - ¦ ¦--expr: 3 [0/1] {836} - ¦ ¦ °--NUM_CONST: 3 [0/0] {835} - ¦ ¦--'*': * [0/1] {837} - ¦ °--expr: 3 [0/0] {839} - ¦ °--NUM_CONST: 3 [0/0] {838} - ¦--',': , [0/1] {840} - ¦--COMMENT: # [0/2] {841} - ¦--expr: 31 [1/0] {843} - ¦ °--NUM_CONST: 31 [0/0] {842} - ¦--',': , [0/4] {844} - ¦--SYMBOL_SUB: fds [0/1] {845} - ¦--EQ_SUB: = [0/1] {846} - ¦--expr: -1 [0/0] {847} - ¦ ¦--'-': - [0/0] {848} - ¦ °--expr: 1 [0/0] {850} - ¦ °--NUM_CONST: 1 [0/0] {849} - ¦--',': , [0/1] {851} - ¦--SYMBOL_SUB: gz [0/3] {852} - ¦--EQ_SUB: = [0/1] {853} - ¦--expr: f / 3 [0/0] {854} - ¦ ¦--expr: f [0/1] {857} - ¦ ¦ °--SYMBOL: f [0/0] {856} - ¦ ¦--'/': / [0/1] {858} - ¦ ¦--expr: 3 [0/1] {860} - ¦ ¦ °--NUM_CONST: 3 [0/0] {859} - ¦ ¦--'+': + [0/1] {861} - ¦ °--expr: 1 [0/0] {863} - ¦ °--NUM_CONST: 1 [0/0] {862} - ¦--',': , [0/0] {864} - °--')': ) [1/0] {865} + ¦--expr: gell( [1/0] {813} + ¦ ¦--expr: gell [0/0] {815} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: gell [0/0] {814} + ¦ ¦--'(': ( [0/2] {816} + ¦ ¦--SYMBOL_SUB: p [1/1] {817} + ¦ ¦--EQ_SUB: = [0/1] {818} + ¦ ¦--expr: 2 [0/0] {820} + ¦ ¦ °--NUM_CONST: 2 [0/0] {819} + ¦ ¦--',': , [0/3] {821} + ¦ ¦--SYMBOL_SUB: g [0/1] {822} + ¦ ¦--EQ_SUB: = [0/1] {823} + ¦ ¦--expr: gg(x) [0/0] {824} + ¦ ¦ ¦--expr: gg [0/0] {826} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: gg [0/0] {825} + ¦ ¦ ¦--'(': ( [0/0] {827} + ¦ ¦ ¦--expr: x [0/0] {829} + ¦ ¦ ¦ °--SYMBOL: x [0/0] {828} + ¦ ¦ °--')': ) [0/0] {830} + ¦ ¦--',': , [0/1] {831} + ¦ ¦--SYMBOL_SUB: n [0/1] {832} + ¦ ¦--EQ_SUB: = [0/1] {833} + ¦ ¦--expr: 3 * 3 [0/0] {834} + ¦ ¦ ¦--expr: 3 [0/1] {836} + ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {835} + ¦ ¦ ¦--'*': * [0/1] {837} + ¦ ¦ °--expr: 3 [0/0] {839} + ¦ ¦ °--NUM_CONST: 3 [0/0] {838} + ¦ ¦--',': , [0/1] {840} + ¦ ¦--COMMENT: # [0/2] {841} + ¦ ¦--expr: 31 [1/0] {843} + ¦ ¦ °--NUM_CONST: 31 [0/0] {842} + ¦ ¦--',': , [0/4] {844} + ¦ ¦--SYMBOL_SUB: fds [0/1] {845} + ¦ ¦--EQ_SUB: = [0/1] {846} + ¦ ¦--expr: -1 [0/0] {847} + ¦ ¦ ¦--'-': - [0/0] {848} + ¦ ¦ °--expr: 1 [0/0] {850} + ¦ ¦ °--NUM_CONST: 1 [0/0] {849} + ¦ ¦--',': , [0/1] {851} + ¦ ¦--SYMBOL_SUB: gz [0/3] {852} + ¦ ¦--EQ_SUB: = [0/1] {853} + ¦ ¦--expr: f / 3 [0/0] {854} + ¦ ¦ ¦--expr: f [0/1] {857} + ¦ ¦ ¦ °--SYMBOL: f [0/0] {856} + ¦ ¦ ¦--'/': / [0/1] {858} + ¦ ¦ ¦--expr: 3 [0/1] {860} + ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {859} + ¦ ¦ ¦--'+': + [0/1] {861} + ¦ ¦ °--expr: 1 [0/0] {863} + ¦ ¦ °--NUM_CONST: 1 [0/0] {862} + ¦ ¦--',': , [0/0] {864} + ¦ °--')': ) [1/0] {865} + °--expr: xgle( [2/0] {866} + ¦--expr: xgle [0/0] {868} + ¦ °--SYMBOL_FUNCTION_CALL: xgle [0/0] {867} + ¦--'(': ( [0/2] {869} + ¦--expr: 1212 [1/0] {871} + ¦ °--NUM_CONST: 1212 [0/0] {870} + ¦--',': , [0/1] {872} + ¦--expr: 232 [0/0] {874} + ¦ °--NUM_CONST: 232 [0/0] {873} + ¦--',': , [0/1] {875} + ¦--expr: f(n = [0/0] {876} + ¦ ¦--expr: f [0/0] {878} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: f [0/0] {877} + ¦ ¦--'(': ( [0/0] {879} + ¦ ¦--SYMBOL_SUB: n [0/1] {880} + ¦ ¦--EQ_SUB: = [0/1] {881} + ¦ ¦--expr: 2 [0/0] {883} + ¦ ¦ °--NUM_CONST: 2 [0/0] {882} + ¦ °--')': ) [0/0] {884} + ¦--',': , [0/2] {885} + ¦--expr: 1 [1/0] {887} + ¦ °--NUM_CONST: 1 [0/0] {886} + ¦--',': , [0/6] {888} + ¦--expr: 2 [0/0] {890} + ¦ °--NUM_CONST: 2 [0/0] {889} + ¦--',': , [0/2] {891} + ¦--expr: "kFly [0/0] {893} + ¦ °--STR_CONST: "kFly [0/0] {892} + °--')': ) [1/0] {894} diff --git a/tests/testthat/alignment/named-out.R b/tests/testthat/alignment/named-out.R index a4fb69041..ca3343595 100644 --- a/tests/testthat/alignment/named-out.R +++ b/tests/testthat/alignment/named-out.R @@ -202,3 +202,8 @@ gell( p = 2, g = gg(x), n = 3 * 3, # 31, fds = -1, gz = f / 3 + 1, ) + +xgle( + 1212, 232, f(n = 2), + 1, 2, "kFlya" +) From 6fcd9272c8c22b6842906c3fbcb235bf06538c1c Mon Sep 17 00:00:00 2001 From: Lorenz Date: Fri, 16 Apr 2021 14:07:10 +0200 Subject: [PATCH 2/3] fi the sh**, simplify later --- R/detect-alignment.R | 23 +++++++++++++++++------ tests/testthat/test-detect-alignment.R | 3 +++ 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/R/detect-alignment.R b/R/detect-alignment.R index 8856953b5..5d2b75a7a 100644 --- a/R/detect-alignment.R +++ b/R/detect-alignment.R @@ -116,15 +116,26 @@ token_is_on_aligned_line <- function(pd_flat) { # check 2: match by = (no extra spaces around it allowed.) # match left aligned after = start_after_eq <- regexpr("= [^ ]", by_line) + names(start_after_eq) <- names(by_line) start_after_eq <- start_after_eq[start_after_eq > 0] - # when match via comma unsuccessful, matching by = must yield at least one = - is_aligned <- length(unique(start_after_eq + previous_line)) == 1 && length(start_after_eq) > 1 - previous_line <- nchar(by_line) + previous_line - if (column >= start_eval && !is_aligned) { - # when not all are named, we need colum 1 for previous_line - return(FALSE) + if (column >= start_eval) { + if (length(start_after_eq) == 0) { + return(FALSE) + } + # when match via comma unsuccessful, matching by = must yield at least one = + if (column == 1) { + current_col <- start_after_eq + } else { + current_col <- start_after_eq + + previous_line[intersect(names(previous_line), names(start_after_eq))] + } + is_aligned <- length(unique(current_col)) == 1 && length(start_after_eq) > 1 + if (!is_aligned) { + return(FALSE) + } } + previous_line <- nchar(by_line) + previous_line } TRUE } diff --git a/tests/testthat/test-detect-alignment.R b/tests/testthat/test-detect-alignment.R index 6c2e65ff0..e0db9a93f 100644 --- a/tests/testthat/test-detect-alignment.R +++ b/tests/testthat/test-detect-alignment.R @@ -2,4 +2,7 @@ test_that("does apply spacing rules only if not aligned", { expect_warning(test_collection("alignment", transformer = style_text ), NA) + + text <- "tribble(\n ~x, ~y,\n 11, list(a = 1),\n 2, list(bjj = 2)\n)" + expect_warning(style_text(text), NA) }) From 16f33bbc54049d4af720eb4791da1e00881dad9d Mon Sep 17 00:00:00 2001 From: Lorenz Date: Fri, 16 Apr 2021 14:42:52 +0200 Subject: [PATCH 3/3] add news bullet --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 0ac70503e..7cd3679e1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ * `#>` is recognized as an output marker and no space is added after `#` (#771). * code with left alignment after `=` in function calls is now recognized as - aligned and won't be reformatted (#774). + aligned and won't be reformatted (#774, #777). ``` # newly detected call(