From 64b86897a0bce3b09b7a51939cdd7409054e7d72 Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Tue, 17 Sep 2019 09:24:09 +0200 Subject: [PATCH 1/8] force brace expression in function calls be on their own line. function arguments that consist of a braced expression always need to start on a new line, unless it's the last argument and all other arguments fit on the line of the function call or they are named. --- R/rules-line-break.R | 22 ++- tests/testthat/curly-curly/mixed-out.R | 13 +- .../braces-fun-calls-in.R | 35 +++++ .../braces-fun-calls-in_tree | 126 ++++++++++++++++++ .../braces-fun-calls-out.R | 39 ++++++ tests/testthat/test-line_breaks_and_other.R | 6 + 6 files changed, 231 insertions(+), 10 deletions(-) create mode 100644 tests/testthat/line_breaks_and_other/braces-fun-calls-in.R create mode 100644 tests/testthat/line_breaks_and_other/braces-fun-calls-in_tree create mode 100644 tests/testthat/line_breaks_and_other/braces-fun-calls-out.R diff --git a/R/rules-line-break.R b/R/rules-line-break.R index 324f50e9f..85553cd8b 100644 --- a/R/rules-line-break.R +++ b/R/rules-line-break.R @@ -1,14 +1,26 @@ # A { should never go on its own line remove_line_break_before_curly_opening <- function(pd) { - rm_break_idx <- which((pd$token_after == "'{'") & (pd$token != "COMMENT")) - rm_break_idx <- setdiff(rm_break_idx, nrow(pd)) - if (length(rm_break_idx) > 0) { + line_break_to_set_idx <- which((pd$token_after == "'{'") & (pd$token != "COMMENT")) + line_break_to_set_idx <- setdiff(line_break_to_set_idx, nrow(pd)) + if (length(line_break_to_set_idx) > 0) { is_not_curly_curly <- map_chr( - rm_break_idx + 1L, + line_break_to_set_idx + 1L, ~ next_terminal(pd[.x, ], vars = "token_after")$token_after ) != "'{'" - is_not_curly_curly_idx <- rm_break_idx[is_not_curly_curly] + last_expr_idx <- max(which(pd$token == "expr")) + is_last_expr <- ifelse(pd$token[1] == "IF", + # rule not applicable for IF + TRUE, (line_break_to_set_idx + 1L) == last_expr_idx + ) + eq_sub_before <- pd$token[line_break_to_set_idx] == "EQ_SUB" + should_be_on_same_line <- is_not_curly_curly & (is_last_expr | eq_sub_before) + is_not_curly_curly_idx <- line_break_to_set_idx[should_be_on_same_line] pd$lag_newlines[1 + is_not_curly_curly_idx] <- 0L + + should_not_be_on_same_line <- is_not_curly_curly & (!is_last_expr & !eq_sub_before) + should_not_be_on_same_line_idx <- line_break_to_set_idx[should_not_be_on_same_line] + + pd$lag_newlines[1 + should_not_be_on_same_line_idx] <- 1L } pd } diff --git a/tests/testthat/curly-curly/mixed-out.R b/tests/testthat/curly-curly/mixed-out.R index dcb5579c1..473ca2975 100644 --- a/tests/testthat/curly-curly/mixed-out.R +++ b/tests/testthat/curly-curly/mixed-out.R @@ -59,11 +59,14 @@ call({{ x }}) ## ............................................................................ ## multiple #### -call({ - 1 -}, a + b, { - 33 / f(c) -}) +call( + { + 1 + }, a + b, + { + 33 / f(c) + } +) call({{ x }}, {{ y }}) call({{ x }}, {{ y }}) diff --git a/tests/testthat/line_breaks_and_other/braces-fun-calls-in.R b/tests/testthat/line_breaks_and_other/braces-fun-calls-in.R new file mode 100644 index 000000000..362094575 --- /dev/null +++ b/tests/testthat/line_breaks_and_other/braces-fun-calls-in.R @@ -0,0 +1,35 @@ +# the brace expression is the last argument (classical testthat case) +test_that(x, { + hh +}) + +test_that(x, + { + hh + } +) + + +# there are multiple brace expressions that spread over multiple lines +# (classical tryCatch) +tryCatch({ + exp(x) +}, error = function(x) x) + +tryCatch( + { + exp(x) + }, + error = function(x) x +) + +call({ + blibla +}, { + blublo +}) + +# curly-curly is respected +fio({{x}}) + +test_that("x", {{ k }}) diff --git a/tests/testthat/line_breaks_and_other/braces-fun-calls-in_tree b/tests/testthat/line_breaks_and_other/braces-fun-calls-in_tree new file mode 100644 index 000000000..fcb313c47 --- /dev/null +++ b/tests/testthat/line_breaks_and_other/braces-fun-calls-in_tree @@ -0,0 +1,126 @@ +ROOT (token: short_text [lag_newlines/spaces] {pos_id}) + ¦--COMMENT: # the [0/0] {1} + ¦--expr: [1/0] {2} + ¦ ¦--expr: [0/0] {4} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: test_ [0/0] {3} + ¦ ¦--'(': ( [0/0] {5} + ¦ ¦--expr: [0/0] {7} + ¦ ¦ °--SYMBOL: x [0/0] {6} + ¦ ¦--',': , [0/1] {8} + ¦ ¦--expr: [0/0] {9} + ¦ ¦ ¦--'{': { [0/2] {10} + ¦ ¦ ¦--expr: [1/0] {12} + ¦ ¦ ¦ °--SYMBOL: hh [0/0] {11} + ¦ ¦ °--'}': } [1/0] {13} + ¦ °--')': ) [0/0] {14} + ¦--expr: [2/0] {15} + ¦ ¦--expr: [0/0] {17} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: test_ [0/0] {16} + ¦ ¦--'(': ( [0/0] {18} + ¦ ¦--expr: [0/0] {20} + ¦ ¦ °--SYMBOL: x [0/0] {19} + ¦ ¦--',': , [0/2] {21} + ¦ ¦--expr: [1/0] {22} + ¦ ¦ ¦--'{': { [0/4] {23} + ¦ ¦ ¦--expr: [1/2] {25} + ¦ ¦ ¦ °--SYMBOL: hh [0/0] {24} + ¦ ¦ °--'}': } [1/0] {26} + ¦ °--')': ) [1/0] {27} + ¦--COMMENT: # the [3/0] {28} + ¦--COMMENT: # (cl [1/0] {29} + ¦--expr: [1/0] {30} + ¦ ¦--expr: [0/0] {32} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: tryCa [0/0] {31} + ¦ ¦--'(': ( [0/0] {33} + ¦ ¦--expr: [0/0] {34} + ¦ ¦ ¦--'{': { [0/2] {35} + ¦ ¦ ¦--expr: [1/0] {36} + ¦ ¦ ¦ ¦--expr: [0/0] {38} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: exp [0/0] {37} + ¦ ¦ ¦ ¦--'(': ( [0/0] {39} + ¦ ¦ ¦ ¦--expr: [0/0] {41} + ¦ ¦ ¦ ¦ °--SYMBOL: x [0/0] {40} + ¦ ¦ ¦ °--')': ) [0/0] {42} + ¦ ¦ °--'}': } [1/0] {43} + ¦ ¦--',': , [0/1] {44} + ¦ ¦--SYMBOL_SUB: error [0/1] {45} + ¦ ¦--EQ_SUB: = [0/1] {46} + ¦ ¦--expr: [0/0] {47} + ¦ ¦ ¦--FUNCTION: funct [0/0] {48} + ¦ ¦ ¦--'(': ( [0/0] {49} + ¦ ¦ ¦--SYMBOL_FORMALS: x [0/0] {50} + ¦ ¦ ¦--')': ) [0/1] {51} + ¦ ¦ °--expr: [0/0] {53} + ¦ ¦ °--SYMBOL: x [0/0] {52} + ¦ °--')': ) [0/0] {54} + ¦--expr: [2/0] {55} + ¦ ¦--expr: [0/0] {57} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: tryCa [0/0] {56} + ¦ ¦--'(': ( [0/2] {58} + ¦ ¦--expr: [1/0] {59} + ¦ ¦ ¦--'{': { [0/4] {60} + ¦ ¦ ¦--expr: [1/2] {61} + ¦ ¦ ¦ ¦--expr: [0/0] {63} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: exp [0/0] {62} + ¦ ¦ ¦ ¦--'(': ( [0/0] {64} + ¦ ¦ ¦ ¦--expr: [0/0] {66} + ¦ ¦ ¦ ¦ °--SYMBOL: x [0/0] {65} + ¦ ¦ ¦ °--')': ) [0/0] {67} + ¦ ¦ °--'}': } [1/0] {68} + ¦ ¦--',': , [0/2] {69} + ¦ ¦--SYMBOL_SUB: error [1/1] {70} + ¦ ¦--EQ_SUB: = [0/1] {71} + ¦ ¦--expr: [0/0] {72} + ¦ ¦ ¦--FUNCTION: funct [0/0] {73} + ¦ ¦ ¦--'(': ( [0/0] {74} + ¦ ¦ ¦--SYMBOL_FORMALS: x [0/0] {75} + ¦ ¦ ¦--')': ) [0/1] {76} + ¦ ¦ °--expr: [0/0] {78} + ¦ ¦ °--SYMBOL: x [0/0] {77} + ¦ °--')': ) [1/0] {79} + ¦--expr: [2/0] {80} + ¦ ¦--expr: [0/0] {82} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {81} + ¦ ¦--'(': ( [0/0] {83} + ¦ ¦--expr: [0/0] {84} + ¦ ¦ ¦--'{': { [0/2] {85} + ¦ ¦ ¦--expr: [1/0] {87} + ¦ ¦ ¦ °--SYMBOL: blibl [0/0] {86} + ¦ ¦ °--'}': } [1/0] {88} + ¦ ¦--',': , [0/1] {89} + ¦ ¦--expr: [0/0] {90} + ¦ ¦ ¦--'{': { [0/2] {91} + ¦ ¦ ¦--expr: [1/0] {93} + ¦ ¦ ¦ °--SYMBOL: blubl [0/0] {92} + ¦ ¦ °--'}': } [1/0] {94} + ¦ °--')': ) [0/0] {95} + ¦--COMMENT: # cur [2/0] {96} + ¦--expr: [1/0] {97} + ¦ ¦--expr: [0/0] {99} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: fio [0/0] {98} + ¦ ¦--'(': ( [0/0] {100} + ¦ ¦--expr: [0/0] {101} + ¦ ¦ ¦--'{': { [0/0] {102} + ¦ ¦ ¦--expr: [0/0] {103} + ¦ ¦ ¦ ¦--'{': { [0/0] {104} + ¦ ¦ ¦ ¦--expr: [0/0] {106} + ¦ ¦ ¦ ¦ °--SYMBOL: x [0/0] {105} + ¦ ¦ ¦ °--'}': } [0/0] {107} + ¦ ¦ °--'}': } [0/0] {108} + ¦ °--')': ) [0/0] {109} + °--expr: [2/0] {110} + ¦--expr: [0/0] {112} + ¦ °--SYMBOL_FUNCTION_CALL: test_ [0/0] {111} + ¦--'(': ( [0/0] {113} + ¦--expr: [0/0] {115} + ¦ °--STR_CONST: "x" [0/0] {114} + ¦--',': , [0/1] {116} + ¦--expr: [0/0] {117} + ¦ ¦--'{': { [0/0] {118} + ¦ ¦--expr: [0/0] {119} + ¦ ¦ ¦--'{': { [0/1] {120} + ¦ ¦ ¦--expr: [0/1] {122} + ¦ ¦ ¦ °--SYMBOL: k [0/0] {121} + ¦ ¦ °--'}': } [0/0] {123} + ¦ °--'}': } [0/0] {124} + °--')': ) [0/0] {125} diff --git a/tests/testthat/line_breaks_and_other/braces-fun-calls-out.R b/tests/testthat/line_breaks_and_other/braces-fun-calls-out.R new file mode 100644 index 000000000..df9b2137d --- /dev/null +++ b/tests/testthat/line_breaks_and_other/braces-fun-calls-out.R @@ -0,0 +1,39 @@ +# the brace expression is the last argument (classical testthat case) +test_that(x, { + hh +}) + +test_that(x, { + hh +}) + + +# there are multiple brace expressions that spread over multiple lines +# (classical tryCatch) +tryCatch( + { + exp(x) + }, + error = function(x) x +) + +tryCatch( + { + exp(x) + }, + error = function(x) x +) + +call( + { + blibla + }, + { + blublo + } +) + +# curly-curly is respected +fio({{ x }}) + +test_that("x", {{ k }}) diff --git a/tests/testthat/test-line_breaks_and_other.R b/tests/testthat/test-line_breaks_and_other.R index 97603068d..88637bd9e 100644 --- a/tests/testthat/test-line_breaks_and_other.R +++ b/tests/testthat/test-line_breaks_and_other.R @@ -5,6 +5,12 @@ test_that("line breaks involing curly brackets", { transformer = style_text), NA) }) +test_that("line breaks involing curly brackets", { + expect_warning(test_collection("line_breaks_and_other", "braces-fun-calls", + transformer = style_text), NA) +}) + + test_that("line breaks involing curly brackets", { expect_warning(test_collection("line_breaks_and_other", "edge_comment_and_curly", transformer = style_text), NA) From 0116c95981c47efe9bbc6c0f1cdb5796336ccdc6 Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Tue, 17 Sep 2019 09:44:49 +0200 Subject: [PATCH 2/8] add news bullet --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 6d53ac461..183dcdbfd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -25,6 +25,9 @@ ## Minor improvements and fixes +* brace expressions in function calls are formatted in a less compact way. This + improves the formatting of `tryCatch()` in many cases (#543). + * escape characters in roxygen code examples are now correctly escaped (#512). * style selection Addin now preserves line break when the last line selected is From bbff73468ce4189b35e8e4808d0ab04dd67b2990 Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Tue, 17 Sep 2019 10:09:32 +0200 Subject: [PATCH 3/8] fix unrelated r rmd check will merge conflict with 7ed140ecf042833a9aa04fd2693fd701afe924a9 --- R/io.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/io.R b/R/io.R index 6fe8e39fd..495650ca5 100644 --- a/R/io.R +++ b/R/io.R @@ -74,7 +74,7 @@ read_utf8_bare <- function(con, warn = TRUE) { "The file ", con, " is not encoded in UTF-8. ", "These lines contain invalid UTF-8 characters: " ), - paste(c(head(i), if (n > 6) "..."), collapse = ", ") + paste(c(utils::head(i), if (n > 6) "..."), collapse = ", ") ) } x From 0c844fab8e1d5f1d7dd961fb426b47e17053fde6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Thu, 19 Sep 2019 01:26:48 +0200 Subject: [PATCH 4/8] Add more test cases --- tests/testthat/curly-curly/mixed-in.R | 18 ++ tests/testthat/curly-curly/mixed-in_tree | 306 +++++++++++++---------- tests/testthat/curly-curly/mixed-out.R | 18 ++ 3 files changed, 215 insertions(+), 127 deletions(-) diff --git a/tests/testthat/curly-curly/mixed-in.R b/tests/testthat/curly-curly/mixed-in.R index 385319ab2..727c2ef89 100644 --- a/tests/testthat/curly-curly/mixed-in.R +++ b/tests/testthat/curly-curly/mixed-in.R @@ -66,6 +66,24 @@ call({ ## ............................................................................ ## multiple #### +call("test", { + 1 +}) + +call( + "test", { + 1 +}) + +call("test", + { + 1 + }) + +call("test", { + 1 } +) + call({ 1 }, a + b, { 33 / f(c)}) diff --git a/tests/testthat/curly-curly/mixed-in_tree b/tests/testthat/curly-curly/mixed-in_tree index c512d47f5..e2ffe8200 100644 --- a/tests/testthat/curly-curly/mixed-in_tree +++ b/tests/testthat/curly-curly/mixed-in_tree @@ -269,131 +269,183 @@ ROOT (token: short_text [lag_newlines/spaces] {pos_id}) ¦ ¦--expr: [0/0] {269} ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {268} ¦ ¦--'(': ( [0/0] {270} - ¦ ¦--expr: [0/0] {271} - ¦ ¦ ¦--'{': { [0/2] {272} - ¦ ¦ ¦--expr: [1/0] {274} - ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {273} - ¦ ¦ °--'}': } [1/0] {275} - ¦ ¦--',': , [0/1] {276} - ¦ ¦--expr: [0/0] {277} - ¦ ¦ ¦--expr: [0/1] {279} - ¦ ¦ ¦ °--SYMBOL: a [0/0] {278} - ¦ ¦ ¦--'+': + [0/1] {280} - ¦ ¦ °--expr: [0/0] {282} - ¦ ¦ °--SYMBOL: b [0/0] {281} - ¦ ¦--',': , [0/1] {283} - ¦ ¦--expr: [0/0] {284} - ¦ ¦ ¦--'{': { [0/1] {285} - ¦ ¦ ¦--expr: [0/0] {286} - ¦ ¦ ¦ ¦--expr: [0/1] {288} - ¦ ¦ ¦ ¦ °--NUM_CONST: 33 [0/0] {287} - ¦ ¦ ¦ ¦--'/': / [0/1] {289} - ¦ ¦ ¦ °--expr: [0/0] {290} - ¦ ¦ ¦ ¦--expr: [0/0] {292} - ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: f [0/0] {291} - ¦ ¦ ¦ ¦--'(': ( [0/0] {293} - ¦ ¦ ¦ ¦--expr: [0/0] {295} - ¦ ¦ ¦ ¦ °--SYMBOL: c [0/0] {294} - ¦ ¦ ¦ °--')': ) [0/0] {296} - ¦ ¦ °--'}': } [0/0] {297} - ¦ °--')': ) [0/0] {298} - ¦--expr: [2/0] {299} - ¦ ¦--expr: [0/0] {301} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {300} - ¦ ¦--'(': ( [0/0] {302} - ¦ ¦--expr: [0/0] {303} - ¦ ¦ ¦--'{': { [0/0] {304} - ¦ ¦ ¦--expr: [0/0] {305} - ¦ ¦ ¦ ¦--'{': { [0/1] {306} - ¦ ¦ ¦ ¦--expr: [0/1] {308} - ¦ ¦ ¦ ¦ °--SYMBOL: x [0/0] {307} - ¦ ¦ ¦ °--'}': } [0/0] {309} - ¦ ¦ °--'}': } [0/0] {310} - ¦ ¦--',': , [0/1] {311} - ¦ ¦--expr: [0/0] {312} - ¦ ¦ ¦--'{': { [0/0] {313} - ¦ ¦ ¦--expr: [0/0] {314} - ¦ ¦ ¦ ¦--'{': { [0/1] {315} - ¦ ¦ ¦ ¦--expr: [0/0] {317} - ¦ ¦ ¦ ¦ °--SYMBOL: y [0/0] {316} - ¦ ¦ ¦ °--'}': } [0/0] {318} - ¦ ¦ °--'}': } [0/0] {319} - ¦ °--')': ) [0/0] {320} - ¦--expr: [1/0] {321} + ¦ ¦--expr: [0/0] {272} + ¦ ¦ °--STR_CONST: "test [0/0] {271} + ¦ ¦--',': , [0/1] {273} + ¦ ¦--expr: [0/0] {274} + ¦ ¦ ¦--'{': { [0/2] {275} + ¦ ¦ ¦--expr: [1/0] {277} + ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {276} + ¦ ¦ °--'}': } [1/0] {278} + ¦ °--')': ) [0/0] {279} + ¦--expr: [2/0] {280} + ¦ ¦--expr: [0/0] {282} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {281} + ¦ ¦--'(': ( [0/2] {283} + ¦ ¦--expr: [1/0] {285} + ¦ ¦ °--STR_CONST: "test [0/0] {284} + ¦ ¦--',': , [0/1] {286} + ¦ ¦--expr: [0/0] {287} + ¦ ¦ ¦--'{': { [0/2] {288} + ¦ ¦ ¦--expr: [1/0] {290} + ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {289} + ¦ ¦ °--'}': } [1/0] {291} + ¦ °--')': ) [0/0] {292} + ¦--expr: [2/0] {293} + ¦ ¦--expr: [0/0] {295} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {294} + ¦ ¦--'(': ( [0/0] {296} + ¦ ¦--expr: [0/0] {298} + ¦ ¦ °--STR_CONST: "test [0/0] {297} + ¦ ¦--',': , [0/5] {299} + ¦ ¦--expr: [1/0] {300} + ¦ ¦ ¦--'{': { [0/4] {301} + ¦ ¦ ¦--expr: [1/2] {303} + ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {302} + ¦ ¦ °--'}': } [1/0] {304} + ¦ °--')': ) [0/0] {305} + ¦--expr: [2/0] {306} + ¦ ¦--expr: [0/0] {308} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {307} + ¦ ¦--'(': ( [0/0] {309} + ¦ ¦--expr: [0/0] {311} + ¦ ¦ °--STR_CONST: "test [0/0] {310} + ¦ ¦--',': , [0/1] {312} + ¦ ¦--expr: [0/0] {313} + ¦ ¦ ¦--'{': { [0/2] {314} + ¦ ¦ ¦--expr: [1/1] {316} + ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {315} + ¦ ¦ °--'}': } [0/0] {317} + ¦ °--')': ) [1/0] {318} + ¦--expr: [2/0] {319} + ¦ ¦--expr: [0/0] {321} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {320} + ¦ ¦--'(': ( [0/0] {322} ¦ ¦--expr: [0/0] {323} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {322} - ¦ ¦--'(': ( [0/0] {324} - ¦ ¦--expr: [0/0] {325} - ¦ ¦ ¦--'{': { [0/0] {326} - ¦ ¦ ¦--expr: [0/0] {327} - ¦ ¦ ¦ ¦--'{': { [0/1] {328} - ¦ ¦ ¦ ¦--expr: [0/1] {330} - ¦ ¦ ¦ ¦ °--SYMBOL: x [0/0] {329} - ¦ ¦ ¦ °--'}': } [0/0] {331} - ¦ ¦ °--'}': } [0/0] {332} - ¦ ¦--',': , [0/1] {333} - ¦ ¦--expr: [0/0] {334} - ¦ ¦ ¦--'{': { [0/0] {335} - ¦ ¦ ¦--expr: [0/2] {336} - ¦ ¦ ¦ ¦--'{': { [0/1] {337} - ¦ ¦ ¦ ¦--expr: [0/0] {339} - ¦ ¦ ¦ ¦ °--SYMBOL: y [0/0] {338} - ¦ ¦ ¦ °--'}': } [0/0] {340} - ¦ ¦ °--'}': } [1/0] {341} - ¦ °--')': ) [0/0] {342} - ¦--expr: [1/0] {343} - ¦ ¦--expr: [0/0] {345} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {344} - ¦ ¦--'(': ( [0/2] {346} - ¦ ¦--expr: [1/0] {347} - ¦ ¦ ¦--'{': { [0/0] {348} - ¦ ¦ ¦--expr: [0/0] {349} - ¦ ¦ ¦ ¦--'{': { [0/1] {350} - ¦ ¦ ¦ ¦--expr: [0/1] {352} - ¦ ¦ ¦ ¦ °--SYMBOL: x [0/0] {351} - ¦ ¦ ¦ °--'}': } [0/0] {353} - ¦ ¦ °--'}': } [0/0] {354} - ¦ ¦--',': , [0/1] {355} - ¦ ¦--expr: [0/0] {356} - ¦ ¦ ¦--'{': { [0/0] {357} - ¦ ¦ ¦--expr: [0/0] {358} - ¦ ¦ ¦ ¦--'{': { [0/1] {359} - ¦ ¦ ¦ ¦--expr: [0/0] {361} - ¦ ¦ ¦ ¦ °--SYMBOL: y [0/0] {360} - ¦ ¦ ¦ °--'}': } [0/0] {362} - ¦ ¦ °--'}': } [0/0] {363} - ¦ °--')': ) [0/0] {364} - °--expr: [2/0] {365} - ¦--expr: [0/0] {367} - ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {366} - ¦--'(': ( [0/2] {368} - ¦--expr: [1/0] {369} - ¦ ¦--'{': { [0/0] {370} - ¦ ¦--expr: [0/0] {371} - ¦ ¦ ¦--'{': { [0/1] {372} - ¦ ¦ ¦--expr: [0/1] {374} - ¦ ¦ ¦ °--SYMBOL: x [0/0] {373} - ¦ ¦ °--'}': } [0/0] {375} - ¦ °--'}': } [0/0] {376} - ¦--',': , [0/2] {377} - ¦--expr: [1/0] {378} - ¦ ¦--expr: [0/1] {379} - ¦ ¦ ¦--'{': { [0/0] {380} - ¦ ¦ ¦--expr: [0/0] {381} - ¦ ¦ ¦ ¦--'{': { [0/1] {382} - ¦ ¦ ¦ ¦--expr: [0/0] {384} - ¦ ¦ ¦ ¦ °--SYMBOL: y [0/0] {383} - ¦ ¦ ¦ °--'}': } [0/0] {385} - ¦ ¦ °--'}': } [0/0] {386} - ¦ ¦--LEFT_ASSIGN: := [0/1] {387} - ¦ °--expr: [0/0] {389} - ¦ °--NUM_CONST: 3 [0/0] {388} - ¦--',': , [0/1] {390} - ¦--expr: [0/0] {391} - ¦ ¦--expr: [0/0] {393} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: f [0/0] {392} - ¦ ¦--'(': ( [0/0] {394} - ¦ ¦--expr: [0/0] {396} - ¦ ¦ °--SYMBOL: bk [0/0] {395} - ¦ °--')': ) [0/0] {397} - °--')': ) [1/0] {398} + ¦ ¦ ¦--'{': { [0/2] {324} + ¦ ¦ ¦--expr: [1/0] {326} + ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {325} + ¦ ¦ °--'}': } [1/0] {327} + ¦ ¦--',': , [0/1] {328} + ¦ ¦--expr: [0/0] {329} + ¦ ¦ ¦--expr: [0/1] {331} + ¦ ¦ ¦ °--SYMBOL: a [0/0] {330} + ¦ ¦ ¦--'+': + [0/1] {332} + ¦ ¦ °--expr: [0/0] {334} + ¦ ¦ °--SYMBOL: b [0/0] {333} + ¦ ¦--',': , [0/1] {335} + ¦ ¦--expr: [0/0] {336} + ¦ ¦ ¦--'{': { [0/1] {337} + ¦ ¦ ¦--expr: [0/0] {338} + ¦ ¦ ¦ ¦--expr: [0/1] {340} + ¦ ¦ ¦ ¦ °--NUM_CONST: 33 [0/0] {339} + ¦ ¦ ¦ ¦--'/': / [0/1] {341} + ¦ ¦ ¦ °--expr: [0/0] {342} + ¦ ¦ ¦ ¦--expr: [0/0] {344} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: f [0/0] {343} + ¦ ¦ ¦ ¦--'(': ( [0/0] {345} + ¦ ¦ ¦ ¦--expr: [0/0] {347} + ¦ ¦ ¦ ¦ °--SYMBOL: c [0/0] {346} + ¦ ¦ ¦ °--')': ) [0/0] {348} + ¦ ¦ °--'}': } [0/0] {349} + ¦ °--')': ) [0/0] {350} + ¦--expr: [2/0] {351} + ¦ ¦--expr: [0/0] {353} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {352} + ¦ ¦--'(': ( [0/0] {354} + ¦ ¦--expr: [0/0] {355} + ¦ ¦ ¦--'{': { [0/0] {356} + ¦ ¦ ¦--expr: [0/0] {357} + ¦ ¦ ¦ ¦--'{': { [0/1] {358} + ¦ ¦ ¦ ¦--expr: [0/1] {360} + ¦ ¦ ¦ ¦ °--SYMBOL: x [0/0] {359} + ¦ ¦ ¦ °--'}': } [0/0] {361} + ¦ ¦ °--'}': } [0/0] {362} + ¦ ¦--',': , [0/1] {363} + ¦ ¦--expr: [0/0] {364} + ¦ ¦ ¦--'{': { [0/0] {365} + ¦ ¦ ¦--expr: [0/0] {366} + ¦ ¦ ¦ ¦--'{': { [0/1] {367} + ¦ ¦ ¦ ¦--expr: [0/0] {369} + ¦ ¦ ¦ ¦ °--SYMBOL: y [0/0] {368} + ¦ ¦ ¦ °--'}': } [0/0] {370} + ¦ ¦ °--'}': } [0/0] {371} + ¦ °--')': ) [0/0] {372} + ¦--expr: [1/0] {373} + ¦ ¦--expr: [0/0] {375} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {374} + ¦ ¦--'(': ( [0/0] {376} + ¦ ¦--expr: [0/0] {377} + ¦ ¦ ¦--'{': { [0/0] {378} + ¦ ¦ ¦--expr: [0/0] {379} + ¦ ¦ ¦ ¦--'{': { [0/1] {380} + ¦ ¦ ¦ ¦--expr: [0/1] {382} + ¦ ¦ ¦ ¦ °--SYMBOL: x [0/0] {381} + ¦ ¦ ¦ °--'}': } [0/0] {383} + ¦ ¦ °--'}': } [0/0] {384} + ¦ ¦--',': , [0/1] {385} + ¦ ¦--expr: [0/0] {386} + ¦ ¦ ¦--'{': { [0/0] {387} + ¦ ¦ ¦--expr: [0/2] {388} + ¦ ¦ ¦ ¦--'{': { [0/1] {389} + ¦ ¦ ¦ ¦--expr: [0/0] {391} + ¦ ¦ ¦ ¦ °--SYMBOL: y [0/0] {390} + ¦ ¦ ¦ °--'}': } [0/0] {392} + ¦ ¦ °--'}': } [1/0] {393} + ¦ °--')': ) [0/0] {394} + ¦--expr: [1/0] {395} + ¦ ¦--expr: [0/0] {397} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {396} + ¦ ¦--'(': ( [0/2] {398} + ¦ ¦--expr: [1/0] {399} + ¦ ¦ ¦--'{': { [0/0] {400} + ¦ ¦ ¦--expr: [0/0] {401} + ¦ ¦ ¦ ¦--'{': { [0/1] {402} + ¦ ¦ ¦ ¦--expr: [0/1] {404} + ¦ ¦ ¦ ¦ °--SYMBOL: x [0/0] {403} + ¦ ¦ ¦ °--'}': } [0/0] {405} + ¦ ¦ °--'}': } [0/0] {406} + ¦ ¦--',': , [0/1] {407} + ¦ ¦--expr: [0/0] {408} + ¦ ¦ ¦--'{': { [0/0] {409} + ¦ ¦ ¦--expr: [0/0] {410} + ¦ ¦ ¦ ¦--'{': { [0/1] {411} + ¦ ¦ ¦ ¦--expr: [0/0] {413} + ¦ ¦ ¦ ¦ °--SYMBOL: y [0/0] {412} + ¦ ¦ ¦ °--'}': } [0/0] {414} + ¦ ¦ °--'}': } [0/0] {415} + ¦ °--')': ) [0/0] {416} + °--expr: [2/0] {417} + ¦--expr: [0/0] {419} + ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {418} + ¦--'(': ( [0/2] {420} + ¦--expr: [1/0] {421} + ¦ ¦--'{': { [0/0] {422} + ¦ ¦--expr: [0/0] {423} + ¦ ¦ ¦--'{': { [0/1] {424} + ¦ ¦ ¦--expr: [0/1] {426} + ¦ ¦ ¦ °--SYMBOL: x [0/0] {425} + ¦ ¦ °--'}': } [0/0] {427} + ¦ °--'}': } [0/0] {428} + ¦--',': , [0/2] {429} + ¦--expr: [1/0] {430} + ¦ ¦--expr: [0/1] {431} + ¦ ¦ ¦--'{': { [0/0] {432} + ¦ ¦ ¦--expr: [0/0] {433} + ¦ ¦ ¦ ¦--'{': { [0/1] {434} + ¦ ¦ ¦ ¦--expr: [0/0] {436} + ¦ ¦ ¦ ¦ °--SYMBOL: y [0/0] {435} + ¦ ¦ ¦ °--'}': } [0/0] {437} + ¦ ¦ °--'}': } [0/0] {438} + ¦ ¦--LEFT_ASSIGN: := [0/1] {439} + ¦ °--expr: [0/0] {441} + ¦ °--NUM_CONST: 3 [0/0] {440} + ¦--',': , [0/1] {442} + ¦--expr: [0/0] {443} + ¦ ¦--expr: [0/0] {445} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: f [0/0] {444} + ¦ ¦--'(': ( [0/0] {446} + ¦ ¦--expr: [0/0] {448} + ¦ ¦ °--SYMBOL: bk [0/0] {447} + ¦ °--')': ) [0/0] {449} + °--')': ) [1/0] {450} diff --git a/tests/testthat/curly-curly/mixed-out.R b/tests/testthat/curly-curly/mixed-out.R index 473ca2975..8e035f75c 100644 --- a/tests/testthat/curly-curly/mixed-out.R +++ b/tests/testthat/curly-curly/mixed-out.R @@ -59,6 +59,24 @@ call({{ x }}) ## ............................................................................ ## multiple #### +call("test", { + 1 +}) + +call( + "test", { + 1 + } +) + +call("test", { + 1 +}) + +call("test", { + 1 +}) + call( { 1 From dac46a837796c6c4c2d0c2d9a0c716554f655a7b Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Sun, 22 Sep 2019 17:33:24 +0200 Subject: [PATCH 5/8] extend rules for non-brace expressions --- R/rules-line-break.R | 24 +- R/style-guides.R | 2 +- ...-fun-calls-in.R => braces-fun-calls1-in.R} | 0 ...alls-in_tree => braces-fun-calls1-in_tree} | 0 ...un-calls-out.R => braces-fun-calls1-out.R} | 6 +- .../braces-fun-calls2-in.R | 71 ++++++ .../braces-fun-calls2-in_tree | 222 ++++++++++++++++++ .../braces-fun-calls2-out.R | 78 ++++++ 8 files changed, 398 insertions(+), 5 deletions(-) rename tests/testthat/line_breaks_and_other/{braces-fun-calls-in.R => braces-fun-calls1-in.R} (100%) rename tests/testthat/line_breaks_and_other/{braces-fun-calls-in_tree => braces-fun-calls1-in_tree} (100%) rename tests/testthat/line_breaks_and_other/{braces-fun-calls-out.R => braces-fun-calls1-out.R} (87%) create mode 100644 tests/testthat/line_breaks_and_other/braces-fun-calls2-in.R create mode 100644 tests/testthat/line_breaks_and_other/braces-fun-calls2-in_tree create mode 100644 tests/testthat/line_breaks_and_other/braces-fun-calls2-out.R diff --git a/R/rules-line-break.R b/R/rules-line-break.R index 85553cd8b..1644a0de6 100644 --- a/R/rules-line-break.R +++ b/R/rules-line-break.R @@ -1,5 +1,16 @@ -# A { should never go on its own line -remove_line_break_before_curly_opening <- function(pd) { +#' Set line break before a curly brace +#' +#' Rule: Function arguments that consist of a braced expression always need to +#' start on a new line, unless it's the last argument and all other arguments +#' fit on the line of the function call or they are named. +#' @keywords internal +#' @examples +#' \dontrun{ +#' testthat("braces braces are cool", { +#' code(to = execute) +#' }) +#' } +set_line_break_before_curly_opening <- function(pd) { line_break_to_set_idx <- which((pd$token_after == "'{'") & (pd$token != "COMMENT")) line_break_to_set_idx <- setdiff(line_break_to_set_idx, nrow(pd)) if (length(line_break_to_set_idx) > 0) { @@ -13,18 +24,27 @@ remove_line_break_before_curly_opening <- function(pd) { TRUE, (line_break_to_set_idx + 1L) == last_expr_idx ) eq_sub_before <- pd$token[line_break_to_set_idx] == "EQ_SUB" + # no line break before last brace expression and named brace expression to should_be_on_same_line <- is_not_curly_curly & (is_last_expr | eq_sub_before) is_not_curly_curly_idx <- line_break_to_set_idx[should_be_on_same_line] pd$lag_newlines[1 + is_not_curly_curly_idx] <- 0L + # other cases: line breaks should_not_be_on_same_line <- is_not_curly_curly & (!is_last_expr & !eq_sub_before) should_not_be_on_same_line_idx <- line_break_to_set_idx[should_not_be_on_same_line] pd$lag_newlines[1 + should_not_be_on_same_line_idx] <- 1L + + # non-curly expressions after curly expressions must have line breaks + exprs_idx <- which(pd$token == "expr") + exprs_after_last_expr_with_line_break_idx <- + exprs_idx[exprs_idx > should_not_be_on_same_line_idx[1] + 1L] + pd$lag_newlines[exprs_after_last_expr_with_line_break_idx] <- 1L } pd } + set_line_break_around_comma <- function(pd) { comma_with_line_break_that_can_be_removed_before <- (pd$token == "','") & diff --git a/R/style-guides.R b/R/style-guides.R index c802d90a4..ab9ee94ae 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -114,7 +114,7 @@ tidyverse_style <- function(scope = "tokens", line_break_manipulators <- if (scope >= "line_breaks") { lst( set_line_break_around_comma, - remove_line_break_before_curly_opening, + set_line_break_before_curly_opening, remove_line_break_before_round_closing_after_curly = if (strict) remove_line_break_before_round_closing_after_curly, remove_line_break_before_round_closing_fun_dec = diff --git a/tests/testthat/line_breaks_and_other/braces-fun-calls-in.R b/tests/testthat/line_breaks_and_other/braces-fun-calls1-in.R similarity index 100% rename from tests/testthat/line_breaks_and_other/braces-fun-calls-in.R rename to tests/testthat/line_breaks_and_other/braces-fun-calls1-in.R diff --git a/tests/testthat/line_breaks_and_other/braces-fun-calls-in_tree b/tests/testthat/line_breaks_and_other/braces-fun-calls1-in_tree similarity index 100% rename from tests/testthat/line_breaks_and_other/braces-fun-calls-in_tree rename to tests/testthat/line_breaks_and_other/braces-fun-calls1-in_tree diff --git a/tests/testthat/line_breaks_and_other/braces-fun-calls-out.R b/tests/testthat/line_breaks_and_other/braces-fun-calls1-out.R similarity index 87% rename from tests/testthat/line_breaks_and_other/braces-fun-calls-out.R rename to tests/testthat/line_breaks_and_other/braces-fun-calls1-out.R index df9b2137d..1f541ca58 100644 --- a/tests/testthat/line_breaks_and_other/braces-fun-calls-out.R +++ b/tests/testthat/line_breaks_and_other/braces-fun-calls1-out.R @@ -14,14 +14,16 @@ tryCatch( { exp(x) }, - error = function(x) x + error = + function(x) x ) tryCatch( { exp(x) }, - error = function(x) x + error = + function(x) x ) call( diff --git a/tests/testthat/line_breaks_and_other/braces-fun-calls2-in.R b/tests/testthat/line_breaks_and_other/braces-fun-calls2-in.R new file mode 100644 index 000000000..ccf82d119 --- /dev/null +++ b/tests/testthat/line_breaks_and_other/braces-fun-calls2-in.R @@ -0,0 +1,71 @@ +test( + "x", + { + + }, a + b, { + s(x = sd) + } +) + +test( + "x", { + + }, a + b, { + s(x = sd) + } +) + +test( + "x", + { + + }, + a + b, { + s(x = sd) + } +) + + +test( + "x", + { + + }, + a + b, + { + s(x = sd) + } +) + +test( + "x", + { + + }, # h + a + b, { + s(x = sd) + } +) + +test( + "x", + { + + }, # h + a + b, + # k + { + s(x = sd) + } +) + +test( + "x", + { + + }, + a + b, # k + { + s(x = sd) + } +) diff --git a/tests/testthat/line_breaks_and_other/braces-fun-calls2-in_tree b/tests/testthat/line_breaks_and_other/braces-fun-calls2-in_tree new file mode 100644 index 000000000..4a2d6f6fc --- /dev/null +++ b/tests/testthat/line_breaks_and_other/braces-fun-calls2-in_tree @@ -0,0 +1,222 @@ +ROOT (token: short_text [lag_newlines/spaces] {pos_id}) + ¦--expr: [0/0] {1} + ¦ ¦--expr: [0/0] {3} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: test [0/0] {2} + ¦ ¦--'(': ( [0/2] {4} + ¦ ¦--expr: [1/0] {6} + ¦ ¦ °--STR_CONST: "x" [0/0] {5} + ¦ ¦--',': , [0/2] {7} + ¦ ¦--expr: [1/0] {8} + ¦ ¦ ¦--'{': { [0/2] {9} + ¦ ¦ °--'}': } [2/0] {10} + ¦ ¦--',': , [0/1] {11} + ¦ ¦--expr: [0/0] {12} + ¦ ¦ ¦--expr: [0/1] {14} + ¦ ¦ ¦ °--SYMBOL: a [0/0] {13} + ¦ ¦ ¦--'+': + [0/1] {15} + ¦ ¦ °--expr: [0/0] {17} + ¦ ¦ °--SYMBOL: b [0/0] {16} + ¦ ¦--',': , [0/1] {18} + ¦ ¦--expr: [0/0] {19} + ¦ ¦ ¦--'{': { [0/4] {20} + ¦ ¦ ¦--expr: [1/2] {21} + ¦ ¦ ¦ ¦--expr: [0/0] {23} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: s [0/0] {22} + ¦ ¦ ¦ ¦--'(': ( [0/0] {24} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {25} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {26} + ¦ ¦ ¦ ¦--expr: [0/0] {28} + ¦ ¦ ¦ ¦ °--SYMBOL: sd [0/0] {27} + ¦ ¦ ¦ °--')': ) [0/0] {29} + ¦ ¦ °--'}': } [1/0] {30} + ¦ °--')': ) [1/0] {31} + ¦--expr: [2/0] {32} + ¦ ¦--expr: [0/0] {34} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: test [0/0] {33} + ¦ ¦--'(': ( [0/2] {35} + ¦ ¦--expr: [1/0] {37} + ¦ ¦ °--STR_CONST: "x" [0/0] {36} + ¦ ¦--',': , [0/1] {38} + ¦ ¦--expr: [0/0] {39} + ¦ ¦ ¦--'{': { [0/2] {40} + ¦ ¦ °--'}': } [2/0] {41} + ¦ ¦--',': , [0/1] {42} + ¦ ¦--expr: [0/0] {43} + ¦ ¦ ¦--expr: [0/1] {45} + ¦ ¦ ¦ °--SYMBOL: a [0/0] {44} + ¦ ¦ ¦--'+': + [0/1] {46} + ¦ ¦ °--expr: [0/0] {48} + ¦ ¦ °--SYMBOL: b [0/0] {47} + ¦ ¦--',': , [0/1] {49} + ¦ ¦--expr: [0/0] {50} + ¦ ¦ ¦--'{': { [0/4] {51} + ¦ ¦ ¦--expr: [1/2] {52} + ¦ ¦ ¦ ¦--expr: [0/0] {54} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: s [0/0] {53} + ¦ ¦ ¦ ¦--'(': ( [0/0] {55} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {56} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {57} + ¦ ¦ ¦ ¦--expr: [0/0] {59} + ¦ ¦ ¦ ¦ °--SYMBOL: sd [0/0] {58} + ¦ ¦ ¦ °--')': ) [0/0] {60} + ¦ ¦ °--'}': } [1/0] {61} + ¦ °--')': ) [1/0] {62} + ¦--expr: [2/0] {63} + ¦ ¦--expr: [0/0] {65} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: test [0/0] {64} + ¦ ¦--'(': ( [0/2] {66} + ¦ ¦--expr: [1/0] {68} + ¦ ¦ °--STR_CONST: "x" [0/0] {67} + ¦ ¦--',': , [0/2] {69} + ¦ ¦--expr: [1/0] {70} + ¦ ¦ ¦--'{': { [0/2] {71} + ¦ ¦ °--'}': } [2/0] {72} + ¦ ¦--',': , [0/2] {73} + ¦ ¦--expr: [1/0] {74} + ¦ ¦ ¦--expr: [0/1] {76} + ¦ ¦ ¦ °--SYMBOL: a [0/0] {75} + ¦ ¦ ¦--'+': + [0/1] {77} + ¦ ¦ °--expr: [0/0] {79} + ¦ ¦ °--SYMBOL: b [0/0] {78} + ¦ ¦--',': , [0/1] {80} + ¦ ¦--expr: [0/0] {81} + ¦ ¦ ¦--'{': { [0/4] {82} + ¦ ¦ ¦--expr: [1/2] {83} + ¦ ¦ ¦ ¦--expr: [0/0] {85} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: s [0/0] {84} + ¦ ¦ ¦ ¦--'(': ( [0/0] {86} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {87} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {88} + ¦ ¦ ¦ ¦--expr: [0/0] {90} + ¦ ¦ ¦ ¦ °--SYMBOL: sd [0/0] {89} + ¦ ¦ ¦ °--')': ) [0/0] {91} + ¦ ¦ °--'}': } [1/0] {92} + ¦ °--')': ) [1/0] {93} + ¦--expr: [3/0] {94} + ¦ ¦--expr: [0/0] {96} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: test [0/0] {95} + ¦ ¦--'(': ( [0/2] {97} + ¦ ¦--expr: [1/0] {99} + ¦ ¦ °--STR_CONST: "x" [0/0] {98} + ¦ ¦--',': , [0/2] {100} + ¦ ¦--expr: [1/0] {101} + ¦ ¦ ¦--'{': { [0/2] {102} + ¦ ¦ °--'}': } [2/0] {103} + ¦ ¦--',': , [0/2] {104} + ¦ ¦--expr: [1/0] {105} + ¦ ¦ ¦--expr: [0/1] {107} + ¦ ¦ ¦ °--SYMBOL: a [0/0] {106} + ¦ ¦ ¦--'+': + [0/1] {108} + ¦ ¦ °--expr: [0/0] {110} + ¦ ¦ °--SYMBOL: b [0/0] {109} + ¦ ¦--',': , [0/2] {111} + ¦ ¦--expr: [1/0] {112} + ¦ ¦ ¦--'{': { [0/4] {113} + ¦ ¦ ¦--expr: [1/2] {114} + ¦ ¦ ¦ ¦--expr: [0/0] {116} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: s [0/0] {115} + ¦ ¦ ¦ ¦--'(': ( [0/0] {117} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {118} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {119} + ¦ ¦ ¦ ¦--expr: [0/0] {121} + ¦ ¦ ¦ ¦ °--SYMBOL: sd [0/0] {120} + ¦ ¦ ¦ °--')': ) [0/0] {122} + ¦ ¦ °--'}': } [1/0] {123} + ¦ °--')': ) [1/0] {124} + ¦--expr: [2/0] {125} + ¦ ¦--expr: [0/0] {127} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: test [0/0] {126} + ¦ ¦--'(': ( [0/2] {128} + ¦ ¦--expr: [1/0] {130} + ¦ ¦ °--STR_CONST: "x" [0/0] {129} + ¦ ¦--',': , [0/2] {131} + ¦ ¦--expr: [1/0] {132} + ¦ ¦ ¦--'{': { [0/2] {133} + ¦ ¦ °--'}': } [2/0] {134} + ¦ ¦--',': , [0/1] {135} + ¦ ¦--COMMENT: # h [0/2] {136} + ¦ ¦--expr: [1/0] {137} + ¦ ¦ ¦--expr: [0/1] {139} + ¦ ¦ ¦ °--SYMBOL: a [0/0] {138} + ¦ ¦ ¦--'+': + [0/1] {140} + ¦ ¦ °--expr: [0/0] {142} + ¦ ¦ °--SYMBOL: b [0/0] {141} + ¦ ¦--',': , [0/1] {143} + ¦ ¦--expr: [0/0] {144} + ¦ ¦ ¦--'{': { [0/4] {145} + ¦ ¦ ¦--expr: [1/2] {146} + ¦ ¦ ¦ ¦--expr: [0/0] {148} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: s [0/0] {147} + ¦ ¦ ¦ ¦--'(': ( [0/0] {149} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {150} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {151} + ¦ ¦ ¦ ¦--expr: [0/0] {153} + ¦ ¦ ¦ ¦ °--SYMBOL: sd [0/0] {152} + ¦ ¦ ¦ °--')': ) [0/0] {154} + ¦ ¦ °--'}': } [1/0] {155} + ¦ °--')': ) [1/0] {156} + ¦--expr: [2/0] {157} + ¦ ¦--expr: [0/0] {159} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: test [0/0] {158} + ¦ ¦--'(': ( [0/2] {160} + ¦ ¦--expr: [1/0] {162} + ¦ ¦ °--STR_CONST: "x" [0/0] {161} + ¦ ¦--',': , [0/2] {163} + ¦ ¦--expr: [1/0] {164} + ¦ ¦ ¦--'{': { [0/2] {165} + ¦ ¦ °--'}': } [2/0] {166} + ¦ ¦--',': , [0/1] {167} + ¦ ¦--COMMENT: # h [0/2] {168} + ¦ ¦--expr: [1/0] {169} + ¦ ¦ ¦--expr: [0/1] {171} + ¦ ¦ ¦ °--SYMBOL: a [0/0] {170} + ¦ ¦ ¦--'+': + [0/1] {172} + ¦ ¦ °--expr: [0/0] {174} + ¦ ¦ °--SYMBOL: b [0/0] {173} + ¦ ¦--',': , [0/2] {175} + ¦ ¦--COMMENT: # k [1/2] {176} + ¦ ¦--expr: [1/0] {177} + ¦ ¦ ¦--'{': { [0/4] {178} + ¦ ¦ ¦--expr: [1/2] {179} + ¦ ¦ ¦ ¦--expr: [0/0] {181} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: s [0/0] {180} + ¦ ¦ ¦ ¦--'(': ( [0/0] {182} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {183} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {184} + ¦ ¦ ¦ ¦--expr: [0/0] {186} + ¦ ¦ ¦ ¦ °--SYMBOL: sd [0/0] {185} + ¦ ¦ ¦ °--')': ) [0/0] {187} + ¦ ¦ °--'}': } [1/0] {188} + ¦ °--')': ) [1/0] {189} + °--expr: [2/0] {190} + ¦--expr: [0/0] {192} + ¦ °--SYMBOL_FUNCTION_CALL: test [0/0] {191} + ¦--'(': ( [0/2] {193} + ¦--expr: [1/0] {195} + ¦ °--STR_CONST: "x" [0/0] {194} + ¦--',': , [0/2] {196} + ¦--expr: [1/0] {197} + ¦ ¦--'{': { [0/2] {198} + ¦ °--'}': } [2/0] {199} + ¦--',': , [0/2] {200} + ¦--expr: [1/0] {201} + ¦ ¦--expr: [0/1] {203} + ¦ ¦ °--SYMBOL: a [0/0] {202} + ¦ ¦--'+': + [0/1] {204} + ¦ °--expr: [0/0] {206} + ¦ °--SYMBOL: b [0/0] {205} + ¦--',': , [0/2] {207} + ¦--COMMENT: # k [0/2] {208} + ¦--expr: [1/0] {209} + ¦ ¦--'{': { [0/4] {210} + ¦ ¦--expr: [1/2] {211} + ¦ ¦ ¦--expr: [0/0] {213} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: s [0/0] {212} + ¦ ¦ ¦--'(': ( [0/0] {214} + ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {215} + ¦ ¦ ¦--EQ_SUB: = [0/1] {216} + ¦ ¦ ¦--expr: [0/0] {218} + ¦ ¦ ¦ °--SYMBOL: sd [0/0] {217} + ¦ ¦ °--')': ) [0/0] {219} + ¦ °--'}': } [1/0] {220} + °--')': ) [1/0] {221} diff --git a/tests/testthat/line_breaks_and_other/braces-fun-calls2-out.R b/tests/testthat/line_breaks_and_other/braces-fun-calls2-out.R new file mode 100644 index 000000000..36ca6e8ad --- /dev/null +++ b/tests/testthat/line_breaks_and_other/braces-fun-calls2-out.R @@ -0,0 +1,78 @@ +test( + "x", + { + + }, + a + b, + { + s(x = sd) + } +) + +test( + "x", + { + + }, + a + b, + { + s(x = sd) + } +) + +test( + "x", + { + + }, + a + b, + { + s(x = sd) + } +) + + +test( + "x", + { + + }, + a + b, + { + s(x = sd) + } +) + +test( + "x", + { + + }, # h + a + b, + { + s(x = sd) + } +) + +test( + "x", + { + + }, # h + a + b, + # k + { + s(x = sd) + } +) + +test( + "x", + { + + }, + a + b, # k + { + s(x = sd) + } +) From 05441b686f69b7c75e74841721e841e869491d47 Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Sun, 22 Sep 2019 18:50:51 +0200 Subject: [PATCH 6/8] all arguments following a braced expression also must go on a new line. --- R/rules-line-break.R | 54 ++++++++++-- man/set_line_break_before_curly_opening.Rd | 37 ++++++++ tests/testthat/curly-curly/mixed-out.R | 3 +- .../braces-fun-calls1-out.R | 6 +- .../braces-fun-calls2-in.R | 7 ++ .../braces-fun-calls2-in_tree | 86 ++++++++++++------- .../braces-fun-calls2-out.R | 8 ++ 7 files changed, 156 insertions(+), 45 deletions(-) create mode 100644 man/set_line_break_before_curly_opening.Rd diff --git a/R/rules-line-break.R b/R/rules-line-break.R index 1644a0de6..f95cc8ecf 100644 --- a/R/rules-line-break.R +++ b/R/rules-line-break.R @@ -1,17 +1,48 @@ #' Set line break before a curly brace #' -#' Rule: Function arguments that consist of a braced expression always need to -#' start on a new line, unless it's the last argument and all other arguments -#' fit on the line of the function call or they are named. +#' Rule: +#' * Principle: Function arguments that consist of a braced expression always +#' need to start on a new line +#' * Exception: [...] unless it's the last argument and all other +#' arguments fit on the line of the function call +#' * Exception: [...] or they are named. +#' * Extension: Also, expressions following on braced expressions also cause a +#' line trigger. #' @keywords internal #' @examples #' \dontrun{ +#' tryCatch( +#' { +#' f(8) +#' }, +#' error = function(e) NULL +#' ) +#' # last-argument case #' testthat("braces braces are cool", { #' code(to = execute) #' }) +#' call2( +#' x = 2, +#' { +#' code(to = execute) +#' }, +#' c = { # this is the named case +#' g(x = 7) +#' } +#' ) +#' tryGugus( +#' { +#' g5(k = na) +#' }, +#' a + b # line break also here because +#' # proceded by brace expression +#' ) #' } set_line_break_before_curly_opening <- function(pd) { - line_break_to_set_idx <- which((pd$token_after == "'{'") & (pd$token != "COMMENT")) + line_break_to_set_idx <- which( + (pd$token_after == "'{'") & (pd$token != "COMMENT") + ) + line_break_to_set_idx <- setdiff(line_break_to_set_idx, nrow(pd)) if (length(line_break_to_set_idx) > 0) { is_not_curly_curly <- map_chr( @@ -36,10 +67,17 @@ set_line_break_before_curly_opening <- function(pd) { pd$lag_newlines[1 + should_not_be_on_same_line_idx] <- 1L # non-curly expressions after curly expressions must have line breaks - exprs_idx <- which(pd$token == "expr") - exprs_after_last_expr_with_line_break_idx <- - exprs_idx[exprs_idx > should_not_be_on_same_line_idx[1] + 1L] - pd$lag_newlines[exprs_after_last_expr_with_line_break_idx] <- 1L + if (length(should_not_be_on_same_line_idx) > 0) { + comma_exprs_idx <- which(pd$token == "','") + comma_exprs_idx <- setdiff(comma_exprs_idx, 1 + is_not_curly_curly_idx) + non_comment_after_comma <- map_int(comma_exprs_idx, + next_non_comment, + pd = pd + ) + non_comment_after_expr <- + non_comment_after_comma[non_comment_after_comma > should_not_be_on_same_line_idx[1]] + pd$lag_newlines[non_comment_after_comma] <- 1L + } } pd } diff --git a/man/set_line_break_before_curly_opening.Rd b/man/set_line_break_before_curly_opening.Rd new file mode 100644 index 000000000..6c26551bc --- /dev/null +++ b/man/set_line_break_before_curly_opening.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rules-line-break.R +\name{set_line_break_before_curly_opening} +\alias{set_line_break_before_curly_opening} +\title{Set line break before a curly brace} +\usage{ +set_line_break_before_curly_opening(pd) +} +\description{ +Rule: Function arguments that consist of a braced expression always need to +start on a new line, unless it's the last argument and all other arguments +fit on the line of the function call or they are named. Also, expressions +following on braced expressions also cause a line trigger. +} +\examples{ +\dontrun{ +testthat("braces braces are cool", { + code(to = execute) +}) +call2(x = 2, + { + code(to = execute) + }, + c = { # this is the named case + g(x = 7) + } +) +tryGugus( + { + g5(k = na) + }, + a + b # line break also here because + # proceded by brace expression +) +} +} +\keyword{internal} diff --git a/tests/testthat/curly-curly/mixed-out.R b/tests/testthat/curly-curly/mixed-out.R index 8e035f75c..c9c236b18 100644 --- a/tests/testthat/curly-curly/mixed-out.R +++ b/tests/testthat/curly-curly/mixed-out.R @@ -80,7 +80,8 @@ call("test", { call( { 1 - }, a + b, + }, + a + b, { 33 / f(c) } diff --git a/tests/testthat/line_breaks_and_other/braces-fun-calls1-out.R b/tests/testthat/line_breaks_and_other/braces-fun-calls1-out.R index 1f541ca58..df9b2137d 100644 --- a/tests/testthat/line_breaks_and_other/braces-fun-calls1-out.R +++ b/tests/testthat/line_breaks_and_other/braces-fun-calls1-out.R @@ -14,16 +14,14 @@ tryCatch( { exp(x) }, - error = - function(x) x + error = function(x) x ) tryCatch( { exp(x) }, - error = - function(x) x + error = function(x) x ) call( diff --git a/tests/testthat/line_breaks_and_other/braces-fun-calls2-in.R b/tests/testthat/line_breaks_and_other/braces-fun-calls2-in.R index ccf82d119..64741bb93 100644 --- a/tests/testthat/line_breaks_and_other/braces-fun-calls2-in.R +++ b/tests/testthat/line_breaks_and_other/braces-fun-calls2-in.R @@ -69,3 +69,10 @@ test( s(x = sd) } ) + +tetst( + "x", + { + x + }, 1 + +1 +) diff --git a/tests/testthat/line_breaks_and_other/braces-fun-calls2-in_tree b/tests/testthat/line_breaks_and_other/braces-fun-calls2-in_tree index 4a2d6f6fc..4923c8f79 100644 --- a/tests/testthat/line_breaks_and_other/braces-fun-calls2-in_tree +++ b/tests/testthat/line_breaks_and_other/braces-fun-calls2-in_tree @@ -188,35 +188,57 @@ ROOT (token: short_text [lag_newlines/spaces] {pos_id}) ¦ ¦ ¦ °--')': ) [0/0] {187} ¦ ¦ °--'}': } [1/0] {188} ¦ °--')': ) [1/0] {189} - °--expr: [2/0] {190} - ¦--expr: [0/0] {192} - ¦ °--SYMBOL_FUNCTION_CALL: test [0/0] {191} - ¦--'(': ( [0/2] {193} - ¦--expr: [1/0] {195} - ¦ °--STR_CONST: "x" [0/0] {194} - ¦--',': , [0/2] {196} - ¦--expr: [1/0] {197} - ¦ ¦--'{': { [0/2] {198} - ¦ °--'}': } [2/0] {199} - ¦--',': , [0/2] {200} - ¦--expr: [1/0] {201} - ¦ ¦--expr: [0/1] {203} - ¦ ¦ °--SYMBOL: a [0/0] {202} - ¦ ¦--'+': + [0/1] {204} - ¦ °--expr: [0/0] {206} - ¦ °--SYMBOL: b [0/0] {205} - ¦--',': , [0/2] {207} - ¦--COMMENT: # k [0/2] {208} - ¦--expr: [1/0] {209} - ¦ ¦--'{': { [0/4] {210} - ¦ ¦--expr: [1/2] {211} - ¦ ¦ ¦--expr: [0/0] {213} - ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: s [0/0] {212} - ¦ ¦ ¦--'(': ( [0/0] {214} - ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {215} - ¦ ¦ ¦--EQ_SUB: = [0/1] {216} - ¦ ¦ ¦--expr: [0/0] {218} - ¦ ¦ ¦ °--SYMBOL: sd [0/0] {217} - ¦ ¦ °--')': ) [0/0] {219} - ¦ °--'}': } [1/0] {220} - °--')': ) [1/0] {221} + ¦--expr: [2/0] {190} + ¦ ¦--expr: [0/0] {192} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: test [0/0] {191} + ¦ ¦--'(': ( [0/2] {193} + ¦ ¦--expr: [1/0] {195} + ¦ ¦ °--STR_CONST: "x" [0/0] {194} + ¦ ¦--',': , [0/2] {196} + ¦ ¦--expr: [1/0] {197} + ¦ ¦ ¦--'{': { [0/2] {198} + ¦ ¦ °--'}': } [2/0] {199} + ¦ ¦--',': , [0/2] {200} + ¦ ¦--expr: [1/0] {201} + ¦ ¦ ¦--expr: [0/1] {203} + ¦ ¦ ¦ °--SYMBOL: a [0/0] {202} + ¦ ¦ ¦--'+': + [0/1] {204} + ¦ ¦ °--expr: [0/0] {206} + ¦ ¦ °--SYMBOL: b [0/0] {205} + ¦ ¦--',': , [0/2] {207} + ¦ ¦--COMMENT: # k [0/2] {208} + ¦ ¦--expr: [1/0] {209} + ¦ ¦ ¦--'{': { [0/4] {210} + ¦ ¦ ¦--expr: [1/2] {211} + ¦ ¦ ¦ ¦--expr: [0/0] {213} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: s [0/0] {212} + ¦ ¦ ¦ ¦--'(': ( [0/0] {214} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {215} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {216} + ¦ ¦ ¦ ¦--expr: [0/0] {218} + ¦ ¦ ¦ ¦ °--SYMBOL: sd [0/0] {217} + ¦ ¦ ¦ °--')': ) [0/0] {219} + ¦ ¦ °--'}': } [1/0] {220} + ¦ °--')': ) [1/0] {221} + °--expr: [2/0] {222} + ¦--expr: [0/0] {224} + ¦ °--SYMBOL_FUNCTION_CALL: tetst [0/0] {223} + ¦--'(': ( [0/2] {225} + ¦--expr: [1/0] {227} + ¦ °--STR_CONST: "x" [0/0] {226} + ¦--',': , [0/2] {228} + ¦--expr: [1/0] {229} + ¦ ¦--'{': { [0/4] {230} + ¦ ¦--expr: [1/2] {232} + ¦ ¦ °--SYMBOL: x [0/0] {231} + ¦ °--'}': } [1/0] {233} + ¦--',': , [0/1] {234} + ¦--expr: [0/0] {235} + ¦ ¦--expr: [0/1] {237} + ¦ ¦ °--NUM_CONST: 1 [0/0] {236} + ¦ ¦--'+': + [0/1] {238} + ¦ °--expr: [0/0] {239} + ¦ ¦--'+': + [0/0] {240} + ¦ °--expr: [0/0] {242} + ¦ °--NUM_CONST: 1 [0/0] {241} + °--')': ) [1/0] {243} diff --git a/tests/testthat/line_breaks_and_other/braces-fun-calls2-out.R b/tests/testthat/line_breaks_and_other/braces-fun-calls2-out.R index 36ca6e8ad..527a0d7c2 100644 --- a/tests/testthat/line_breaks_and_other/braces-fun-calls2-out.R +++ b/tests/testthat/line_breaks_and_other/braces-fun-calls2-out.R @@ -76,3 +76,11 @@ test( s(x = sd) } ) + +tetst( + "x", + { + x + }, + 1 + +1 +) From 0e076d26242cfbe149b17cabf9464d52324279cb Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Sun, 22 Sep 2019 19:15:57 +0200 Subject: [PATCH 7/8] document --- man/invalid_utf8.Rd | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 man/invalid_utf8.Rd diff --git a/man/invalid_utf8.Rd b/man/invalid_utf8.Rd new file mode 100644 index 000000000..9b1b64e75 --- /dev/null +++ b/man/invalid_utf8.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/io.R +\name{invalid_utf8} +\alias{invalid_utf8} +\title{Drop-in replacement for \code{\link[xfun:::invalid_utf8]{xfun::::invalid_utf8()}}} +\usage{ +invalid_utf8(x) +} +\description{ +Drop-in replacement for \code{\link[xfun:::invalid_utf8]{xfun::::invalid_utf8()}} +} +\keyword{internal} From 1c997063c16dcf0311993c4d2ecc90814ab2f3e0 Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Sun, 22 Sep 2019 19:23:16 +0200 Subject: [PATCH 8/8] adapt to namechange of remove_line_break_before_curly_opening(). --- vignettes/customizing_styler.Rmd | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/vignettes/customizing_styler.Rmd b/vignettes/customizing_styler.Rmd index 401e32fcc..09253550f 100644 --- a/vignettes/customizing_styler.Rmd +++ b/vignettes/customizing_styler.Rmd @@ -308,10 +308,11 @@ a <- function() # comments should remain EOL { The easiest way of taking care of that is not applying the rule if there is a comment before the token of interest, which can be checked for within your transformer function. The transformer function from the tidyverse style that -removes line breaks before the curly opening bracket looks as follows: +removes line breaks before the round closing bracket that comes after a curly +brace looks as follows: ```{r} -styler:::remove_line_break_before_curly_opening +styler:::remove_line_break_before_round_closing_after_curly ``` With our example function `set_line_break_before_curly_opening()` we don't need