diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 4f34c10b7..0ad306e94 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -1,12 +1,12 @@ # All available hooks: https://pre-commit.com/hooks.html # R specific hooks: https://github.com/lorenzwalthert/precommit -default_stages: [commit] +default_stages: [pre-commit] default_language_version: python: python3 repos: - repo: https://github.com/lorenzwalthert/precommit - rev: v0.4.2 + rev: v0.4.3.9003 hooks: - id: style-files args: diff --git a/R/rules-line-breaks.R b/R/rules-line-breaks.R index 07229ebc9..5a007bdff 100644 --- a/R/rules-line-breaks.R +++ b/R/rules-line-breaks.R @@ -447,3 +447,9 @@ remove_empty_lines_after_opening_and_before_closing_braces <- function(pd) { pd } + + +set_line_breaks_between_top_level_exprs <- function(pd, allowed_blank_lines = 2L) { + pd$lag_newlines <- pmin(pd$lag_newlines, allowed_blank_lines + 1L) + pd +} diff --git a/R/style-guides.R b/R/style-guides.R index 39fc30118..93ea89dd2 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -139,6 +139,8 @@ tidyverse_style <- function(scope = "tokens", if (strict) remove_line_break_before_round_closing_after_curly, remove_line_breaks_in_fun_dec = if (strict) remove_line_breaks_in_fun_dec, + set_line_breaks_between_top_level_exprs = + if (strict) set_line_breaks_between_top_level_exprs, style_line_break_around_curly = partial( style_line_break_around_curly, strict diff --git a/tests/testthat/alignment/named-out.R b/tests/testthat/alignment/named-out.R index 5fd8e9507..35c3bb607 100644 --- a/tests/testthat/alignment/named-out.R +++ b/tests/testthat/alignment/named-out.R @@ -102,7 +102,6 @@ call( ) - # if all col1 arguments are named, col1 must also be aligned # not aligned fell( diff --git a/tests/testthat/indention_curly_brackets/custom-out.R b/tests/testthat/indention_curly_brackets/custom-out.R index f2612d575..f68775003 100644 --- a/tests/testthat/indention_curly_brackets/custom-out.R +++ b/tests/testthat/indention_curly_brackets/custom-out.R @@ -4,7 +4,6 @@ if (value > 0) { } - if (value > 0) { print(value) } diff --git a/tests/testthat/line_breaks_and_other/assignment-out.R b/tests/testthat/line_breaks_and_other/assignment-out.R index 239bb02aa..5c16559ed 100644 --- a/tests/testthat/line_breaks_and_other/assignment-out.R +++ b/tests/testthat/line_breaks_and_other/assignment-out.R @@ -22,7 +22,6 @@ x <- 3 - ImportantDataFrame$ImportantColumn1 <- ImportantDataFrame$ImportantColumn2 <- ComplicatedFunction(ImportantDataFrame$InputColumn) @@ -32,6 +31,5 @@ ImportantDataFrame$ImportantColumn1 <- ImportantDataFrame$ImportantColumn2 <- ComplicatedFunction(ImportantDataFrame$InputColumn) - ImportantDataFrame$ImportantColumn1 <- ImportantDataFrame$ImportantColumn2 <- ComplicatedFunction(ImportantDataFrame$InputColumn) diff --git a/tests/testthat/line_breaks_and_other/ggplot2-in.R b/tests/testthat/line_breaks_and_other/ggplot2-in.R index c767dca7a..c9c224cec 100644 --- a/tests/testthat/line_breaks_and_other/ggplot2-in.R +++ b/tests/testthat/line_breaks_and_other/ggplot2-in.R @@ -26,6 +26,7 @@ ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + ggplot2::geom_point() + g() # comment + # add when comment ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + ggplot2::geom_point() + g() + geom_oint() # comment diff --git a/tests/testthat/line_breaks_fun_call/blank-strict-out.R b/tests/testthat/line_breaks_fun_call/blank-strict-out.R index cb9acea09..19232c9fa 100644 --- a/tests/testthat/line_breaks_fun_call/blank-strict-out.R +++ b/tests/testthat/line_breaks_fun_call/blank-strict-out.R @@ -19,7 +19,6 @@ call( 2, - # comment 1, diff --git a/tests/testthat/line_breaks_fun_call/switch_ifelse_etc_no_line_break-out.R b/tests/testthat/line_breaks_fun_call/switch_ifelse_etc_no_line_break-out.R index e6cfeee64..f43cd21f8 100644 --- a/tests/testthat/line_breaks_fun_call/switch_ifelse_etc_no_line_break-out.R +++ b/tests/testthat/line_breaks_fun_call/switch_ifelse_etc_no_line_break-out.R @@ -16,7 +16,6 @@ switch( # ) - switch(x, a = 2, # y = 3 diff --git a/tests/testthat/line_breaks_fun_call/token_dependent_mixed-out.R b/tests/testthat/line_breaks_fun_call/token_dependent_mixed-out.R index d588f1ff0..1bd68278f 100644 --- a/tests/testthat/line_breaks_fun_call/token_dependent_mixed-out.R +++ b/tests/testthat/line_breaks_fun_call/token_dependent_mixed-out.R @@ -16,7 +16,6 @@ call(call( )) - # no more barcket on same line -> call(call( 3, 4 diff --git a/tests/testthat/line_breaks_top_level_exprs/braces-in.R b/tests/testthat/line_breaks_top_level_exprs/braces-in.R new file mode 100644 index 000000000..d504e6413 --- /dev/null +++ b/tests/testthat/line_breaks_top_level_exprs/braces-in.R @@ -0,0 +1,16 @@ +{ + 1 + 1 +} + + + + + +### some comment + + + + +{ + NULL +} diff --git a/tests/testthat/line_breaks_top_level_exprs/braces-out.R b/tests/testthat/line_breaks_top_level_exprs/braces-out.R new file mode 100644 index 000000000..9fd7a480d --- /dev/null +++ b/tests/testthat/line_breaks_top_level_exprs/braces-out.R @@ -0,0 +1,11 @@ +{ + 1 + 1 +} + + +### some comment + + +{ + NULL +} diff --git a/tests/testthat/line_breaks_top_level_exprs/conditionals-in.R b/tests/testthat/line_breaks_top_level_exprs/conditionals-in.R new file mode 100644 index 000000000..37e07e57f --- /dev/null +++ b/tests/testthat/line_breaks_top_level_exprs/conditionals-in.R @@ -0,0 +1,20 @@ +for (i in 1:10) {} + + + + + + +# some comment + + + + + +while (TRUE) {} + + + + +# some comment +if (TRUE) NULL diff --git a/tests/testthat/line_breaks_top_level_exprs/conditionals-out.R b/tests/testthat/line_breaks_top_level_exprs/conditionals-out.R new file mode 100644 index 000000000..54104e290 --- /dev/null +++ b/tests/testthat/line_breaks_top_level_exprs/conditionals-out.R @@ -0,0 +1,11 @@ +for (i in 1:10) {} + + +# some comment + + +while (TRUE) {} + + +# some comment +if (TRUE) NULL diff --git a/tests/testthat/line_breaks_top_level_exprs/function_defs_and_calls-in.R b/tests/testthat/line_breaks_top_level_exprs/function_defs_and_calls-in.R new file mode 100644 index 000000000..4a18af903 --- /dev/null +++ b/tests/testthat/line_breaks_top_level_exprs/function_defs_and_calls-in.R @@ -0,0 +1,23 @@ +f <- function() NULL + + + + + + + + +g <- function() NULL + + + + +f() + +# comment + + + + + +g() diff --git a/tests/testthat/line_breaks_top_level_exprs/function_defs_and_calls-out.R b/tests/testthat/line_breaks_top_level_exprs/function_defs_and_calls-out.R new file mode 100644 index 000000000..741c47309 --- /dev/null +++ b/tests/testthat/line_breaks_top_level_exprs/function_defs_and_calls-out.R @@ -0,0 +1,12 @@ +f <- function() NULL + + +g <- function() NULL + + +f() + +# comment + + +g() diff --git a/tests/testthat/line_breaks_top_level_exprs/non_strict-in.R b/tests/testthat/line_breaks_top_level_exprs/non_strict-in.R new file mode 100644 index 000000000..4a18af903 --- /dev/null +++ b/tests/testthat/line_breaks_top_level_exprs/non_strict-in.R @@ -0,0 +1,23 @@ +f <- function() NULL + + + + + + + + +g <- function() NULL + + + + +f() + +# comment + + + + + +g() diff --git a/tests/testthat/line_breaks_top_level_exprs/non_strict-out.R b/tests/testthat/line_breaks_top_level_exprs/non_strict-out.R new file mode 100644 index 000000000..4a18af903 --- /dev/null +++ b/tests/testthat/line_breaks_top_level_exprs/non_strict-out.R @@ -0,0 +1,23 @@ +f <- function() NULL + + + + + + + + +g <- function() NULL + + + + +f() + +# comment + + + + + +g() diff --git a/tests/testthat/line_breaks_top_level_exprs/piped_chains-in.R b/tests/testthat/line_breaks_top_level_exprs/piped_chains-in.R new file mode 100644 index 000000000..75a3abee2 --- /dev/null +++ b/tests/testthat/line_breaks_top_level_exprs/piped_chains-in.R @@ -0,0 +1,21 @@ + + +f %>% g() + + + + + + +h %>% i() + + + + + +# some comment + + + + +j %>% k() diff --git a/tests/testthat/line_breaks_top_level_exprs/piped_chains-out.R b/tests/testthat/line_breaks_top_level_exprs/piped_chains-out.R new file mode 100644 index 000000000..b424cbba1 --- /dev/null +++ b/tests/testthat/line_breaks_top_level_exprs/piped_chains-out.R @@ -0,0 +1,10 @@ +f %>% g() + + +h %>% i() + + +# some comment + + +j %>% k() diff --git a/tests/testthat/parse_comments/with_indention-out.R b/tests/testthat/parse_comments/with_indention-out.R index 5854b9515..526802374 100644 --- a/tests/testthat/parse_comments/with_indention-out.R +++ b/tests/testthat/parse_comments/with_indention-out.R @@ -18,8 +18,6 @@ call( # new comment - - a() # I think it gets boring # new_line here diff --git a/tests/testthat/roxygen-examples-complete/13-empty-lines-out.R b/tests/testthat/roxygen-examples-complete/13-empty-lines-out.R index a2f6f567b..460600158 100644 --- a/tests/testthat/roxygen-examples-complete/13-empty-lines-out.R +++ b/tests/testthat/roxygen-examples-complete/13-empty-lines-out.R @@ -9,8 +9,6 @@ #' # two #' #' -#' -#' #' ( #' # more #' a <- 3 diff --git a/tests/testthat/roxygen-examples-complete/26-empty-trailing-lines-out.R b/tests/testthat/roxygen-examples-complete/26-empty-trailing-lines-out.R index f85ff9e76..dc44475aa 100644 --- a/tests/testthat/roxygen-examples-complete/26-empty-trailing-lines-out.R +++ b/tests/testthat/roxygen-examples-complete/26-empty-trailing-lines-out.R @@ -24,7 +24,6 @@ NULL NULL - #' this #' #' empty line after example diff --git a/tests/testthat/roxygen-examples-complete/30-multiple-empty-lines-between-in.R b/tests/testthat/roxygen-examples-complete/30-multiple-empty-lines-between-in.R new file mode 100644 index 000000000..880595599 --- /dev/null +++ b/tests/testthat/roxygen-examples-complete/30-multiple-empty-lines-between-in.R @@ -0,0 +1,16 @@ +#' Empty line in examples +#' +#' @examples +1 + + + + + + +#' Empty line in examples +#' +#' @examples +#' \dontrun{ +#' } +2 diff --git a/tests/testthat/roxygen-examples-complete/30-multiple-empty-lines-between-out.R b/tests/testthat/roxygen-examples-complete/30-multiple-empty-lines-between-out.R new file mode 100644 index 000000000..8871734b8 --- /dev/null +++ b/tests/testthat/roxygen-examples-complete/30-multiple-empty-lines-between-out.R @@ -0,0 +1,13 @@ +#' Empty line in examples +#' +#' @examples +1 + + +#' Empty line in examples +#' +#' @examples +#' \dontrun{ +#' +#' } +2 diff --git a/tests/testthat/test-line_breaks_top_level_exprs.R b/tests/testthat/test-line_breaks_top_level_exprs.R new file mode 100644 index 000000000..643385954 --- /dev/null +++ b/tests/testthat/test-line_breaks_top_level_exprs.R @@ -0,0 +1,29 @@ +test_that("extra line breaks between conditional statements are removed", { + expect_no_warning( + test_collection("line_breaks_top_level_exprs", "conditionals", transformer = style_text) + ) +}) + +test_that("extra line breaks between function and definitions and calls are removed", { + expect_no_warning( + test_collection("line_breaks_top_level_exprs", "function_defs_and_calls", transformer = style_text) + ) +}) + +test_that("extra line breaks between piped chains are removed", { + expect_no_warning( + test_collection("line_breaks_top_level_exprs", "piped_chains", transformer = style_text) + ) +}) + +test_that("extra line breaks between braced expressions are removed", { + expect_no_warning( + test_collection("line_breaks_top_level_exprs", "braces", transformer = style_text) + ) +}) + +test_that("extra line breaks are not removed in non-strict mode", { + expect_no_warning( + test_collection("line_breaks_top_level_exprs", "non_strict", transformer = style_text, strict = FALSE) + ) +}) diff --git a/tests/testthat/test-roxygen-examples-complete-30.R b/tests/testthat/test-roxygen-examples-complete-30.R new file mode 100644 index 000000000..f81bab588 --- /dev/null +++ b/tests/testthat/test-roxygen-examples-complete-30.R @@ -0,0 +1,5 @@ +# NB: DO NOT EDIT. Auto-generated by ./tests/dev/generate_roxygen_tests.R. + +test_that("analogous to test-roxygen-examples-complete: 30", { + expect_warning(test_collection("roxygen-examples-complete", "^30-", transformer = style_text), NA) +}) diff --git a/tests/testthat/test-transformers-drop.R b/tests/testthat/test-transformers-drop.R index 77ccff008..ad10908f5 100644 --- a/tests/testthat/test-transformers-drop.R +++ b/tests/testthat/test-transformers-drop.R @@ -72,6 +72,7 @@ test_that("tidyverse transformers are correctly dropped", { names_line_break <- c( "remove_empty_lines_after_opening_and_before_closing_braces", + "set_line_breaks_between_top_level_exprs", "set_line_break_around_comma_and_or", "set_line_break_after_assignment", "set_line_break_after_opening_if_call_is_multi_line", diff --git a/tests/testthat/token_adding_removing/mixed_token-out.R b/tests/testthat/token_adding_removing/mixed_token-out.R index e80aafb4d..068ab64ef 100644 --- a/tests/testthat/token_adding_removing/mixed_token-out.R +++ b/tests/testthat/token_adding_removing/mixed_token-out.R @@ -14,7 +14,6 @@ d 'text with "quotes"' - # adding brackets in pipes a %>% b() %>%