From 2f2bd47541d1683d089396f4d65f1d4153e306c9 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sat, 14 Dec 2019 23:32:19 +0100 Subject: [PATCH 1/4] break line after ggplot (simple cases) --- R/rules-line-break.R | 13 ++ R/style-guides.R | 3 +- .../line_breaks_and_other/ggplot2-in.R | 18 ++ .../line_breaks_and_other/ggplot2-in_tree | 184 ++++++++++++++++++ .../line_breaks_and_other/ggplot2-out.R | 22 +++ tests/testthat/test-line_breaks_and_other.R | 5 + 6 files changed, 244 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/line_breaks_and_other/ggplot2-in.R create mode 100644 tests/testthat/line_breaks_and_other/ggplot2-in_tree create mode 100644 tests/testthat/line_breaks_and_other/ggplot2-out.R diff --git a/R/rules-line-break.R b/R/rules-line-break.R index a4720cc93..190d0478a 100644 --- a/R/rules-line-break.R +++ b/R/rules-line-break.R @@ -273,3 +273,16 @@ remove_line_break_in_empty_fun_call <- function(pd) { } pd } + + +set_linebreak_after_ggplot2_plus <- function(pd) { + is_plus <- pd$token == "'+'" & + (pd$token_after == "SYMBOL_FUNCTION_CALL" | pd$token_after == "SYMBOL_PACKAGE") + if (any(is_plus)) { + gg_call <- pd$child[[which(is_plus)[1] - 1]]$child[[1]] + if (!is.null(gg_call) && gg_call$text[gg_call$token == "SYMBOL_FUNCTION_CALL"] == "ggplot") { + pd$lag_newlines[lag(is_plus)] <- 1L + } + } + pd +} diff --git a/R/style-guides.R b/R/style-guides.R index ab9ee94ae..7c6d65f1b 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -137,7 +137,8 @@ tidyverse_style <- function(scope = "tokens", ) }, remove_line_break_in_empty_fun_call, - add_line_break_after_pipe = if (strict) add_line_break_after_pipe + 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/tests/testthat/line_breaks_and_other/ggplot2-in.R b/tests/testthat/line_breaks_and_other/ggplot2-in.R new file mode 100644 index 000000000..27c4713c6 --- /dev/null +++ b/tests/testthat/line_breaks_and_other/ggplot2-in.R @@ -0,0 +1,18 @@ +# don't remove line break +ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + + geom_point() + + +# add when unmasked +ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + geom_point() + + +# add when masked +ggplot2::ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + geom_point() + +# add when masked +ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + ggplot2::geom_point() + +# add when comment +ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + # comment + ggplot2::geom_point() + g() diff --git a/tests/testthat/line_breaks_and_other/ggplot2-in_tree b/tests/testthat/line_breaks_and_other/ggplot2-in_tree new file mode 100644 index 000000000..79be001b8 --- /dev/null +++ b/tests/testthat/line_breaks_and_other/ggplot2-in_tree @@ -0,0 +1,184 @@ +ROOT (token: short_text [lag_newlines/spaces] {pos_id}) + ¦--COMMENT: # don [0/0] {1} + ¦--expr: [1/0] {2} + ¦ ¦--expr: [0/1] {3} + ¦ ¦ ¦--expr: [0/0] {5} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: ggplo [0/0] {4} + ¦ ¦ ¦--'(': ( [0/0] {6} + ¦ ¦ ¦--SYMBOL_SUB: data [0/1] {7} + ¦ ¦ ¦--EQ_SUB: = [0/1] {8} + ¦ ¦ ¦--expr: [0/0] {10} + ¦ ¦ ¦ °--SYMBOL: mtcar [0/0] {9} + ¦ ¦ ¦--',': , [0/1] {11} + ¦ ¦ ¦--SYMBOL_SUB: mappi [0/1] {12} + ¦ ¦ ¦--EQ_SUB: = [0/1] {13} + ¦ ¦ ¦--expr: [0/0] {14} + ¦ ¦ ¦ ¦--expr: [0/0] {16} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: aes [0/0] {15} + ¦ ¦ ¦ ¦--'(': ( [0/0] {17} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {18} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {19} + ¦ ¦ ¦ ¦--expr: [0/0] {21} + ¦ ¦ ¦ ¦ °--SYMBOL: mpg [0/0] {20} + ¦ ¦ ¦ ¦--',': , [0/1] {22} + ¦ ¦ ¦ ¦--SYMBOL_SUB: y [0/1] {23} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {24} + ¦ ¦ ¦ ¦--expr: [0/0] {26} + ¦ ¦ ¦ ¦ °--SYMBOL: vs [0/0] {25} + ¦ ¦ ¦ °--')': ) [0/0] {27} + ¦ ¦ °--')': ) [0/0] {28} + ¦ ¦--'+': + [0/2] {29} + ¦ °--expr: [1/0] {30} + ¦ ¦--expr: [0/0] {32} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: geom_ [0/0] {31} + ¦ ¦--'(': ( [0/0] {33} + ¦ °--')': ) [0/0] {34} + ¦--COMMENT: # add [3/0] {35} + ¦--expr: [1/0] {36} + ¦ ¦--expr: [0/1] {37} + ¦ ¦ ¦--expr: [0/0] {39} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: ggplo [0/0] {38} + ¦ ¦ ¦--'(': ( [0/0] {40} + ¦ ¦ ¦--SYMBOL_SUB: data [0/1] {41} + ¦ ¦ ¦--EQ_SUB: = [0/1] {42} + ¦ ¦ ¦--expr: [0/0] {44} + ¦ ¦ ¦ °--SYMBOL: mtcar [0/0] {43} + ¦ ¦ ¦--',': , [0/1] {45} + ¦ ¦ ¦--SYMBOL_SUB: mappi [0/1] {46} + ¦ ¦ ¦--EQ_SUB: = [0/1] {47} + ¦ ¦ ¦--expr: [0/0] {48} + ¦ ¦ ¦ ¦--expr: [0/0] {50} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: aes [0/0] {49} + ¦ ¦ ¦ ¦--'(': ( [0/0] {51} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {52} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {53} + ¦ ¦ ¦ ¦--expr: [0/0] {55} + ¦ ¦ ¦ ¦ °--SYMBOL: mpg [0/0] {54} + ¦ ¦ ¦ ¦--',': , [0/1] {56} + ¦ ¦ ¦ ¦--SYMBOL_SUB: y [0/1] {57} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {58} + ¦ ¦ ¦ ¦--expr: [0/0] {60} + ¦ ¦ ¦ ¦ °--SYMBOL: vs [0/0] {59} + ¦ ¦ ¦ °--')': ) [0/0] {61} + ¦ ¦ °--')': ) [0/0] {62} + ¦ ¦--'+': + [0/1] {63} + ¦ °--expr: [0/0] {64} + ¦ ¦--expr: [0/0] {66} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: geom_ [0/0] {65} + ¦ ¦--'(': ( [0/0] {67} + ¦ °--')': ) [0/0] {68} + ¦--COMMENT: # add [3/0] {69} + ¦--expr: [1/0] {70} + ¦ ¦--expr: [0/1] {71} + ¦ ¦ ¦--expr: [0/0] {72} + ¦ ¦ ¦ ¦--SYMBOL_PACKAGE: ggplo [0/0] {73} + ¦ ¦ ¦ ¦--NS_GET: :: [0/0] {74} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: ggplo [0/0] {75} + ¦ ¦ ¦--'(': ( [0/0] {76} + ¦ ¦ ¦--SYMBOL_SUB: data [0/1] {77} + ¦ ¦ ¦--EQ_SUB: = [0/1] {78} + ¦ ¦ ¦--expr: [0/0] {80} + ¦ ¦ ¦ °--SYMBOL: mtcar [0/0] {79} + ¦ ¦ ¦--',': , [0/1] {81} + ¦ ¦ ¦--SYMBOL_SUB: mappi [0/1] {82} + ¦ ¦ ¦--EQ_SUB: = [0/1] {83} + ¦ ¦ ¦--expr: [0/0] {84} + ¦ ¦ ¦ ¦--expr: [0/0] {86} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: aes [0/0] {85} + ¦ ¦ ¦ ¦--'(': ( [0/0] {87} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {88} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {89} + ¦ ¦ ¦ ¦--expr: [0/0] {91} + ¦ ¦ ¦ ¦ °--SYMBOL: mpg [0/0] {90} + ¦ ¦ ¦ ¦--',': , [0/1] {92} + ¦ ¦ ¦ ¦--SYMBOL_SUB: y [0/1] {93} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {94} + ¦ ¦ ¦ ¦--expr: [0/0] {96} + ¦ ¦ ¦ ¦ °--SYMBOL: vs [0/0] {95} + ¦ ¦ ¦ °--')': ) [0/0] {97} + ¦ ¦ °--')': ) [0/0] {98} + ¦ ¦--'+': + [0/1] {99} + ¦ °--expr: [0/0] {100} + ¦ ¦--expr: [0/0] {102} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: geom_ [0/0] {101} + ¦ ¦--'(': ( [0/0] {103} + ¦ °--')': ) [0/0] {104} + ¦--COMMENT: # add [2/0] {105} + ¦--expr: [1/0] {106} + ¦ ¦--expr: [0/1] {107} + ¦ ¦ ¦--expr: [0/0] {109} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: ggplo [0/0] {108} + ¦ ¦ ¦--'(': ( [0/0] {110} + ¦ ¦ ¦--SYMBOL_SUB: data [0/1] {111} + ¦ ¦ ¦--EQ_SUB: = [0/1] {112} + ¦ ¦ ¦--expr: [0/0] {114} + ¦ ¦ ¦ °--SYMBOL: mtcar [0/0] {113} + ¦ ¦ ¦--',': , [0/1] {115} + ¦ ¦ ¦--SYMBOL_SUB: mappi [0/1] {116} + ¦ ¦ ¦--EQ_SUB: = [0/1] {117} + ¦ ¦ ¦--expr: [0/0] {118} + ¦ ¦ ¦ ¦--expr: [0/0] {120} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: aes [0/0] {119} + ¦ ¦ ¦ ¦--'(': ( [0/0] {121} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {122} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {123} + ¦ ¦ ¦ ¦--expr: [0/0] {125} + ¦ ¦ ¦ ¦ °--SYMBOL: mpg [0/0] {124} + ¦ ¦ ¦ ¦--',': , [0/1] {126} + ¦ ¦ ¦ ¦--SYMBOL_SUB: y [0/1] {127} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {128} + ¦ ¦ ¦ ¦--expr: [0/0] {130} + ¦ ¦ ¦ ¦ °--SYMBOL: vs [0/0] {129} + ¦ ¦ ¦ °--')': ) [0/0] {131} + ¦ ¦ °--')': ) [0/0] {132} + ¦ ¦--'+': + [0/1] {133} + ¦ °--expr: [0/0] {134} + ¦ ¦--expr: [0/0] {135} + ¦ ¦ ¦--SYMBOL_PACKAGE: ggplo [0/0] {136} + ¦ ¦ ¦--NS_GET: :: [0/0] {137} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: geom_ [0/0] {138} + ¦ ¦--'(': ( [0/0] {139} + ¦ °--')': ) [0/0] {140} + ¦--COMMENT: # add [2/0] {141} + °--expr: [1/0] {142} + ¦--expr: [0/1] {144} + ¦ ¦--expr: [0/0] {146} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: ggplo [0/0] {145} + ¦ ¦--'(': ( [0/0] {147} + ¦ ¦--SYMBOL_SUB: data [0/1] {148} + ¦ ¦--EQ_SUB: = [0/1] {149} + ¦ ¦--expr: [0/0] {151} + ¦ ¦ °--SYMBOL: mtcar [0/0] {150} + ¦ ¦--',': , [0/1] {152} + ¦ ¦--SYMBOL_SUB: mappi [0/1] {153} + ¦ ¦--EQ_SUB: = [0/1] {154} + ¦ ¦--expr: [0/0] {155} + ¦ ¦ ¦--expr: [0/0] {157} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: aes [0/0] {156} + ¦ ¦ ¦--'(': ( [0/0] {158} + ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {159} + ¦ ¦ ¦--EQ_SUB: = [0/1] {160} + ¦ ¦ ¦--expr: [0/0] {162} + ¦ ¦ ¦ °--SYMBOL: mpg [0/0] {161} + ¦ ¦ ¦--',': , [0/1] {163} + ¦ ¦ ¦--SYMBOL_SUB: y [0/1] {164} + ¦ ¦ ¦--EQ_SUB: = [0/1] {165} + ¦ ¦ ¦--expr: [0/0] {167} + ¦ ¦ ¦ °--SYMBOL: vs [0/0] {166} + ¦ ¦ °--')': ) [0/0] {168} + ¦ °--')': ) [0/0] {169} + ¦--'+': + [0/1] {170} + ¦--COMMENT: # com [0/2] {171} + ¦--expr: [1/1] {172} + ¦ ¦--expr: [0/0] {173} + ¦ ¦ ¦--SYMBOL_PACKAGE: ggplo [0/0] {174} + ¦ ¦ ¦--NS_GET: :: [0/0] {175} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: geom_ [0/0] {176} + ¦ ¦--'(': ( [0/0] {177} + ¦ °--')': ) [0/0] {178} + ¦--'+': + [0/1] {179} + °--expr: [0/0] {180} + ¦--expr: [0/0] {182} + ¦ °--SYMBOL_FUNCTION_CALL: g [0/0] {181} + ¦--'(': ( [0/0] {183} + °--')': ) [0/0] {184} diff --git a/tests/testthat/line_breaks_and_other/ggplot2-out.R b/tests/testthat/line_breaks_and_other/ggplot2-out.R new file mode 100644 index 000000000..b57eb0da6 --- /dev/null +++ b/tests/testthat/line_breaks_and_other/ggplot2-out.R @@ -0,0 +1,22 @@ +# don't remove line break +ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + + geom_point() + + +# add when unmasked +ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + + geom_point() + + +# add when masked +ggplot2::ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + + geom_point() + +# add when masked +ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + + ggplot2::geom_point() + +# add when comment +# FIXME +ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + # comment + ggplot2::geom_point() + g() diff --git a/tests/testthat/test-line_breaks_and_other.R b/tests/testthat/test-line_breaks_and_other.R index 88637bd9e..aca5c1976 100644 --- a/tests/testthat/test-line_breaks_and_other.R +++ b/tests/testthat/test-line_breaks_and_other.R @@ -36,3 +36,8 @@ test_that("line break before comma is removed and placed after comma ", { expect_warning(test_collection("line_breaks_and_other", "pipe-line", transformer = style_text), NA) }) + +test_that("line break added for ggplot2 call", { + expect_warning(test_collection("line_breaks_and_other", "ggplot2", + transformer = style_text), NA) +}) From 672160a6ac5e633b78b87d9961ed477378e5f750 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sat, 14 Dec 2019 23:56:55 +0100 Subject: [PATCH 2/4] fix case with comments --- R/rules-line-break.R | 24 +- .../line_breaks_and_other/ggplot2-in.R | 13 ++ .../line_breaks_and_other/ggplot2-in_tree | 219 ++++++++++++++---- .../line_breaks_and_other/ggplot2-out.R | 22 +- 4 files changed, 228 insertions(+), 50 deletions(-) diff --git a/R/rules-line-break.R b/R/rules-line-break.R index 190d0478a..524efd96c 100644 --- a/R/rules-line-break.R +++ b/R/rules-line-break.R @@ -276,13 +276,25 @@ remove_line_break_in_empty_fun_call <- function(pd) { set_linebreak_after_ggplot2_plus <- function(pd) { - is_plus <- pd$token == "'+'" & - (pd$token_after == "SYMBOL_FUNCTION_CALL" | pd$token_after == "SYMBOL_PACKAGE") - if (any(is_plus)) { - gg_call <- pd$child[[which(is_plus)[1] - 1]]$child[[1]] - if (!is.null(gg_call) && gg_call$text[gg_call$token == "SYMBOL_FUNCTION_CALL"] == "ggplot") { - pd$lag_newlines[lag(is_plus)] <- 1L + is_plus_raw <- pd$token == "'+'" + if (any(is_plus_raw)) { + first_plus <- which(is_plus_raw)[1] + next_non_comment <- next_non_comment(pd, first_plus) + is_plus_or_comment_after_plus_before_fun_call <- + lag(is_plus_raw, next_non_comment - first_plus - 1, default = FALSE) & + (pd$token_after == "SYMBOL_FUNCTION_CALL" | pd$token_after == "SYMBOL_PACKAGE") + if (any(is_plus_or_comment_after_plus_before_fun_call)) { + gg_call <- pd$child[[previous_non_comment(pd, first_plus)]]$child[[1]] + if (!is.null(gg_call) && gg_call$text[gg_call$token == "SYMBOL_FUNCTION_CALL"] == "ggplot") { + plus_without_comment_after <- setdiff( + which(is_plus_raw), + which(lead(pd$token == "COMMENT")) + ) + + pd$lag_newlines[plus_without_comment_after + 1] <- 1L + } } + } pd } diff --git a/tests/testthat/line_breaks_and_other/ggplot2-in.R b/tests/testthat/line_breaks_and_other/ggplot2-in.R index 27c4713c6..8687c743d 100644 --- a/tests/testthat/line_breaks_and_other/ggplot2-in.R +++ b/tests/testthat/line_breaks_and_other/ggplot2-in.R @@ -16,3 +16,16 @@ ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + ggplot2::geom_point() # add when comment ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + # comment ggplot2::geom_point() + g() + + +# add when comment +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() # 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_and_other/ggplot2-in_tree b/tests/testthat/line_breaks_and_other/ggplot2-in_tree index 79be001b8..f1ad4ab53 100644 --- a/tests/testthat/line_breaks_and_other/ggplot2-in_tree +++ b/tests/testthat/line_breaks_and_other/ggplot2-in_tree @@ -140,45 +140,180 @@ ROOT (token: short_text [lag_newlines/spaces] {pos_id}) ¦ ¦--'(': ( [0/0] {139} ¦ °--')': ) [0/0] {140} ¦--COMMENT: # add [2/0] {141} - °--expr: [1/0] {142} - ¦--expr: [0/1] {144} - ¦ ¦--expr: [0/0] {146} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: ggplo [0/0] {145} - ¦ ¦--'(': ( [0/0] {147} - ¦ ¦--SYMBOL_SUB: data [0/1] {148} - ¦ ¦--EQ_SUB: = [0/1] {149} - ¦ ¦--expr: [0/0] {151} - ¦ ¦ °--SYMBOL: mtcar [0/0] {150} - ¦ ¦--',': , [0/1] {152} - ¦ ¦--SYMBOL_SUB: mappi [0/1] {153} - ¦ ¦--EQ_SUB: = [0/1] {154} - ¦ ¦--expr: [0/0] {155} - ¦ ¦ ¦--expr: [0/0] {157} - ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: aes [0/0] {156} - ¦ ¦ ¦--'(': ( [0/0] {158} - ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {159} - ¦ ¦ ¦--EQ_SUB: = [0/1] {160} - ¦ ¦ ¦--expr: [0/0] {162} - ¦ ¦ ¦ °--SYMBOL: mpg [0/0] {161} - ¦ ¦ ¦--',': , [0/1] {163} - ¦ ¦ ¦--SYMBOL_SUB: y [0/1] {164} - ¦ ¦ ¦--EQ_SUB: = [0/1] {165} - ¦ ¦ ¦--expr: [0/0] {167} - ¦ ¦ ¦ °--SYMBOL: vs [0/0] {166} - ¦ ¦ °--')': ) [0/0] {168} - ¦ °--')': ) [0/0] {169} - ¦--'+': + [0/1] {170} - ¦--COMMENT: # com [0/2] {171} - ¦--expr: [1/1] {172} - ¦ ¦--expr: [0/0] {173} - ¦ ¦ ¦--SYMBOL_PACKAGE: ggplo [0/0] {174} - ¦ ¦ ¦--NS_GET: :: [0/0] {175} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: geom_ [0/0] {176} - ¦ ¦--'(': ( [0/0] {177} - ¦ °--')': ) [0/0] {178} - ¦--'+': + [0/1] {179} - °--expr: [0/0] {180} - ¦--expr: [0/0] {182} - ¦ °--SYMBOL_FUNCTION_CALL: g [0/0] {181} - ¦--'(': ( [0/0] {183} - °--')': ) [0/0] {184} + ¦--expr: [1/0] {142} + ¦ ¦--expr: [0/1] {144} + ¦ ¦ ¦--expr: [0/0] {146} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: ggplo [0/0] {145} + ¦ ¦ ¦--'(': ( [0/0] {147} + ¦ ¦ ¦--SYMBOL_SUB: data [0/1] {148} + ¦ ¦ ¦--EQ_SUB: = [0/1] {149} + ¦ ¦ ¦--expr: [0/0] {151} + ¦ ¦ ¦ °--SYMBOL: mtcar [0/0] {150} + ¦ ¦ ¦--',': , [0/1] {152} + ¦ ¦ ¦--SYMBOL_SUB: mappi [0/1] {153} + ¦ ¦ ¦--EQ_SUB: = [0/1] {154} + ¦ ¦ ¦--expr: [0/0] {155} + ¦ ¦ ¦ ¦--expr: [0/0] {157} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: aes [0/0] {156} + ¦ ¦ ¦ ¦--'(': ( [0/0] {158} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {159} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {160} + ¦ ¦ ¦ ¦--expr: [0/0] {162} + ¦ ¦ ¦ ¦ °--SYMBOL: mpg [0/0] {161} + ¦ ¦ ¦ ¦--',': , [0/1] {163} + ¦ ¦ ¦ ¦--SYMBOL_SUB: y [0/1] {164} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {165} + ¦ ¦ ¦ ¦--expr: [0/0] {167} + ¦ ¦ ¦ ¦ °--SYMBOL: vs [0/0] {166} + ¦ ¦ ¦ °--')': ) [0/0] {168} + ¦ ¦ °--')': ) [0/0] {169} + ¦ ¦--'+': + [0/1] {170} + ¦ ¦--COMMENT: # com [0/2] {171} + ¦ ¦--expr: [1/1] {172} + ¦ ¦ ¦--expr: [0/0] {173} + ¦ ¦ ¦ ¦--SYMBOL_PACKAGE: ggplo [0/0] {174} + ¦ ¦ ¦ ¦--NS_GET: :: [0/0] {175} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: geom_ [0/0] {176} + ¦ ¦ ¦--'(': ( [0/0] {177} + ¦ ¦ °--')': ) [0/0] {178} + ¦ ¦--'+': + [0/1] {179} + ¦ °--expr: [0/0] {180} + ¦ ¦--expr: [0/0] {182} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: g [0/0] {181} + ¦ ¦--'(': ( [0/0] {183} + ¦ °--')': ) [0/0] {184} + ¦--COMMENT: # add [3/0] {185} + ¦--expr: [1/1] {186} + ¦ ¦--expr: [0/1] {188} + ¦ ¦ ¦--expr: [0/0] {190} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: ggplo [0/0] {189} + ¦ ¦ ¦--'(': ( [0/0] {191} + ¦ ¦ ¦--SYMBOL_SUB: data [0/1] {192} + ¦ ¦ ¦--EQ_SUB: = [0/1] {193} + ¦ ¦ ¦--expr: [0/0] {195} + ¦ ¦ ¦ °--SYMBOL: mtcar [0/0] {194} + ¦ ¦ ¦--',': , [0/1] {196} + ¦ ¦ ¦--SYMBOL_SUB: mappi [0/1] {197} + ¦ ¦ ¦--EQ_SUB: = [0/1] {198} + ¦ ¦ ¦--expr: [0/0] {199} + ¦ ¦ ¦ ¦--expr: [0/0] {201} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: aes [0/0] {200} + ¦ ¦ ¦ ¦--'(': ( [0/0] {202} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {203} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {204} + ¦ ¦ ¦ ¦--expr: [0/0] {206} + ¦ ¦ ¦ ¦ °--SYMBOL: mpg [0/0] {205} + ¦ ¦ ¦ ¦--',': , [0/1] {207} + ¦ ¦ ¦ ¦--SYMBOL_SUB: y [0/1] {208} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {209} + ¦ ¦ ¦ ¦--expr: [0/0] {211} + ¦ ¦ ¦ ¦ °--SYMBOL: vs [0/0] {210} + ¦ ¦ ¦ °--')': ) [0/0] {212} + ¦ ¦ °--')': ) [0/0] {213} + ¦ ¦--'+': + [0/2] {214} + ¦ ¦--expr: [1/1] {215} + ¦ ¦ ¦--expr: [0/0] {216} + ¦ ¦ ¦ ¦--SYMBOL_PACKAGE: ggplo [0/0] {217} + ¦ ¦ ¦ ¦--NS_GET: :: [0/0] {218} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: geom_ [0/0] {219} + ¦ ¦ ¦--'(': ( [0/0] {220} + ¦ ¦ °--')': ) [0/0] {221} + ¦ ¦--'+': + [0/1] {222} + ¦ °--expr: [0/0] {223} + ¦ ¦--expr: [0/0] {225} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: g [0/0] {224} + ¦ ¦--'(': ( [0/0] {226} + ¦ °--')': ) [0/0] {227} + ¦--COMMENT: # com [0/0] {228} + ¦--COMMENT: # add [2/0] {229} + ¦--expr: [1/1] {230} + ¦ ¦--expr: [0/1] {232} + ¦ ¦ ¦--expr: [0/0] {234} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: ggplo [0/0] {233} + ¦ ¦ ¦--'(': ( [0/0] {235} + ¦ ¦ ¦--SYMBOL_SUB: data [0/1] {236} + ¦ ¦ ¦--EQ_SUB: = [0/1] {237} + ¦ ¦ ¦--expr: [0/0] {239} + ¦ ¦ ¦ °--SYMBOL: mtcar [0/0] {238} + ¦ ¦ ¦--',': , [0/1] {240} + ¦ ¦ ¦--SYMBOL_SUB: mappi [0/1] {241} + ¦ ¦ ¦--EQ_SUB: = [0/1] {242} + ¦ ¦ ¦--expr: [0/0] {243} + ¦ ¦ ¦ ¦--expr: [0/0] {245} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: aes [0/0] {244} + ¦ ¦ ¦ ¦--'(': ( [0/0] {246} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {247} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {248} + ¦ ¦ ¦ ¦--expr: [0/0] {250} + ¦ ¦ ¦ ¦ °--SYMBOL: mpg [0/0] {249} + ¦ ¦ ¦ ¦--',': , [0/1] {251} + ¦ ¦ ¦ ¦--SYMBOL_SUB: y [0/1] {252} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {253} + ¦ ¦ ¦ ¦--expr: [0/0] {255} + ¦ ¦ ¦ ¦ °--SYMBOL: vs [0/0] {254} + ¦ ¦ ¦ °--')': ) [0/0] {256} + ¦ ¦ °--')': ) [0/0] {257} + ¦ ¦--'+': + [0/1] {258} + ¦ ¦--expr: [0/1] {259} + ¦ ¦ ¦--expr: [0/0] {260} + ¦ ¦ ¦ ¦--SYMBOL_PACKAGE: ggplo [0/0] {261} + ¦ ¦ ¦ ¦--NS_GET: :: [0/0] {262} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: geom_ [0/0] {263} + ¦ ¦ ¦--'(': ( [0/0] {264} + ¦ ¦ °--')': ) [0/0] {265} + ¦ ¦--'+': + [0/1] {266} + ¦ °--expr: [0/0] {267} + ¦ ¦--expr: [0/0] {269} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: g [0/0] {268} + ¦ ¦--'(': ( [0/0] {270} + ¦ °--')': ) [0/0] {271} + ¦--COMMENT: # com [0/0] {272} + ¦--COMMENT: # add [3/0] {273} + ¦--expr: [1/1] {274} + ¦ ¦--expr: [0/1] {277} + ¦ ¦ ¦--expr: [0/0] {279} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: ggplo [0/0] {278} + ¦ ¦ ¦--'(': ( [0/0] {280} + ¦ ¦ ¦--SYMBOL_SUB: data [0/1] {281} + ¦ ¦ ¦--EQ_SUB: = [0/1] {282} + ¦ ¦ ¦--expr: [0/0] {284} + ¦ ¦ ¦ °--SYMBOL: mtcar [0/0] {283} + ¦ ¦ ¦--',': , [0/1] {285} + ¦ ¦ ¦--SYMBOL_SUB: mappi [0/1] {286} + ¦ ¦ ¦--EQ_SUB: = [0/1] {287} + ¦ ¦ ¦--expr: [0/0] {288} + ¦ ¦ ¦ ¦--expr: [0/0] {290} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: aes [0/0] {289} + ¦ ¦ ¦ ¦--'(': ( [0/0] {291} + ¦ ¦ ¦ ¦--SYMBOL_SUB: x [0/1] {292} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {293} + ¦ ¦ ¦ ¦--expr: [0/0] {295} + ¦ ¦ ¦ ¦ °--SYMBOL: mpg [0/0] {294} + ¦ ¦ ¦ ¦--',': , [0/1] {296} + ¦ ¦ ¦ ¦--SYMBOL_SUB: y [0/1] {297} + ¦ ¦ ¦ ¦--EQ_SUB: = [0/1] {298} + ¦ ¦ ¦ ¦--expr: [0/0] {300} + ¦ ¦ ¦ ¦ °--SYMBOL: vs [0/0] {299} + ¦ ¦ ¦ °--')': ) [0/0] {301} + ¦ ¦ °--')': ) [0/0] {302} + ¦ ¦--'+': + [0/2] {303} + ¦ ¦--expr: [1/1] {304} + ¦ ¦ ¦--expr: [0/0] {305} + ¦ ¦ ¦ ¦--SYMBOL_PACKAGE: ggplo [0/0] {306} + ¦ ¦ ¦ ¦--NS_GET: :: [0/0] {307} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: geom_ [0/0] {308} + ¦ ¦ ¦--'(': ( [0/0] {309} + ¦ ¦ °--')': ) [0/0] {310} + ¦ ¦--'+': + [0/1] {311} + ¦ ¦--expr: [0/2] {312} + ¦ ¦ ¦--expr: [0/0] {314} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: g [0/0] {313} + ¦ ¦ ¦--'(': ( [0/0] {315} + ¦ ¦ °--')': ) [0/0] {316} + ¦ ¦--'+': + [0/1] {317} + ¦ °--expr: [0/0] {318} + ¦ ¦--expr: [0/0] {320} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: geom_ [0/0] {319} + ¦ ¦--'(': ( [0/0] {321} + ¦ °--')': ) [0/0] {322} + °--COMMENT: # com [0/0] {323} diff --git a/tests/testthat/line_breaks_and_other/ggplot2-out.R b/tests/testthat/line_breaks_and_other/ggplot2-out.R index b57eb0da6..a26183d2c 100644 --- a/tests/testthat/line_breaks_and_other/ggplot2-out.R +++ b/tests/testthat/line_breaks_and_other/ggplot2-out.R @@ -17,6 +17,24 @@ ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + ggplot2::geom_point() # add when comment -# FIXME ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + # comment - ggplot2::geom_point() + g() + ggplot2::geom_point() + + g() + + +# add when comment +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() # comment + + +# add when comment +ggplot(data = mtcars, mapping = aes(x = mpg, y = vs)) + + ggplot2::geom_point() + + g() + + geom_oint() # comment From 5f4c440722af2e4676ee0f92635a9a0ff8b70814 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 15 Dec 2019 00:09:24 +0100 Subject: [PATCH 3/4] preliminary news --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index aa8214723..ebbbe2df4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,5 @@ +* lines are now broken after `+` in `ggplot2` calls for `strict = TRUE`. + # styler 1.2.0.9000 ## Breaking changes From fd28e14f22be63c2354b80a590a9366268a9a316 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Mon, 16 Dec 2019 23:31:26 +0100 Subject: [PATCH 4/4] adapt NEWS.md --- NEWS.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index ebbbe2df4..a337ea45f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,3 @@ -* lines are now broken after `+` in `ggplot2` calls for `strict = TRUE`. # styler 1.2.0.9000 @@ -25,8 +24,10 @@ ## Minor changes and fixes +* lines are now broken after `+` in `ggplot2` calls for `strict = TRUE` (#569). + * `style_file()` and friends now strip `./` in file paths returned invisibly, - i.e. `./script.R` becomes `script.R`. + i.e. `./script.R` becomes `script.R` (#568). * function documentation now contains many more linebreaks due to roxygen2 update to version 7.0.1 (#566).