diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index baead9def..6aaed02c2 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -1,23 +1,20 @@ # All available hooks: https://pre-commit.com/hooks.html +# R specific hooks: https://github.com/lorenzwalthert/precommit repos: - repo: https://github.com/lorenzwalthert/precommit - rev: v0.0.0.9027 + rev: v0.0.0.9038 hooks: - # - id: lintr - # - id: style-files Does style *-in.R files in tests otherwise! - id: parsable-R - id: no-browser-statement + # - id: lintr - id: readme-rmd-rendered - # R package development - - id: roxygenize - - id: use-tidy-description - - id: deps-in-desc + - id: spell-check + - id: style-files + args: [--style_pkg=styler, --style_fun=tidyverse_style] - repo: https://github.com/pre-commit/pre-commit-hooks - rev: v2.4.0 + rev: v2.5.0 hooks: - id: check-added-large-files args: ['--maxkb=200'] -- repo: https://github.com/lorenzwalthert/precommit-markdown-link-check - rev: v0.0.0.9002 # Use the sha / tag you want to point at - hooks: - - id: markdown-link-check + - id: end-of-file-fixer + exclude: '\.Rd' diff --git a/NEWS.md b/NEWS.md index 26157a478..c2cf32980 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ ## Major changes +- blank lines in function calls and headers are now removed (#629, #630). ## Minor chnages and fixes @@ -10,7 +11,6 @@ - typos in documentation (#618, #614). - # styler 1.3.2 Release upon request by the CRAN team. @@ -435,4 +435,3 @@ specify_reindention( ) initialize_default_attributes(pd_flat) ``` - diff --git a/R/rules-line-break.R b/R/rules-line-break.R index db1432791..e7e789fa2 100644 --- a/R/rules-line-break.R +++ b/R/rules-line-break.R @@ -90,12 +90,13 @@ set_line_break_before_curly_opening <- function(pd) { } -set_line_break_around_comma <- function(pd) { +set_line_break_around_comma <- function(pd, strict) { comma_with_line_break_that_can_be_removed_before <- (pd$token == "','") & (pd$lag_newlines > 0) & (pd$token_before != "COMMENT") & (lag(pd$token) != "'['") + pd$lag_newlines[comma_with_line_break_that_can_be_removed_before] <- 0L pd$lag_newlines[lag(comma_with_line_break_that_can_be_removed_before)] <- 1L pd @@ -169,9 +170,10 @@ remove_line_break_before_round_closing_after_curly <- function(pd) { pd } -remove_line_break_before_round_closing_fun_dec <- function(pd) { +remove_line_breaks_in_fun_dec <- function(pd) { if (is_function_dec(pd)) { round_after <- pd$token == "')'" & pd$token_before != "COMMENT" + pd$lag_newlines[pd$lag_newlines > 1L] <- 1L pd$lag_newlines[round_after] <- 0L } pd @@ -267,9 +269,17 @@ set_line_break_before_closing_call <- function(pd, except_token_before) { #' @rdname set_line_break_if_call_is_multi_line #' @keywords internal -remove_line_break_in_empty_fun_call <- function(pd) { - if (is_function_call(pd) && nrow(pd) == 3) { - pd$lag_newlines[3] <- 0L +remove_line_break_in_fun_call <- function(pd, strict) { + if (is_function_call(pd)) { + # no blank lines within function calls + if (strict) { + pd$lag_newlines[lag(pd$token == "','") & pd$lag_newlines > 1] <- 1L + + pd$lag_newlines[lag(pd$token == "COMMENT") & pd$lag_newlines > 0] <- 1L + } + if (nrow(pd) == 3) { + pd$lag_newlines[3] <- 0L + } } pd } diff --git a/R/style-guides.R b/R/style-guides.R index 79d55950d..8ccf03e5f 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -117,8 +117,8 @@ tidyverse_style <- function(scope = "tokens", 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 = - if (strict) remove_line_break_before_round_closing_fun_dec, + remove_line_breaks_in_fun_dec = + if (strict) remove_line_breaks_in_fun_dec, style_line_break_around_curly = partial( style_line_break_around_curly, strict @@ -139,7 +139,7 @@ tidyverse_style <- function(scope = "tokens", except_token_before = "COMMENT" ) }, - remove_line_break_in_empty_fun_call, + purrr::partial(remove_line_break_in_fun_call, strict = strict), add_line_break_after_pipe = if (strict) add_line_break_after_pipe, set_linebreak_after_ggplot2_plus = if (strict) set_linebreak_after_ggplot2_plus ) diff --git a/inst/WORDLIST b/inst/WORDLIST index 1b5cc9176..26e867484 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,76 +1,3 @@ -yihui -xfun -Visit'em -unnest -unlinkunindention -unindent -unindent -unexplainable -uncached -Tidyverse -tidyverse -tidyeval -tibbles -tibble -testthat -stylerignore -stylerignored -StackOverflow -Rprofile -rprofile -rplumber -Roxygen -roxygen -Rnw -rnw -Rmd -rmd -RMarkdown -rlang -reprex -reindention -reindented -rebased -README -readme -rds -precommit -pre -pos -pkgdown -parsable -NUM -macOS -lorenzwalthert -lifecycle -LF -levelName -knitr -ixmypi -invasiveness -innode -infinitively -https -forcond -filetype -expr EQ -EOLs -EOL -EOF -emacs -DSLs -dontshowdontrun -donttest -dont -dir -dec -cran -CONST -config -codecov -CMD -cancelling - Addin Addins AppVeyor @@ -78,3 +5,80 @@ apriori arg AST benchmarking +cancelling +chnages +CMD +codecov +config +CONST +cran +dec +dir +dont +dontshowdontrun +donttest +DSLs +emacs +EOF +EOL +EOLs +expr +expr EQ +filetype +forcond +funct +https +infinitively +innode +invasiveness +ixmypi +knitr +levelName +LF +lifecycle +lorenzwalthert +macOS +NUM +parsable +pgkdown +pkgdown +pos +pre +precommit +rds +readme +README +rebased +reindented +reindention +reprex +rlang +RMarkdown +rmd +Rmd +rnw +Rnw +roxygen +Roxygen +rplumber +rprofile +Rprofile +StackOverflow +styler +stylerignore +stylerignored +stylers +testthat +tibble +tibbles +tidyeval +tidyverse +Tidyverse +uncached +unexplainable +unindent +unlinkunindention +unnest +Visit'em +xfun +yihui diff --git a/man/set_line_break_if_call_is_multi_line.Rd b/man/set_line_break_if_call_is_multi_line.Rd index 7be17b1f9..a599c9938 100644 --- a/man/set_line_break_if_call_is_multi_line.Rd +++ b/man/set_line_break_if_call_is_multi_line.Rd @@ -4,7 +4,7 @@ \alias{set_line_break_if_call_is_multi_line} \alias{set_line_break_after_opening_if_call_is_multi_line} \alias{set_line_break_before_closing_call} -\alias{remove_line_break_in_empty_fun_call} +\alias{remove_line_break_in_fun_call} \title{Set line break for multi-line function calls} \usage{ set_line_break_after_opening_if_call_is_multi_line( @@ -15,7 +15,7 @@ set_line_break_after_opening_if_call_is_multi_line( set_line_break_before_closing_call(pd, except_token_before) -remove_line_break_in_empty_fun_call(pd) +remove_line_break_in_fun_call(pd, strict) } \arguments{ \item{pd}{A parse table.} diff --git a/tests/testthat/alignment/named-out.R b/tests/testthat/alignment/named-out.R index 53b1da23d..4985a203e 100644 --- a/tests/testthat/alignment/named-out.R +++ b/tests/testthat/alignment/named-out.R @@ -63,7 +63,6 @@ call( # algorithm: aligned. human: aligned. call( x = 1, n = 33, z = "333", - xy = 2, ) diff --git a/tests/testthat/fun_dec/line_break_fun_dec-in.R b/tests/testthat/fun_dec/line_break_fun_dec-in.R index ea100a0cb..a72d9d215 100644 --- a/tests/testthat/fun_dec/line_break_fun_dec-in.R +++ b/tests/testthat/fun_dec/line_break_fun_dec-in.R @@ -1,6 +1,5 @@ a <- function(x, # - y - ) { + y) { x - 1 } @@ -13,6 +12,24 @@ a <- function(x, # a <- function(x, # y # - ) { +) { y } + + +a <- function(x, + y) { + x - 1 +} + +a <- function(x, + # + y) { + x - 1 +} + +a <- function(x, + + y) { + x - 1 +} diff --git a/tests/testthat/fun_dec/line_break_fun_dec-in_tree b/tests/testthat/fun_dec/line_break_fun_dec-in_tree index 8fb8259be..764ae7b1c 100644 --- a/tests/testthat/fun_dec/line_break_fun_dec-in_tree +++ b/tests/testthat/fun_dec/line_break_fun_dec-in_tree @@ -40,22 +40,86 @@ ROOT (token: short_text [lag_newlines/spaces] {pos_id}) ¦ ¦--expr: x [1/0] {38} ¦ ¦ °--SYMBOL: x [0/0] {37} ¦ °--'}': } [1/0] {39} - °--expr: a <- [2/0] {40} - ¦--expr: a [0/1] {42} - ¦ °--SYMBOL: a [0/0] {41} - ¦--LEFT_ASSIGN: <- [0/1] {43} - °--expr: funct [0/0] {44} - ¦--FUNCTION: funct [0/0] {45} - ¦--'(': ( [0/0] {46} - ¦--SYMBOL_FORMALS: x [0/0] {47} - ¦--',': , [0/1] {48} - ¦--COMMENT: # [0/14] {49} - ¦--SYMBOL_FORMALS: y [1/1] {50} - ¦--COMMENT: # [0/12] {51} - ¦--')': ) [1/1] {52} - °--expr: { + ¦--expr: a <- [2/0] {40} + ¦ ¦--expr: a [0/1] {42} + ¦ ¦ °--SYMBOL: a [0/0] {41} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {43} + ¦ °--expr: funct [0/0] {44} + ¦ ¦--FUNCTION: funct [0/0] {45} + ¦ ¦--'(': ( [0/0] {46} + ¦ ¦--SYMBOL_FORMALS: x [0/0] {47} + ¦ ¦--',': , [0/1] {48} + ¦ ¦--COMMENT: # [0/14] {49} + ¦ ¦--SYMBOL_FORMALS: y [1/1] {50} + ¦ ¦--COMMENT: # [0/12] {51} + ¦ ¦--')': ) [1/1] {52} + ¦ °--expr: { y [0/0] {53} - ¦--'{': { [0/2] {54} - ¦--expr: y [1/0] {56} - ¦ °--SYMBOL: y [0/0] {55} - °--'}': } [1/0] {57} + ¦ ¦--'{': { [0/2] {54} + ¦ ¦--expr: y [1/0] {56} + ¦ ¦ °--SYMBOL: y [0/0] {55} + ¦ °--'}': } [1/0] {57} + ¦--expr: a <- [3/0] {58} + ¦ ¦--expr: a [0/1] {60} + ¦ ¦ °--SYMBOL: a [0/0] {59} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {61} + ¦ °--expr: funct [0/0] {62} + ¦ ¦--FUNCTION: funct [0/0] {63} + ¦ ¦--'(': ( [0/0] {64} + ¦ ¦--SYMBOL_FORMALS: x [0/0] {65} + ¦ ¦--',': , [0/14] {66} + ¦ ¦--SYMBOL_FORMALS: y [1/0] {67} + ¦ ¦--')': ) [1/1] {68} + ¦ °--expr: { + x [0/0] {69} + ¦ ¦--'{': { [0/2] {70} + ¦ ¦--expr: x - 1 [1/0] {71} + ¦ ¦ ¦--expr: x [0/1] {73} + ¦ ¦ ¦ °--SYMBOL: x [0/0] {72} + ¦ ¦ ¦--'-': - [0/1] {74} + ¦ ¦ °--expr: 1 [0/0] {76} + ¦ ¦ °--NUM_CONST: 1 [0/0] {75} + ¦ °--'}': } [1/0] {77} + ¦--expr: a <- [2/0] {78} + ¦ ¦--expr: a [0/1] {80} + ¦ ¦ °--SYMBOL: a [0/0] {79} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {81} + ¦ °--expr: funct [0/0] {82} + ¦ ¦--FUNCTION: funct [0/0] {83} + ¦ ¦--'(': ( [0/0] {84} + ¦ ¦--SYMBOL_FORMALS: x [0/0] {85} + ¦ ¦--',': , [0/14] {86} + ¦ ¦--COMMENT: # [1/14] {87} + ¦ ¦--SYMBOL_FORMALS: y [1/0] {88} + ¦ ¦--')': ) [1/1] {89} + ¦ °--expr: { + x [0/0] {90} + ¦ ¦--'{': { [0/2] {91} + ¦ ¦--expr: x - 1 [1/0] {92} + ¦ ¦ ¦--expr: x [0/1] {94} + ¦ ¦ ¦ °--SYMBOL: x [0/0] {93} + ¦ ¦ ¦--'-': - [0/1] {95} + ¦ ¦ °--expr: 1 [0/0] {97} + ¦ ¦ °--NUM_CONST: 1 [0/0] {96} + ¦ °--'}': } [1/0] {98} + °--expr: a <- [2/0] {99} + ¦--expr: a [0/1] {101} + ¦ °--SYMBOL: a [0/0] {100} + ¦--LEFT_ASSIGN: <- [0/1] {102} + °--expr: funct [0/0] {103} + ¦--FUNCTION: funct [0/0] {104} + ¦--'(': ( [0/0] {105} + ¦--SYMBOL_FORMALS: x [0/0] {106} + ¦--',': , [0/14] {107} + ¦--SYMBOL_FORMALS: y [2/0] {108} + ¦--')': ) [1/1] {109} + °--expr: { + x [0/0] {110} + ¦--'{': { [0/2] {111} + ¦--expr: x - 1 [1/0] {112} + ¦ ¦--expr: x [0/1] {114} + ¦ ¦ °--SYMBOL: x [0/0] {113} + ¦ ¦--'-': - [0/1] {115} + ¦ °--expr: 1 [0/0] {117} + ¦ °--NUM_CONST: 1 [0/0] {116} + °--'}': } [1/0] {118} 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 6d7d0910e..42f87027c 100644 --- a/tests/testthat/fun_dec/line_break_fun_dec-out.R +++ b/tests/testthat/fun_dec/line_break_fun_dec-out.R @@ -15,3 +15,20 @@ a <- function(x, # ) { y } + + +a <- function(x, + y) { + x - 1 +} + +a <- function(x, + # + y) { + x - 1 +} + +a <- function(x, + y) { + x - 1 +} diff --git a/tests/testthat/line_breaks_fun_call/blank-non-strict-in.R b/tests/testthat/line_breaks_fun_call/blank-non-strict-in.R new file mode 100644 index 000000000..21225f5f8 --- /dev/null +++ b/tests/testthat/line_breaks_fun_call/blank-non-strict-in.R @@ -0,0 +1,18 @@ +call( + + + 1 +) + +call( + # comment + + 1 +) + +call( + x = 2, + 1, + + "w" +) diff --git a/tests/testthat/line_breaks_fun_call/blank-non-strict-in_tree b/tests/testthat/line_breaks_fun_call/blank-non-strict-in_tree new file mode 100644 index 000000000..9632f334c --- /dev/null +++ b/tests/testthat/line_breaks_fun_call/blank-non-strict-in_tree @@ -0,0 +1,31 @@ +ROOT (token: short_text [lag_newlines/spaces] {pos_id}) + ¦--expr: call( [0/0] {1} + ¦ ¦--expr: call [0/0] {3} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {2} + ¦ ¦--'(': ( [0/2] {4} + ¦ ¦--expr: 1 [3/0] {6} + ¦ ¦ °--NUM_CONST: 1 [0/0] {5} + ¦ °--')': ) [1/0] {7} + ¦--expr: call( [2/0] {8} + ¦ ¦--expr: call [0/0] {10} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {9} + ¦ ¦--'(': ( [0/2] {11} + ¦ ¦--COMMENT: # com [1/2] {12} + ¦ ¦--expr: 1 [2/0] {14} + ¦ ¦ °--NUM_CONST: 1 [0/0] {13} + ¦ °--')': ) [1/0] {15} + °--expr: call( [2/0] {16} + ¦--expr: call [0/0] {18} + ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {17} + ¦--'(': ( [0/2] {19} + ¦--SYMBOL_SUB: x [1/1] {20} + ¦--EQ_SUB: = [0/1] {21} + ¦--expr: 2 [0/0] {23} + ¦ °--NUM_CONST: 2 [0/0] {22} + ¦--',': , [0/2] {24} + ¦--expr: 1 [1/0] {26} + ¦ °--NUM_CONST: 1 [0/0] {25} + ¦--',': , [0/2] {27} + ¦--expr: "w" [2/0] {29} + ¦ °--STR_CONST: "w" [0/0] {28} + °--')': ) [1/0] {30} diff --git a/tests/testthat/line_breaks_fun_call/blank-non-strict-out.R b/tests/testthat/line_breaks_fun_call/blank-non-strict-out.R new file mode 100644 index 000000000..21225f5f8 --- /dev/null +++ b/tests/testthat/line_breaks_fun_call/blank-non-strict-out.R @@ -0,0 +1,18 @@ +call( + + + 1 +) + +call( + # comment + + 1 +) + +call( + x = 2, + 1, + + "w" +) diff --git a/tests/testthat/line_breaks_fun_call/blank-strict-in.R b/tests/testthat/line_breaks_fun_call/blank-strict-in.R new file mode 100644 index 000000000..21225f5f8 --- /dev/null +++ b/tests/testthat/line_breaks_fun_call/blank-strict-in.R @@ -0,0 +1,18 @@ +call( + + + 1 +) + +call( + # comment + + 1 +) + +call( + x = 2, + 1, + + "w" +) diff --git a/tests/testthat/line_breaks_fun_call/blank-strict-in_tree b/tests/testthat/line_breaks_fun_call/blank-strict-in_tree new file mode 100644 index 000000000..9632f334c --- /dev/null +++ b/tests/testthat/line_breaks_fun_call/blank-strict-in_tree @@ -0,0 +1,31 @@ +ROOT (token: short_text [lag_newlines/spaces] {pos_id}) + ¦--expr: call( [0/0] {1} + ¦ ¦--expr: call [0/0] {3} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {2} + ¦ ¦--'(': ( [0/2] {4} + ¦ ¦--expr: 1 [3/0] {6} + ¦ ¦ °--NUM_CONST: 1 [0/0] {5} + ¦ °--')': ) [1/0] {7} + ¦--expr: call( [2/0] {8} + ¦ ¦--expr: call [0/0] {10} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {9} + ¦ ¦--'(': ( [0/2] {11} + ¦ ¦--COMMENT: # com [1/2] {12} + ¦ ¦--expr: 1 [2/0] {14} + ¦ ¦ °--NUM_CONST: 1 [0/0] {13} + ¦ °--')': ) [1/0] {15} + °--expr: call( [2/0] {16} + ¦--expr: call [0/0] {18} + ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {17} + ¦--'(': ( [0/2] {19} + ¦--SYMBOL_SUB: x [1/1] {20} + ¦--EQ_SUB: = [0/1] {21} + ¦--expr: 2 [0/0] {23} + ¦ °--NUM_CONST: 2 [0/0] {22} + ¦--',': , [0/2] {24} + ¦--expr: 1 [1/0] {26} + ¦ °--NUM_CONST: 1 [0/0] {25} + ¦--',': , [0/2] {27} + ¦--expr: "w" [2/0] {29} + ¦ °--STR_CONST: "w" [0/0] {28} + °--')': ) [1/0] {30} diff --git a/tests/testthat/line_breaks_fun_call/blank-strict-out.R b/tests/testthat/line_breaks_fun_call/blank-strict-out.R new file mode 100644 index 000000000..bffb39422 --- /dev/null +++ b/tests/testthat/line_breaks_fun_call/blank-strict-out.R @@ -0,0 +1,14 @@ +call( + 1 +) + +call( + # comment + 1 +) + +call( + x = 2, + 1, + "w" +) diff --git a/tests/testthat/test-line_breaks_fun_call.R b/tests/testthat/test-line_breaks_fun_call.R index 674b2a3a8..826c254e6 100644 --- a/tests/testthat/test-line_breaks_fun_call.R +++ b/tests/testthat/test-line_breaks_fun_call.R @@ -11,6 +11,19 @@ test_that("line breaks work in general", { ), NA) }) +test_that("blank lines in function calls are removed for strict = TRUE", { + expect_warning(test_collection("line_breaks_fun_call", + "blank-strict", + transformer = style_text + ), NA) + + expect_warning(test_collection("line_breaks_fun_call", + "blank-non-strict", + transformer = style_text, strict = FALSE + ), NA) +}) + + test_that("line breaks are not applied with non-strict", { expect_warning(test_collection("line_breaks_fun_call", "token_dependent_complex_non_strict",