diff --git a/R/expr-is.R b/R/expr-is.R index a152166a5..58fbb673f 100644 --- a/R/expr-is.R +++ b/R/expr-is.R @@ -11,6 +11,11 @@ is_curly_expr <- function(pd) { pd$token[1] == "'{'" } +is_subset_expr <- function(pd) { + if (is.null(pd) || nrow(pd) == 1) return(FALSE) + pd$token[2] == "'['" +} + #' @describeIn pd_is Checks whether `pd` is a function call. is_function_call <- function(pd) { if (is.null(pd)) return(FALSE) diff --git a/R/modify_pd.R b/R/modify_pd.R index e676fca90..4d02d9aa2 100644 --- a/R/modify_pd.R +++ b/R/modify_pd.R @@ -7,24 +7,18 @@ #' @name update_indention NULL -#' @describeIn update_indention Inserts indention based on round brackets. -indent_round <- function(pd, indent_by) { +#' @describeIn update_indention Inserts indention based on round, square and +#' curly brackets. +indent_braces <- function(pd, indent_by) { indent_indices <- compute_indent_indices( - pd, token_opening = "'('", token_closing = "')'" + pd, + token_opening = c("'('", "'['", "'{'"), + token_closing = c("')'", "']'", "'}'") ) pd$indent[indent_indices] <- pd$indent[indent_indices] + indent_by set_unindention_child(pd, token = "')'", unindent_by = indent_by) } -#' @rdname update_indention -indent_curly <- function(pd, indent_by) { - indent_indices <- compute_indent_indices( - pd, token_opening = "'{'", token_closing = "'}'" - ) - pd$indent[indent_indices] <- pd$indent[indent_indices] + indent_by - set_unindention_child(pd, token = "'}'", unindent_by = indent_by) -} - #' @describeIn update_indention Indents operators indent_op <- function(pd, indent_by, diff --git a/R/rules-line_break.R b/R/rules-line_break.R index d81ab017f..3d2cf658b 100644 --- a/R/rules-line_break.R +++ b/R/rules-line_break.R @@ -70,7 +70,7 @@ set_line_break_after_opening_if_call_is_multi_line <- function(pd, except_token_after = NULL, except_text_before = NULL) { - if (!is_function_call(pd)) return(pd) + if (!is_function_call(pd) && !is_subset_expr(pd)) return(pd) npd <- nrow(pd) seq_x <- seq2(3L, npd - 1L) is_multi_line <- any( @@ -92,7 +92,7 @@ set_line_break_after_opening_if_call_is_multi_line <- #' @describeIn set_line_break_if_call_is_multi_line Sets line break before #' closing parenthesis. set_line_break_before_closing_call <- function(pd, except_token_before) { - if (!is_function_call(pd)) return(pd) + if (!is_function_call(pd) && !is_subset_expr(pd)) return(pd) npd <- nrow(pd) is_multi_line <- any(pd$lag_newlines[seq2(3L, npd - 1L)] > 0) if (!is_multi_line) { diff --git a/R/serialized_tests.R b/R/serialized_tests.R index 11b9d6b37..b3d6b3058 100644 --- a/R/serialized_tests.R +++ b/R/serialized_tests.R @@ -151,46 +151,6 @@ style_empty <- function(text) { transformed_text } -#' @describeIn test_transformer Transformations for indention based on curly -#' brackets only. -style_indent_curly <- function(text) { - - transformers <- list( - # transformer functions - initialize = initialize_attributes, - line_break = NULL, - space = partial(indent_curly, indent_by = 2), - token = NULL, - - # transformer options - use_raw_indention = FALSE, - NULL - ) - transformed_text <- parse_transform_serialize(text, transformers) - transformed_text -} - - -#' @describeIn test_transformer Transformations for indention based on curly -#' brackets and round brackets. -style_indent_curly_round <- function(text) { - transformers <- list( - # transformer functions - initialize = initialize_attributes, - line_break = NULL, - space = c(partial(indent_curly, indent_by = 2), - partial(indent_round, indent_by = 2)), - token = NULL, - - # transformer options - use_raw_indention = FALSE, - NULL - ) - - transformed_text <- parse_transform_serialize(text, transformers) - transformed_text -} - #' @describeIn test_transformer Transformations for indention based on operators style_op <- function(text) { diff --git a/R/style_guides.R b/R/style_guides.R index 21f58e393..d7088287d 100644 --- a/R/style_guides.R +++ b/R/style_guides.R @@ -58,8 +58,7 @@ tidyverse_style <- function(scope = "tokens", space_manipulators <- if (scope >= "spaces") lst( - partial(indent_round, indent_by = indent_by), - partial(indent_curly, indent_by = indent_by), + partial(indent_braces, indent_by = indent_by), partial(indent_op, indent_by = indent_by), partial(indent_eq_sub, indent_by = indent_by), partial(indent_without_paren, indent_by = indent_by), diff --git a/man/test_transformer.Rd b/man/test_transformer.Rd index 1451c4aab..c80a7b0c7 100644 --- a/man/test_transformer.Rd +++ b/man/test_transformer.Rd @@ -3,17 +3,11 @@ \name{test_transformer} \alias{test_transformer} \alias{style_empty} -\alias{style_indent_curly} -\alias{style_indent_curly_round} \alias{style_op} \title{Transforming test input with a transformer function} \usage{ style_empty(text) -style_indent_curly(text) - -style_indent_curly_round(text) - style_op(text) } \arguments{ @@ -33,12 +27,6 @@ as \code{\link[=style_text]{style_text()}}. transformations but remove EOL spaces and indention due to the way the serialization is set up. -\item \code{style_indent_curly}: Transformations for indention based on curly -brackets only. - -\item \code{style_indent_curly_round}: Transformations for indention based on curly -brackets and round brackets. - \item \code{style_op}: Transformations for indention based on operators }} diff --git a/man/update_indention.Rd b/man/update_indention.Rd index 9995ffa68..b0a26c229 100644 --- a/man/update_indention.Rd +++ b/man/update_indention.Rd @@ -2,8 +2,7 @@ % Please edit documentation in R/modify_pd.R \name{update_indention} \alias{update_indention} -\alias{indent_round} -\alias{indent_curly} +\alias{indent_braces} \alias{indent_op} \alias{indent_eq_sub} \alias{indent_assign} @@ -12,9 +11,7 @@ \alias{indent_without_paren_if_else} \title{Update indention information of parse data} \usage{ -indent_round(pd, indent_by) - -indent_curly(pd, indent_by) +indent_braces(pd, indent_by) indent_op(pd, indent_by, token = c(math_token, logical_token, special_token, "LEFT_ASSIGN", "'$'")) @@ -42,7 +39,8 @@ Update indention information of parse data } \section{Functions}{ \itemize{ -\item \code{indent_round}: Inserts indention based on round brackets. +\item \code{indent_braces}: Inserts indention based on round, square and +curly brackets. \item \code{indent_op}: Indents operators diff --git a/tests/testthat/indention_curly_brackets/multi_line_curly_only-out.R b/tests/testthat/indention_curly_brackets/multi_line_curly_only-out.R index 69ee670bc..b2db83528 100644 --- a/tests/testthat/indention_curly_brackets/multi_line_curly_only-out.R +++ b/tests/testthat/indention_curly_brackets/multi_line_curly_only-out.R @@ -1,4 +1,8 @@ { - {1 + 3} - {2 + sin(pi)} + { + 1 + 3 + } + { + 2 + sin(pi) + } } diff --git a/tests/testthat/indention_curly_brackets/multi_line_curly_round_only-in.R b/tests/testthat/indention_curly_brackets/multi_line_curly_round_only-in.R index 88abf7485..192e43770 100644 --- a/tests/testthat/indention_curly_brackets/multi_line_curly_round_only-in.R +++ b/tests/testthat/indention_curly_brackets/multi_line_curly_round_only-in.R @@ -1,7 +1,7 @@ a <- function(x) { x <- c(1, 2 + 3, -sin(pi)) # FIXME add tidyverse-comliant rule to break after '(' +sin(pi)) if(x > 10) { return("done") diff --git a/tests/testthat/indention_curly_brackets/multi_line_curly_round_only-in_tree b/tests/testthat/indention_curly_brackets/multi_line_curly_round_only-in_tree index 392373b71..b79f115e5 100644 --- a/tests/testthat/indention_curly_brackets/multi_line_curly_round_only-in_tree +++ b/tests/testthat/indention_curly_brackets/multi_line_curly_round_only-in_tree @@ -1,16 +1,16 @@ ROOT (token: short_text [lag_newlines/spaces] {id}) - °--expr: [0/0] {90} + °--expr: [0/0] {89} ¦--expr: [0/1] {3} ¦ °--SYMBOL: a [0/0] {1} ¦--LEFT_ASSIGN: <- [0/1] {2} - °--expr: [0/0] {89} + °--expr: [0/0] {88} ¦--FUNCTION: funct [0/0] {4} ¦--'(': ( [0/0] {5} ¦--SYMBOL_FORMALS: x [0/0] {6} ¦--')': ) [0/1] {7} - °--expr: [0/0] {86} + °--expr: [0/0] {85} ¦--'{': { [0/0] {9} - ¦--expr: [1/1] {48} + ¦--expr: [1/0] {47} ¦ ¦--expr: [0/1] {13} ¦ ¦ °--SYMBOL: x [0/0] {11} ¦ ¦--LEFT_ASSIGN: <- [0/1] {12} @@ -36,25 +36,24 @@ ROOT (token: short_text [lag_newlines/spaces] {id}) ¦ ¦ ¦ °--SYMBOL: pi [0/0] {36} ¦ ¦ °--')': ) [0/0] {37} ¦ °--')': ) [0/0] {42} - ¦--COMMENT: # FIX [0/0] {46} - ¦--expr: [2/8] {83} - ¦ ¦--IF: if [0/0] {53} - ¦ ¦--'(': ( [0/0] {54} - ¦ ¦--expr: [0/0] {61} - ¦ ¦ ¦--expr: [0/1] {57} - ¦ ¦ ¦ °--SYMBOL: x [0/0] {55} - ¦ ¦ ¦--GT: > [0/1] {56} - ¦ ¦ °--expr: [0/0] {59} - ¦ ¦ °--NUM_CONST: 10 [0/0] {58} - ¦ ¦--')': ) [0/1] {60} - ¦ °--expr: [0/0] {79} - ¦ ¦--'{': { [0/4] {63} - ¦ ¦--expr: [1/16] {73} - ¦ ¦ ¦--expr: [0/0] {67} - ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {65} - ¦ ¦ ¦--'(': ( [0/0] {66} - ¦ ¦ ¦--expr: [0/0] {70} - ¦ ¦ ¦ °--STR_CONST: "done [0/0] {68} - ¦ ¦ °--')': ) [0/0] {69} - ¦ °--'}': } [1/0] {77} - °--'}': } [1/0] {81} + ¦--expr: [2/8] {82} + ¦ ¦--IF: if [0/0] {52} + ¦ ¦--'(': ( [0/0] {53} + ¦ ¦--expr: [0/0] {60} + ¦ ¦ ¦--expr: [0/1] {56} + ¦ ¦ ¦ °--SYMBOL: x [0/0] {54} + ¦ ¦ ¦--GT: > [0/1] {55} + ¦ ¦ °--expr: [0/0] {58} + ¦ ¦ °--NUM_CONST: 10 [0/0] {57} + ¦ ¦--')': ) [0/1] {59} + ¦ °--expr: [0/0] {78} + ¦ ¦--'{': { [0/4] {62} + ¦ ¦--expr: [1/16] {72} + ¦ ¦ ¦--expr: [0/0] {66} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {64} + ¦ ¦ ¦--'(': ( [0/0] {65} + ¦ ¦ ¦--expr: [0/0] {69} + ¦ ¦ ¦ °--STR_CONST: "done [0/0] {67} + ¦ ¦ °--')': ) [0/0] {68} + ¦ °--'}': } [1/0] {76} + °--'}': } [1/0] {80} diff --git a/tests/testthat/indention_curly_brackets/multi_line_curly_round_only-out.R b/tests/testthat/indention_curly_brackets/multi_line_curly_round_only-out.R index 37dd96f68..745c5b262 100644 --- a/tests/testthat/indention_curly_brackets/multi_line_curly_round_only-out.R +++ b/tests/testthat/indention_curly_brackets/multi_line_curly_round_only-out.R @@ -1,9 +1,11 @@ a <- function(x) { - x <- c(1, + x <- c( + 1, 2 + 3, - sin(pi)) # FIXME add tidyverse-comliant rule to break after '(' + sin(pi) + ) - if(x > 10) { + if (x > 10) { return("done") } } diff --git a/tests/testthat/indention_curly_brackets/one_line_curly-out.R b/tests/testthat/indention_curly_brackets/one_line_curly-out.R index 1861090d8..9904d1ce8 100644 --- a/tests/testthat/indention_curly_brackets/one_line_curly-out.R +++ b/tests/testthat/indention_curly_brackets/one_line_curly-out.R @@ -1 +1,3 @@ -a <- {1+1} +a <- { + 1 + 1 +} diff --git a/tests/testthat/indention_square_brackets/square_brackets_line_break-in.R b/tests/testthat/indention_square_brackets/square_brackets_line_break-in.R new file mode 100644 index 000000000..bdfcd50e4 --- /dev/null +++ b/tests/testthat/indention_square_brackets/square_brackets_line_break-in.R @@ -0,0 +1,11 @@ +ranges[tag == "non_literal" & str_detect(text, ";"), +text := str_replace_all(text, ";", "\n")] + +fak[a, b] + +fac[a, + b] +fac[ + a, + b + ] diff --git a/tests/testthat/indention_square_brackets/square_brackets_line_break-in_tree b/tests/testthat/indention_square_brackets/square_brackets_line_break-in_tree new file mode 100644 index 000000000..79f58cdc9 --- /dev/null +++ b/tests/testthat/indention_square_brackets/square_brackets_line_break-in_tree @@ -0,0 +1,72 @@ +ROOT (token: short_text [lag_newlines/spaces] {id}) + ¦--expr: [0/0] {56} + ¦ ¦--expr: [0/0] {3} + ¦ ¦ °--SYMBOL: range [0/0] {1} + ¦ ¦--'[': [ [0/0] {2} + ¦ ¦--expr: [0/0] {26} + ¦ ¦ ¦--expr: [0/1] {10} + ¦ ¦ ¦ ¦--expr: [0/1] {6} + ¦ ¦ ¦ ¦ °--SYMBOL: tag [0/0] {4} + ¦ ¦ ¦ ¦--EQ: == [0/1] {5} + ¦ ¦ ¦ °--expr: [0/0] {9} + ¦ ¦ ¦ °--STR_CONST: "non_ [0/0] {7} + ¦ ¦ ¦--AND: & [0/1] {8} + ¦ ¦ °--expr: [0/0] {24} + ¦ ¦ ¦--expr: [0/0] {13} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: str_d [0/0] {11} + ¦ ¦ ¦--'(': ( [0/0] {12} + ¦ ¦ ¦--expr: [0/0] {16} + ¦ ¦ ¦ °--SYMBOL: text [0/0] {14} + ¦ ¦ ¦--',': , [0/1] {15} + ¦ ¦ ¦--expr: [0/0] {21} + ¦ ¦ ¦ °--STR_CONST: ";" [0/0] {19} + ¦ ¦ °--')': ) [0/0] {20} + ¦ ¦--',': , [0/0] {25} + ¦ ¦--expr: [1/0] {53} + ¦ ¦ ¦--expr: [0/1] {32} + ¦ ¦ ¦ °--SYMBOL: text [0/0] {30} + ¦ ¦ ¦--LEFT_ASSIGN: := [0/1] {31} + ¦ ¦ °--expr: [0/0] {51} + ¦ ¦ ¦--expr: [0/0] {35} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: str_r [0/0] {33} + ¦ ¦ ¦--'(': ( [0/0] {34} + ¦ ¦ ¦--expr: [0/0] {38} + ¦ ¦ ¦ °--SYMBOL: text [0/0] {36} + ¦ ¦ ¦--',': , [0/1] {37} + ¦ ¦ ¦--expr: [0/0] {43} + ¦ ¦ ¦ °--STR_CONST: ";" [0/0] {41} + ¦ ¦ ¦--',': , [0/1] {42} + ¦ ¦ ¦--expr: [0/0] {48} + ¦ ¦ ¦ °--STR_CONST: "\n" [0/0] {46} + ¦ ¦ °--')': ) [0/0] {47} + ¦ °--']': ] [0/0] {52} + ¦--expr: [2/0] {75} + ¦ ¦--expr: [0/0] {64} + ¦ ¦ °--SYMBOL: fak [0/0] {62} + ¦ ¦--'[': [ [0/0] {63} + ¦ ¦--expr: [0/0] {67} + ¦ ¦ °--SYMBOL: a [0/0] {65} + ¦ ¦--',': , [0/1] {66} + ¦ ¦--expr: [0/0] {72} + ¦ ¦ °--SYMBOL: b [0/0] {70} + ¦ °--']': ] [0/0] {71} + ¦--expr: [2/0] {95} + ¦ ¦--expr: [0/0] {83} + ¦ ¦ °--SYMBOL: fac [0/0] {81} + ¦ ¦--'[': [ [0/0] {82} + ¦ ¦--expr: [0/0] {86} + ¦ ¦ °--SYMBOL: a [0/0] {84} + ¦ ¦--',': , [0/4] {85} + ¦ ¦--expr: [1/0] {92} + ¦ ¦ °--SYMBOL: b [0/0] {90} + ¦ °--']': ] [0/0] {91} + °--expr: [1/0] {115} + ¦--expr: [0/0] {101} + ¦ °--SYMBOL: fac [0/0] {99} + ¦--'[': [ [0/2] {100} + ¦--expr: [1/0] {105} + ¦ °--SYMBOL: a [0/0] {103} + ¦--',': , [0/2] {104} + ¦--expr: [1/2] {112} + ¦ °--SYMBOL: b [0/0] {109} + °--']': ] [1/0] {111} diff --git a/tests/testthat/indention_square_brackets/square_brackets_line_break-out.R b/tests/testthat/indention_square_brackets/square_brackets_line_break-out.R new file mode 100644 index 000000000..69e9cea51 --- /dev/null +++ b/tests/testthat/indention_square_brackets/square_brackets_line_break-out.R @@ -0,0 +1,15 @@ +ranges[ + tag == "non_literal" & str_detect(text, ";"), + text := str_replace_all(text, ";", "\n") +] + +fak[a, b] + +fac[ + a, + b +] +fac[ + a, + b +] diff --git a/tests/testthat/test-indention_curly.R b/tests/testthat/test-indention_curly.R index b646033f9..11c33045a 100644 --- a/tests/testthat/test-indention_curly.R +++ b/tests/testthat/test-indention_curly.R @@ -3,14 +3,14 @@ context("indent curly brackets") test_that("indention on one-liner curley only is not changed", { expect_warning(test_collection("indention_curly_brackets", "one_line_curly", - transformer = style_indent_curly), NA) + transformer = style_text), NA) }) test_that("indention with multi-line curley only is correct", { expect_warning(test_collection("indention_curly_brackets", "multi_line_curly_only", - transformer = style_indent_curly), NA) + transformer = style_text), NA) }) @@ -18,7 +18,7 @@ test_that("indention with multi-line curley only is correct", { test_that("indention with multi-line curley and round is correct", { expect_warning(test_collection("indention_curly_brackets", "multi_line_curly_round_only", - transformer = style_indent_curly_round), NA) + transformer = style_text), NA) }) diff --git a/tests/testthat/test-square_brackets.R b/tests/testthat/test-square_brackets.R new file mode 100644 index 000000000..3b317af7a --- /dev/null +++ b/tests/testthat/test-square_brackets.R @@ -0,0 +1,7 @@ +context("indention square brackets") + +test_that("square brackets cause indention", { + expect_warning(test_collection( + "indention_square_brackets", + "square_brackets_line_break", transformer = style_text), NA) +}) diff --git a/tests/testthat/test-unindention.R b/tests/testthat/test-unindention.R index bb1e4cd9c..988bc5469 100644 --- a/tests/testthat/test-unindention.R +++ b/tests/testthat/test-unindention.R @@ -3,7 +3,7 @@ context("unindention") test_that("round brackets are unindented correctly", { expect_warning(test_collection("unindention", "mixed", - transformer = style_indent_curly_round, + transformer = style_text, write_back = TRUE), NA) }) diff --git a/tests/testthat/unindention/mixed-in.R b/tests/testthat/unindention/mixed-in.R index 34b8bd4c0..5a00a8b16 100644 --- a/tests/testthat/unindention/mixed-in.R +++ b/tests/testthat/unindention/mixed-in.R @@ -10,6 +10,6 @@ call1(2, 3), { sin(cos(pi)) - } ) # FIXME space between curly and round bracket must be removed + } ) } } diff --git a/tests/testthat/unindention/mixed-in_tree b/tests/testthat/unindention/mixed-in_tree index 71dc098d5..b3155ac79 100644 --- a/tests/testthat/unindention/mixed-in_tree +++ b/tests/testthat/unindention/mixed-in_tree @@ -13,11 +13,11 @@ ROOT (token: short_text [lag_newlines/spaces] {id}) ¦ ¦ ¦ °--')': ) [0/0] {13} ¦ ¦ °--')': ) [0/0] {16} ¦ °--'}': } [1/0] {22} - °--expr: [2/0] {96} + °--expr: [2/0] {95} ¦--'{': { [0/0] {30} - ¦--expr: [1/0] {90} + ¦--expr: [1/0] {89} ¦ ¦--'{': { [0/8] {32} - ¦ ¦--expr: [1/1] {83} + ¦ ¦--expr: [1/5] {83} ¦ ¦ ¦--expr: [0/0] {36} ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: call [0/0] {34} ¦ ¦ ¦--'(': ( [0/10] {35} @@ -48,6 +48,5 @@ ROOT (token: short_text [lag_newlines/spaces] {id}) ¦ ¦ ¦ ¦ °--')': ) [0/0] {70} ¦ ¦ ¦ °--'}': } [1/0] {77} ¦ ¦ °--')': ) [0/0] {80} - ¦ ¦--COMMENT: # FIX [0/5] {84} - ¦ °--'}': } [1/0] {88} - °--'}': } [1/0] {94} + ¦ °--'}': } [1/0] {87} + °--'}': } [1/0] {93} diff --git a/tests/testthat/unindention/mixed-out.R b/tests/testthat/unindention/mixed-out.R index cc6791e91..5dce16bf7 100644 --- a/tests/testthat/unindention/mixed-out.R +++ b/tests/testthat/unindention/mixed-out.R @@ -7,9 +7,9 @@ { { call( - call1(2, 3), - { + call1(2, 3), { sin(cos(pi)) - } ) # FIXME space between curly and round bracket must be removed + } + ) } }