From d97879732034455d4c0c2c5d2180012b96d67d64 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 3 Jan 2021 11:40:01 +0100 Subject: [PATCH 01/31] remove all edge case transformers and see speed implications --- R/style-guides.R | 25 +++---------------------- 1 file changed, 3 insertions(+), 22 deletions(-) diff --git a/R/style-guides.R b/R/style-guides.R index aeb3140d7..8448648c1 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -98,19 +98,13 @@ tidyverse_style <- function(scope = "tokens", math_token_spacing$zero, math_token_spacing$one ), - style_space_around_tilde = partial( - style_space_around_tilde, - strict = strict - ), spacing_around_op = purrr::partial(set_space_around_op, strict = strict ), remove_space_after_opening_paren, remove_space_after_excl, - set_space_after_bang_bang, remove_space_before_dollar, remove_space_after_fun_dec, - remove_space_around_colons, start_comments_with_space = partial(start_comments_with_space, force_one = start_comments_with_one_space ), @@ -120,9 +114,7 @@ tidyverse_style <- function(scope = "tokens", } else { add_space_before_comments }, - set_space_between_levels, - set_space_between_eq_sub_and_comma, - set_space_in_curly_curly + set_space_between_levels ) } @@ -135,8 +127,6 @@ 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_breaks_in_fun_dec = - if (strict) remove_line_breaks_in_fun_dec, style_line_break_around_curly = partial( style_line_break_around_curly, strict @@ -158,21 +148,12 @@ tidyverse_style <- function(scope = "tokens", ) }, 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 + add_line_break_after_pipe = if (strict) add_line_break_after_pipe ) } token_manipulators <- if ("tokens" %in% scope) { - lst( - fix_quotes, - force_assignment_op, - resolve_semicolon, - add_brackets_in_pipe, - remove_terminal_token_before_and_after, - wrap_if_else_while_for_fun_multi_line_in_curly = - if (strict) wrap_if_else_while_for_fun_multi_line_in_curly - ) + lst() } style_guide_name <- "styler::tidyverse_style@https://github.com/r-lib" From 8cd65635b92ab0fca33915d95e576d5a5088408e Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 10 Jan 2021 16:10:02 +0100 Subject: [PATCH 02/31] Revert "remove all edge case transformers and see speed implications" Now we see it's working, we should do a real implementation This reverts commit f048a33de8fa1ec182a28deea1cc4ac1cb554045. --- R/style-guides.R | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/R/style-guides.R b/R/style-guides.R index 8448648c1..aeb3140d7 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -98,13 +98,19 @@ tidyverse_style <- function(scope = "tokens", math_token_spacing$zero, math_token_spacing$one ), + style_space_around_tilde = partial( + style_space_around_tilde, + strict = strict + ), spacing_around_op = purrr::partial(set_space_around_op, strict = strict ), remove_space_after_opening_paren, remove_space_after_excl, + set_space_after_bang_bang, remove_space_before_dollar, remove_space_after_fun_dec, + remove_space_around_colons, start_comments_with_space = partial(start_comments_with_space, force_one = start_comments_with_one_space ), @@ -114,7 +120,9 @@ tidyverse_style <- function(scope = "tokens", } else { add_space_before_comments }, - set_space_between_levels + set_space_between_levels, + set_space_between_eq_sub_and_comma, + set_space_in_curly_curly ) } @@ -127,6 +135,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_breaks_in_fun_dec = + if (strict) remove_line_breaks_in_fun_dec, style_line_break_around_curly = partial( style_line_break_around_curly, strict @@ -148,12 +158,21 @@ tidyverse_style <- function(scope = "tokens", ) }, purrr::partial(remove_line_break_in_fun_call, strict = strict), - 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 ) } token_manipulators <- if ("tokens" %in% scope) { - lst() + lst( + fix_quotes, + force_assignment_op, + resolve_semicolon, + add_brackets_in_pipe, + remove_terminal_token_before_and_after, + wrap_if_else_while_for_fun_multi_line_in_curly = + if (strict) wrap_if_else_while_for_fun_multi_line_in_curly + ) } style_guide_name <- "styler::tidyverse_style@https://github.com/r-lib" From 82a71583509bd44a451a81a31330a3a5f6845048 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 10 Jan 2021 16:07:37 +0100 Subject: [PATCH 03/31] first implementation draft for touchstone --- API | 2 +- R/style-guides.R | 41 +++++++++++++++++++++++++++++++++++--- R/transform-files.R | 39 +++++++++++++++++++++++++++++++++++- man/create_style_guide.Rd | 3 ++- man/transformers_subset.Rd | 15 ++++++++++++++ 5 files changed, 94 insertions(+), 6 deletions(-) create mode 100644 man/transformers_subset.Rd diff --git a/API b/API index f95f8c1bf..fe6a4d98f 100644 --- a/API +++ b/API @@ -6,7 +6,7 @@ cache_activate(cache_name = NULL, verbose = TRUE) cache_clear(cache_name = NULL, ask = TRUE) cache_deactivate(verbose = TRUE) cache_info(cache_name = NULL, format = "both") -create_style_guide(initialize = default_style_guide_attributes, line_break = NULL, space = NULL, token = NULL, indention = NULL, use_raw_indention = FALSE, reindention = tidyverse_reindention(), style_guide_name = NULL, style_guide_version = NULL, more_specs_style_guide = NULL) +create_style_guide(initialize = default_style_guide_attributes, line_break = NULL, space = NULL, token = NULL, indention = NULL, use_raw_indention = FALSE, reindention = tidyverse_reindention(), style_guide_name = NULL, style_guide_version = NULL, more_specs_style_guide = NULL, subset_transformers = NULL) default_style_guide_attributes(pd_flat) specify_math_token_spacing(zero = "'^'", one = c("'+'", "'-'", "'*'", "'/'")) specify_reindention(regex_pattern = NULL, indention = 0, comments_only = TRUE) diff --git a/R/style-guides.R b/R/style-guides.R index aeb3140d7..bc6bcfc92 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -175,6 +175,38 @@ tidyverse_style <- function(scope = "tokens", ) } + subset_transformers <- list( + force_assignment_op = "EQ_ASSIGN", + add_line_break_after_pipe = "SPECIAL-PIPE", + wrap_if_else_while_for_fun_multi_line_in_curly = c("IF", "WHILE", "FOR", "FUNCTION"), + remove_line_breaks_in_fun_dec = "FUNCTION", + set_space_in_curly_curly = c("'{'", "'}'"), + set_space_between_eq_sub_and_comma = "EQ_SUB", + remove_space_around_colons = c("':'", "NS_GET_INT", "NS_GET"), + remove_space_after_fun_dec = "FUNCTION", + remove_space_before_dollar = "'$'", + set_space_after_bang_bang = "'!'", + remove_space_after_excl = "'!'", + style_space_around_tilde = "'~'", + add_space_after_for_if_while = c("IF", "WHILE", "FOR"), + set_line_break_around_curly_curly = "'{'", + indent_braces = c("'('", "'['", "'{'", "')'", "']'", "'}'"), + unindent_fun_dec = "FUNCTION", + indent_eq_sub = c("EQ_SUB", "EQ_FORMALS"), # TODO rename + update_indention_ref_fun_dec = "FUNCTION", + remove_space_before_closing_paren = c("')'", "']'"), + remove_space_before_opening_paren = c("'('", "'['", "LBB"), + remove_space_before_comma = "','", + style_space_around_math_token = c( + math_token_spacing$zero, + math_token_spacing$one + ), + remove_space_after_opening_paren = c("'('", "'['", "LBB"), + start_comments_with_space = "COMMENT", + remove_line_break_before_round_closing_after_curly = "'}'", + style_line_break_around_curly = "'{'" + ) + style_guide_name <- "styler::tidyverse_style@https://github.com/r-lib" create_style_guide( # transformer functions @@ -188,7 +220,8 @@ tidyverse_style <- function(scope = "tokens", reindention = reindention, style_guide_name = style_guide_name, style_guide_version = styler_version, - more_specs_style_guide = args + more_specs_style_guide = args, + subset_transformers = subset_transformers ) } @@ -257,7 +290,8 @@ create_style_guide <- function(initialize = default_style_guide_attributes, reindention = tidyverse_reindention(), style_guide_name = NULL, style_guide_version = NULL, - more_specs_style_guide = NULL) { + more_specs_style_guide = NULL, + subset_transformers = NULL) { lst( # transformer functions initialize = lst(initialize), @@ -270,7 +304,8 @@ create_style_guide <- function(initialize = default_style_guide_attributes, reindention, style_guide_name, style_guide_version, - more_specs_style_guide + more_specs_style_guide, + subset_transformers ) %>% map(compact) } diff --git a/R/transform-files.R b/R/transform-files.R index 7d266b3b9..0bc84ad0e 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -217,13 +217,18 @@ parse_transform_serialize_r <- function(text, text <- assert_text(text) pd_nested <- compute_parse_data_nested(text, transformers, more_specs) - blank_lines_to_next_expr <- find_blank_lines_to_next_block(pd_nested) if (nrow(pd_nested) == 0) { if (warn_empty) { warn("Text to style did not contain any tokens. Returning empty string.") } return("") } + transformers <- transformers_subset( + pd_nested$text[!pd_nested$is_cached], + transformers + ) + blank_lines_to_next_expr <- find_blank_lines_to_next_block(pd_nested) + text_out <- pd_nested %>% split(pd_nested$block) %>% @@ -245,6 +250,38 @@ parse_transform_serialize_r <- function(text, text_out } +transformers_subset_impl <- function(x, token) { + if (!any(x %in% token)) { + x + } +} + +#' Remove transformers that are not needed +#' For every transformer, at least one token must be given to make subsetting. +#' active. +transformers_subset <- function(text, transformers) { + is_colon <- text == ";" + if (any(is_colon)) { + # ; can only be parsed when on the same line as other token, not the case + # here since text is output of compute_parse_data_nested. + text <- c(text[!is_colon], "1;") + } + token <- unique(tokenize(text)$token) + to_remove <- purrr::map( + transformers$subset_transformers, + transformers_subset_impl, token + ) %>% + compact() %>% # ise imap, return names directly, save compact() + names() + if (length(to_remove) > 0) { + for (scope in c("initialize", "line_break", "space", "token", "indention")) { + transformers[[scope]][to_remove] <- NULL + transformers[[scope]] <- purrr::compact(transformers[[scope]]) + } + } + transformers +} + #' Apply transformers to a parse table #' #' The column `multi_line` is updated (after the line break information is diff --git a/man/create_style_guide.Rd b/man/create_style_guide.Rd index bb07f00e3..2c4d5d842 100644 --- a/man/create_style_guide.Rd +++ b/man/create_style_guide.Rd @@ -14,7 +14,8 @@ create_style_guide( reindention = tidyverse_reindention(), style_guide_name = NULL, style_guide_version = NULL, - more_specs_style_guide = NULL + more_specs_style_guide = NULL, + subset_transformers = NULL ) } \arguments{ diff --git a/man/transformers_subset.Rd b/man/transformers_subset.Rd new file mode 100644 index 000000000..07e2a3767 --- /dev/null +++ b/man/transformers_subset.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform-files.R +\name{transformers_subset} +\alias{transformers_subset} +\title{Remove transformers that are not needed +For every transformer, at least one token must be given to make subsetting. +active.} +\usage{ +transformers_subset(text, transformers) +} +\description{ +Remove transformers that are not needed +For every transformer, at least one token must be given to make subsetting. +active. +} From 1fd7d80d59336a338e0f393a04a7d130991ff3d9 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 10 Jan 2021 22:46:11 +0100 Subject: [PATCH 04/31] use more elegant approach with reduce and some tests --- R/style-guides.R | 70 ++++++++++++++--------- R/transform-files.R | 43 ++++++++------ inst/WORDLIST | 2 + man/transformers_subset.Rd | 15 +++-- man/transformers_subset_impl.Rd | 22 +++++++ tests/testthat/test-transformers-subset.R | 69 ++++++++++++++++++++++ 6 files changed, 173 insertions(+), 48 deletions(-) create mode 100644 man/transformers_subset_impl.Rd create mode 100644 tests/testthat/test-transformers-subset.R diff --git a/R/style-guides.R b/R/style-guides.R index bc6bcfc92..472e17774 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -176,35 +176,49 @@ tidyverse_style <- function(scope = "tokens", } subset_transformers <- list( - force_assignment_op = "EQ_ASSIGN", - add_line_break_after_pipe = "SPECIAL-PIPE", - wrap_if_else_while_for_fun_multi_line_in_curly = c("IF", "WHILE", "FOR", "FUNCTION"), - remove_line_breaks_in_fun_dec = "FUNCTION", - set_space_in_curly_curly = c("'{'", "'}'"), - set_space_between_eq_sub_and_comma = "EQ_SUB", - remove_space_around_colons = c("':'", "NS_GET_INT", "NS_GET"), - remove_space_after_fun_dec = "FUNCTION", - remove_space_before_dollar = "'$'", - set_space_after_bang_bang = "'!'", - remove_space_after_excl = "'!'", - style_space_around_tilde = "'~'", - add_space_after_for_if_while = c("IF", "WHILE", "FOR"), - set_line_break_around_curly_curly = "'{'", - indent_braces = c("'('", "'['", "'{'", "')'", "']'", "'}'"), - unindent_fun_dec = "FUNCTION", - indent_eq_sub = c("EQ_SUB", "EQ_FORMALS"), # TODO rename - update_indention_ref_fun_dec = "FUNCTION", - remove_space_before_closing_paren = c("')'", "']'"), - remove_space_before_opening_paren = c("'('", "'['", "LBB"), - remove_space_before_comma = "','", - style_space_around_math_token = c( - math_token_spacing$zero, - math_token_spacing$one + token = list( + resolve_semicolon = "';'", + add_brackets_in_pipe = "SPECIAL-PIPE", + force_assignment_op = c("token" = "EQ_ASSIGN"), + wrap_if_else_while_for_fun_multi_line_in_curly = c("IF", "WHILE", "FOR", "FUNCTION") ), - remove_space_after_opening_paren = c("'('", "'['", "LBB"), - start_comments_with_space = "COMMENT", - remove_line_break_before_round_closing_after_curly = "'}'", - style_line_break_around_curly = "'{'" + line_break = list( + set_line_break_before_curly_opening = "'{'", + remove_line_break_before_round_closing_after_curly = "'}'", + remove_line_breaks_in_fun_dec = "FUNCTION", + set_line_break_around_curly_curly = "'{'", + style_line_break_around_curly = "'{'", + add_line_break_after_pipe = "SPECIAL-PIPE" + ), + space = list( + remove_space_before_closing_paren = c("')'", "']'"), + remove_space_before_opening_paren = c("'('", "'['", "LBB"), + add_space_after_for_if_while = c("IF", "WHILE", "FOR"), + add_space_before_brace = "'{'", + remove_space_before_comma = "','", + set_space_between_eq_sub_and_comma = "EQ_SUB", + style_space_around_math_token = c( + math_token_spacing$zero, + math_token_spacing$one + ), + style_space_around_tilde = "'~'", + remove_space_after_opening_paren = c("'('", "'['", "LBB"), + remove_space_after_excl = "'!'", + set_space_after_bang_bang = "'!'", + remove_space_before_dollar = "'$'", + remove_space_after_fun_dec = "FUNCTION", + remove_space_around_colons = c("':'", "NS_GET_INT", "NS_GET"), + start_comments_with_space = "COMMENT", + remove_space_after_unary_pm_nested = c("'+'", "'-'"), + spacing_before_comments = "COMMENT", + set_space_in_curly_curly = c("'{'", "'}'") + ), + indent = list( + indent_braces = c("'('", "'['", "'{'", "')'", "']'", "'}'"), + unindent_fun_dec = "FUNCTION", + indent_eq_sub = c("EQ_SUB", "EQ_FORMALS"), # TODO rename + update_indention_ref_fun_dec = "FUNCTION" + ) ) style_guide_name <- "styler::tidyverse_style@https://github.com/r-lib" diff --git a/R/transform-files.R b/R/transform-files.R index 0bc84ad0e..4ee7bd883 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -250,15 +250,34 @@ parse_transform_serialize_r <- function(text, text_out } -transformers_subset_impl <- function(x, token) { - if (!any(x %in% token)) { - x +#' Removes the transformers if tokens in x +#' @param transformers The style full style guide, i.e. the result of +#' [create_style_guide()]. +#' @param token Named character vector: Names are rules and values are the token +#' that trigger are required to be absent to trigger a removal. +#' @param scope The low-level scope, e.g. 'token'. +#' @param code tokenized code for which we check if `token` is in them. +transformers_subset_impl <- function(transformers, token, scope, code) { + transformer_names <- names(token) + for (i in seq_along(token)) { + if (!any(token[i] %in% code)) { + transformers[[scope]][[transformer_names[i]]] <- NULL + } } + transformers } #' Remove transformers that are not needed +#' #' For every transformer, at least one token must be given to make subsetting. #' active. +#' @param text Text to parse. Can also be the column `text` of the output of +#' [compute_parse_data_nested()], where each element is a token (instead of a +#' line). +#' @return +#' Returns `transformers`, but stripped away those rules that are not used when +#' styling `text`. +#' @keywords internal transformers_subset <- function(text, transformers) { is_colon <- text == ";" if (any(is_colon)) { @@ -266,20 +285,12 @@ transformers_subset <- function(text, transformers) { # here since text is output of compute_parse_data_nested. text <- c(text[!is_colon], "1;") } - token <- unique(tokenize(text)$token) - to_remove <- purrr::map( + purrr::reduce2( transformers$subset_transformers, - transformers_subset_impl, token - ) %>% - compact() %>% # ise imap, return names directly, save compact() - names() - if (length(to_remove) > 0) { - for (scope in c("initialize", "line_break", "space", "token", "indention")) { - transformers[[scope]][to_remove] <- NULL - transformers[[scope]] <- purrr::compact(transformers[[scope]]) - } - } - transformers + names(transformers$subset_transformers), + transformers_subset_impl, unique(tokenize(text)$token), + .init = transformers + ) } #' Apply transformers to a parse table diff --git a/inst/WORDLIST b/inst/WORDLIST index ab4a2eb79..9fcb604ce 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -68,6 +68,7 @@ href http https icloud +impl infinitively initializer innode @@ -192,6 +193,7 @@ tidyeval tidyr tidyverse Tidyverse +tokenized travis tryCatch tryGugus diff --git a/man/transformers_subset.Rd b/man/transformers_subset.Rd index 07e2a3767..064718815 100644 --- a/man/transformers_subset.Rd +++ b/man/transformers_subset.Rd @@ -2,14 +2,21 @@ % Please edit documentation in R/transform-files.R \name{transformers_subset} \alias{transformers_subset} -\title{Remove transformers that are not needed -For every transformer, at least one token must be given to make subsetting. -active.} +\title{Remove transformers that are not needed} \usage{ transformers_subset(text, transformers) } +\arguments{ +\item{text}{Text to parse. Can also be the column \code{text} of the output of +\code{\link[=compute_parse_data_nested]{compute_parse_data_nested()}}, where each element is a token (instead of a +line).} +} +\value{ +Returns \code{transformers}, but stripped away those rules that are not used when +styling \code{text}. +} \description{ -Remove transformers that are not needed For every transformer, at least one token must be given to make subsetting. active. } +\keyword{internal} diff --git a/man/transformers_subset_impl.Rd b/man/transformers_subset_impl.Rd new file mode 100644 index 000000000..e43a2bc41 --- /dev/null +++ b/man/transformers_subset_impl.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/transform-files.R +\name{transformers_subset_impl} +\alias{transformers_subset_impl} +\title{Removes the transformers if tokens in x} +\usage{ +transformers_subset_impl(transformers, token, scope, code) +} +\arguments{ +\item{transformers}{The style full style guide, i.e. the result of +\code{\link[=create_style_guide]{create_style_guide()}}.} + +\item{token}{Named character vector: Names are rules and values are the token +that trigger are required to be absent to trigger a removal.} + +\item{scope}{The low-level scope, e.g. 'token'.} + +\item{code}{tokenized code for which we check if \code{token} is in them.} +} +\description{ +Removes the transformers if tokens in x +} diff --git a/tests/testthat/test-transformers-subset.R b/tests/testthat/test-transformers-subset.R new file mode 100644 index 000000000..c78044fd1 --- /dev/null +++ b/tests/testthat/test-transformers-subset.R @@ -0,0 +1,69 @@ +# c/cp from remove_space_after_excl but for self-containement repeated +remove_space_after_excl_ <- function(pd_flat) { + excl <- (pd_flat$token == "'!'") & + (pd_flat$token_after != "'!'") & + (pd_flat$newlines == 0L) + pd_flat$spaces[excl] <- 0L + pd_flat +} + +t <- create_style_guide( + space = lst(remove_space_after_excl_), + subset_transformers = list(space = list(remove_space_after_excl_ = c("'!'"))), +) + +t_no_subset <- create_style_guide( + space = lst(remove_space_after_excl_), + subset_transformers = NULL, +) + +t_empty_subset1 <- create_style_guide( + space = lst(remove_space_after_excl_), + subset_transformers = list(space = list()), +) + +t_empty_subset2 <- create_style_guide( + space = lst(remove_space_after_excl_), + subset_transformers = list(), +) + +test_that("transformers are not removed if they are used", { + t_new <- transformers_subset( + "!x", t + ) + expect_equal(t_new, t) +}) + +test_that("transformers are removed if they are unused", { + t_fun <- transformers_subset( + "x", t + ) + t_manual <- t + t_manual$space$remove_space_after_excl_ <- NULL + expect_equal(t_fun, t_manual) +}) + + +test_that("if no subset_transformers is specified, no transformer is removed and no error issued", { + t_fun <- transformers_subset( + "x", t_no_subset + ) + expect_equal(t_fun, t_no_subset) + + t_fun <- transformers_subset( + "x", t_empty_subset1 + ) + expect_equal(t_fun, t_empty_subset1) + + t_fun <- transformers_subset( + "x", t_empty_subset2 + ) + expect_equal(t_fun, t_empty_subset2) +}) + +test_that('semi-colon is parsed without error', { + expect_equal( + transformers_subset(c("a", ";", "b"), t_fun), + t_fun + ) +}) From 6d08838899693b8f5b45ebaa9e9e973c9b875cd5 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 10 Jan 2021 23:24:11 +0100 Subject: [PATCH 05/31] fix tests --- R/transform-files.R | 2 +- tests/testthat/test-transformers-subset.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/transform-files.R b/R/transform-files.R index 4ee7bd883..744ed082a 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -260,7 +260,7 @@ parse_transform_serialize_r <- function(text, transformers_subset_impl <- function(transformers, token, scope, code) { transformer_names <- names(token) for (i in seq_along(token)) { - if (!any(token[i] %in% code)) { + if (!any(token[[i]] %in% code)) { transformers[[scope]][[transformer_names[i]]] <- NULL } } diff --git a/tests/testthat/test-transformers-subset.R b/tests/testthat/test-transformers-subset.R index c78044fd1..46eb50d45 100644 --- a/tests/testthat/test-transformers-subset.R +++ b/tests/testthat/test-transformers-subset.R @@ -63,7 +63,7 @@ test_that("if no subset_transformers is specified, no transformer is removed and test_that('semi-colon is parsed without error', { expect_equal( - transformers_subset(c("a", ";", "b"), t_fun), - t_fun + transformers_subset(c("!a", ";", "b"), t), + t ) }) From d3c90bdea3832f3115c1c374a9afeaba743fbce0 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Mon, 11 Jan 2021 21:53:55 +0100 Subject: [PATCH 06/31] replace loop with walk for speed --- NAMESPACE | 1 + R/transform-files.R | 5 +++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 67f3fcd43..e67c8699a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -35,6 +35,7 @@ importFrom(purrr,map_lgl) importFrom(purrr,partial) importFrom(purrr,pmap) importFrom(purrr,pwalk) +importFrom(purrr,walk) importFrom(purrr,when) importFrom(rlang,abort) importFrom(rlang,is_empty) diff --git a/R/transform-files.R b/R/transform-files.R index 744ed082a..b37275f08 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -257,13 +257,14 @@ parse_transform_serialize_r <- function(text, #' that trigger are required to be absent to trigger a removal. #' @param scope The low-level scope, e.g. 'token'. #' @param code tokenized code for which we check if `token` is in them. +#' @importFrom purrr walk transformers_subset_impl <- function(transformers, token, scope, code) { transformer_names <- names(token) - for (i in seq_along(token)) { + walk(seq_along(token), function(i) { if (!any(token[[i]] %in% code)) { transformers[[scope]][[transformer_names[i]]] <- NULL } - } + }) transformers } From 48f53a361db4ca3d00a3f9c0cbbc09d49f57904e Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sat, 23 Jan 2021 21:45:07 +0100 Subject: [PATCH 07/31] more extensive tests for old style guides --- tests/testthat/test-transformers-subset.R | 32 +++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/tests/testthat/test-transformers-subset.R b/tests/testthat/test-transformers-subset.R index 46eb50d45..bdf3faa99 100644 --- a/tests/testthat/test-transformers-subset.R +++ b/tests/testthat/test-transformers-subset.R @@ -10,6 +10,8 @@ remove_space_after_excl_ <- function(pd_flat) { t <- create_style_guide( space = lst(remove_space_after_excl_), subset_transformers = list(space = list(remove_space_after_excl_ = c("'!'"))), + style_guide_name = "styler::t@https://github.com/r-lib", + style_guide_version = as.character(packageVersion("styler")) ) t_no_subset <- create_style_guide( @@ -67,3 +69,33 @@ test_that('semi-colon is parsed without error', { t ) }) + + +test_that('can handle old style guide without transformer object', { + t_new <- t + t_new$subset_transformers <- NULL + expect_error( + transformers_subset(c("!a", ";", "b"), t_new), + NA + ) + expect_error( + style_text('1;3', transformers = t_new), + NA + ) +}) + +test_that("can handle default", { + t_no_subset <- create_style_guide( + space = lst(remove_space_after_excl_), + style_guide_name = "styler::t@https://github.com/r-lib", + style_guide_version = as.character(packageVersion("styler")) + ) + expect_error( + transformers_subset(c("!a", ";", "b"), t_no_subset), + NA + ) + expect_error( + style_text('a =2 ', transformers = t_new), + NA + ) +}) From 4c1f95a71aa44b1cb382dbb84d09a877a46e25cb Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sat, 23 Jan 2021 21:53:59 +0100 Subject: [PATCH 08/31] resolve with simple for loop --- NAMESPACE | 1 - R/style-guides.R | 4 +++ R/transform-files.R | 43 ++++++++++++--------------------- man/create_style_guide.Rd | 5 ++++ man/transformers_subset.Rd | 12 ++++----- man/transformers_subset_impl.Rd | 22 ----------------- 6 files changed, 30 insertions(+), 57 deletions(-) delete mode 100644 man/transformers_subset_impl.Rd diff --git a/NAMESPACE b/NAMESPACE index e67c8699a..67f3fcd43 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -35,7 +35,6 @@ importFrom(purrr,map_lgl) importFrom(purrr,partial) importFrom(purrr,pmap) importFrom(purrr,pwalk) -importFrom(purrr,walk) importFrom(purrr,when) importFrom(rlang,abort) importFrom(rlang,is_empty) diff --git a/R/style-guides.R b/R/style-guides.R index 472e17774..2cca5a571 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -278,6 +278,10 @@ tidyverse_style <- function(scope = "tokens", #' they will yield generic code and we loose the specific value of `arg` (see #' [styler::cache_make_key()]), even when unquoting these inputs with `!!` #' beforehand in `purrr::partial()`. +#' @param subset_transformers A list specifying under which conditions +#' transformer functions can be dropped since they have no effect on the +#' code to format. This is argument experimental and may change in future +#' releases without prior notification. #' @examples #' set_line_break_before_curly_opening <- function(pd_flat) { #' op <- pd_flat$token %in% "'{'" diff --git a/R/transform-files.R b/R/transform-files.R index b37275f08..11ca58133 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -250,34 +250,17 @@ parse_transform_serialize_r <- function(text, text_out } -#' Removes the transformers if tokens in x -#' @param transformers The style full style guide, i.e. the result of -#' [create_style_guide()]. -#' @param token Named character vector: Names are rules and values are the token -#' that trigger are required to be absent to trigger a removal. -#' @param scope The low-level scope, e.g. 'token'. -#' @param code tokenized code for which we check if `token` is in them. -#' @importFrom purrr walk -transformers_subset_impl <- function(transformers, token, scope, code) { - transformer_names <- names(token) - walk(seq_along(token), function(i) { - if (!any(token[[i]] %in% code)) { - transformers[[scope]][[transformer_names[i]]] <- NULL - } - }) - transformers -} #' Remove transformers that are not needed #' -#' For every transformer, at least one token must be given to make subsetting. -#' active. +#' The goal is to speed up styling by removing all rules that are only +#' applicable in contexts that don't occur often, e.g. for most code, we don't +#' expect ";" to be in it, so we don't need to apply [resolve_semicolon()] on +#' every *nest*. #' @param text Text to parse. Can also be the column `text` of the output of #' [compute_parse_data_nested()], where each element is a token (instead of a #' line). -#' @return -#' Returns `transformers`, but stripped away those rules that are not used when -#' styling `text`. +#' @param transformers the transformers. #' @keywords internal transformers_subset <- function(text, transformers) { is_colon <- text == ";" @@ -286,12 +269,16 @@ transformers_subset <- function(text, transformers) { # here since text is output of compute_parse_data_nested. text <- c(text[!is_colon], "1;") } - purrr::reduce2( - transformers$subset_transformers, - names(transformers$subset_transformers), - transformers_subset_impl, unique(tokenize(text)$token), - .init = transformers - ) + token <- unique(tokenize(text)$token) + for (scope in c("line_break", "space", "token", "indention")) { + rules <- transformers$subset_transformers[[scope]] + for (rule in names(rules)) { + if (!any(rules[[rule]] %in% token)) { + transformers[[scope]][rule] <- NULL + } + } + } + transformers } #' Apply transformers to a parse table diff --git a/man/create_style_guide.Rd b/man/create_style_guide.Rd index 2c4d5d842..f14165696 100644 --- a/man/create_style_guide.Rd +++ b/man/create_style_guide.Rd @@ -56,6 +56,11 @@ such functions are converted to characters in \code{\link[=cache_make_key]{cache they will yield generic code and we loose the specific value of \code{arg} (see \code{\link[=cache_make_key]{cache_make_key()}}), even when unquoting these inputs with \verb{!!} beforehand in \code{purrr::partial()}.} + +\item{subset_transformers}{A list specifying under which conditions +transformer functions can be dropped since they have no effect on the +code to format. This is argument experimental and may change in future +releases without prior notification.} } \description{ This is a helper function to create a style guide, which is technically diff --git a/man/transformers_subset.Rd b/man/transformers_subset.Rd index 064718815..4652cc1e6 100644 --- a/man/transformers_subset.Rd +++ b/man/transformers_subset.Rd @@ -10,13 +10,13 @@ transformers_subset(text, transformers) \item{text}{Text to parse. Can also be the column \code{text} of the output of \code{\link[=compute_parse_data_nested]{compute_parse_data_nested()}}, where each element is a token (instead of a line).} -} -\value{ -Returns \code{transformers}, but stripped away those rules that are not used when -styling \code{text}. + +\item{transformers}{the transformers.} } \description{ -For every transformer, at least one token must be given to make subsetting. -active. +The goal is to speed up styling by removing all rules that are only +applicable in contexts that don't occur often, e.g. for most code, we don't +expect ";" to be in it, so we don't need to apply \code{\link[=resolve_semicolon]{resolve_semicolon()}} on +every \emph{nest}. } \keyword{internal} diff --git a/man/transformers_subset_impl.Rd b/man/transformers_subset_impl.Rd deleted file mode 100644 index e43a2bc41..000000000 --- a/man/transformers_subset_impl.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/transform-files.R -\name{transformers_subset_impl} -\alias{transformers_subset_impl} -\title{Removes the transformers if tokens in x} -\usage{ -transformers_subset_impl(transformers, token, scope, code) -} -\arguments{ -\item{transformers}{The style full style guide, i.e. the result of -\code{\link[=create_style_guide]{create_style_guide()}}.} - -\item{token}{Named character vector: Names are rules and values are the token -that trigger are required to be absent to trigger a removal.} - -\item{scope}{The low-level scope, e.g. 'token'.} - -\item{code}{tokenized code for which we check if \code{token} is in them.} -} -\description{ -Removes the transformers if tokens in x -} From 04c609c255aafc4858e3dabc3263aab448246d2e Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sat, 23 Jan 2021 22:03:43 +0100 Subject: [PATCH 09/31] fix test --- tests/testthat/test-transformers-subset.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-transformers-subset.R b/tests/testthat/test-transformers-subset.R index bdf3faa99..c0ad9e212 100644 --- a/tests/testthat/test-transformers-subset.R +++ b/tests/testthat/test-transformers-subset.R @@ -95,7 +95,7 @@ test_that("can handle default", { NA ) expect_error( - style_text('a =2 ', transformers = t_new), + style_text('a =2 ', transformers = t_no_subset), NA ) }) From 781f7964eee0dc9b54e522e63f0ef61290085550 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sat, 23 Jan 2021 22:16:08 +0100 Subject: [PATCH 10/31] fix R cmd check --- .Rbuildignore | 6 ++---- R/transform-files.R | 2 +- man/transformers_subset.Rd | 2 +- 3 files changed, 4 insertions(+), 6 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index e45fa7c85..8bffc965b 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -5,10 +5,8 @@ ^API$ ^README\.Rmd$ ^README-.*\.png$ -^.travis.yml ^appveyor\.yml$ ^tic\.R$ -^\.travis\.yml$ ^docs$ ^_pkgdown\.yml$ CONTRIBUTING.md @@ -20,5 +18,5 @@ revdep ^\.pre-commit-config\.yaml$ ^brew\-log$ ^\.github/$ -^touchstone/$ -^.github/$ +^touchstone$ +^\.github$ diff --git a/R/transform-files.R b/R/transform-files.R index 11ca58133..fefd808f1 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -255,7 +255,7 @@ parse_transform_serialize_r <- function(text, #' #' The goal is to speed up styling by removing all rules that are only #' applicable in contexts that don't occur often, e.g. for most code, we don't -#' expect ";" to be in it, so we don't need to apply [resolve_semicolon()] on +#' expect ";" to be in it, so we don't need to apply `resolve_semicolon()` on #' every *nest*. #' @param text Text to parse. Can also be the column `text` of the output of #' [compute_parse_data_nested()], where each element is a token (instead of a diff --git a/man/transformers_subset.Rd b/man/transformers_subset.Rd index 4652cc1e6..7cbabf850 100644 --- a/man/transformers_subset.Rd +++ b/man/transformers_subset.Rd @@ -16,7 +16,7 @@ line).} \description{ The goal is to speed up styling by removing all rules that are only applicable in contexts that don't occur often, e.g. for most code, we don't -expect ";" to be in it, so we don't need to apply \code{\link[=resolve_semicolon]{resolve_semicolon()}} on +expect ";" to be in it, so we don't need to apply \code{resolve_semicolon()} on every \emph{nest}. } \keyword{internal} From 9c4fc1eda8bcc0e56f88537e21cd93dafa35919f Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sat, 23 Jan 2021 23:40:09 +0100 Subject: [PATCH 11/31] make things work for R < 3.6 --- R/style-guides.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/style-guides.R b/R/style-guides.R index 2cca5a571..4ed1c6dc8 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -179,7 +179,11 @@ tidyverse_style <- function(scope = "tokens", token = list( resolve_semicolon = "';'", add_brackets_in_pipe = "SPECIAL-PIPE", - force_assignment_op = c("token" = "EQ_ASSIGN"), + # before 3.6, these assignments are not wrapped into top level expression + # and `text` supplied to transformer_subset() is "", so it appears to not + # contain EQ_ASSIGN, and the transformer is falsely removed. + # compute_parse_data_nested / text_to_flat_pd ('a = 4') + if (getRversion() >= 3.6) force_assignment_op <- "EQ_ASSIGN", wrap_if_else_while_for_fun_multi_line_in_curly = c("IF", "WHILE", "FOR", "FUNCTION") ), line_break = list( From f71deaea9e9fa03c81ccc94c56a11d80a132b7a7 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sat, 23 Jan 2021 23:51:22 +0100 Subject: [PATCH 12/31] boost by fix typo and remove indention too --- R/style-guides.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/style-guides.R b/R/style-guides.R index 4ed1c6dc8..50263e9c5 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -157,7 +157,7 @@ tidyverse_style <- function(scope = "tokens", except_token_before = "COMMENT" ) }, - purrr::partial(remove_line_break_in_fun_call, strict = strict), + remove_line_break_in_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 ) @@ -217,7 +217,7 @@ tidyverse_style <- function(scope = "tokens", spacing_before_comments = "COMMENT", set_space_in_curly_curly = c("'{'", "'}'") ), - indent = list( + indention = list( indent_braces = c("'('", "'['", "'{'", "')'", "']'", "'}'"), unindent_fun_dec = "FUNCTION", indent_eq_sub = c("EQ_SUB", "EQ_FORMALS"), # TODO rename From 5523a8f1b20c8b26d06dc187d5556cf2abdd1c67 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 24 Jan 2021 00:21:05 +0100 Subject: [PATCH 13/31] another hack for old R versions --- R/transform-files.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/transform-files.R b/R/transform-files.R index fefd808f1..7f84d348d 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -224,7 +224,7 @@ parse_transform_serialize_r <- function(text, return("") } transformers <- transformers_subset( - pd_nested$text[!pd_nested$is_cached], + ifelse(getRversion() < 3.4, text, pd_nested$text[!pd_nested$is_cached]), transformers ) blank_lines_to_next_expr <- find_blank_lines_to_next_block(pd_nested) From 35976ef7c8adcdab7e15a2ae7231c35e6cfecc23 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 24 Jan 2021 00:44:48 +0100 Subject: [PATCH 14/31] if over ifelse --- R/transform-files.R | 72 ++++++++++++++++++++++----------------------- 1 file changed, 36 insertions(+), 36 deletions(-) diff --git a/R/transform-files.R b/R/transform-files.R index 7f84d348d..f8804efc5 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -208,46 +208,46 @@ split_roxygen_segments <- function(text, roxygen_examples) { #' @importFrom rlang abort #' @keywords internal parse_transform_serialize_r <- function(text, - transformers, - base_indention, - warn_empty = TRUE) { - more_specs <- cache_more_specs( - include_roxygen_examples = TRUE, base_indention = base_indention - ) +transformers, +base_indention, +warn_empty = TRUE) { +more_specs <- cache_more_specs( +include_roxygen_examples = TRUE, base_indention = base_indention +) - text <- assert_text(text) - pd_nested <- compute_parse_data_nested(text, transformers, more_specs) - if (nrow(pd_nested) == 0) { - if (warn_empty) { - warn("Text to style did not contain any tokens. Returning empty string.") - } - return("") - } - transformers <- transformers_subset( - ifelse(getRversion() < 3.4, text, pd_nested$text[!pd_nested$is_cached]), - transformers - ) - blank_lines_to_next_expr <- find_blank_lines_to_next_block(pd_nested) +text <- assert_text(text) +pd_nested <- compute_parse_data_nested(text, transformers, more_specs) +if (nrow(pd_nested) == 0) { +if (warn_empty) { +warn("Text to style did not contain any tokens. Returning empty string.") +} +return("") +} +transformers <- transformers_subset( +if(getRversion() < 3.4) text else pd_nested$text[!pd_nested$is_cached], +transformers +) +blank_lines_to_next_expr <- find_blank_lines_to_next_block(pd_nested) - text_out <- pd_nested %>% - split(pd_nested$block) %>% - unname() %>% - map2(blank_lines_to_next_expr, - parse_transform_serialize_r_block, - transformers = transformers, - base_indention = base_indention - ) %>% - unlist() +text_out <- pd_nested %>% + split(pd_nested$block) %>% + unname() %>% + map2(blank_lines_to_next_expr, + parse_transform_serialize_r_block, + transformers = transformers, + base_indention = base_indention + ) %>% + unlist() - if (can_verify_roundtrip(transformers)) { - verify_roundtrip(text, text_out) - } - text_out <- convert_newlines_to_linebreaks(text_out) - if (cache_is_activated()) { - cache_by_expression(text_out, transformers, more_specs = more_specs) - } - text_out +if (can_verify_roundtrip(transformers)) { +verify_roundtrip(text, text_out) +} +text_out <- convert_newlines_to_linebreaks(text_out) +if (cache_is_activated()) { +cache_by_expression(text_out, transformers, more_specs = more_specs) +} +text_out } From 258b677df4562db5f02292c0e01c4111bdaec5dd Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 24 Jan 2021 01:07:14 +0100 Subject: [PATCH 15/31] back to normal formatting --- R/transform-files.R | 73 +++++++++++++++++++++++---------------------- 1 file changed, 37 insertions(+), 36 deletions(-) diff --git a/R/transform-files.R b/R/transform-files.R index f8804efc5..c4713eb5b 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -169,6 +169,7 @@ parse_transform_serialize_roxygen <- function(text, transformers, base_indention flatten_chr() } + #' Split text into roxygen and non-roxygen example segments #' #' @param text Roxygen comments @@ -208,46 +209,46 @@ split_roxygen_segments <- function(text, roxygen_examples) { #' @importFrom rlang abort #' @keywords internal parse_transform_serialize_r <- function(text, -transformers, -base_indention, -warn_empty = TRUE) { -more_specs <- cache_more_specs( -include_roxygen_examples = TRUE, base_indention = base_indention -) + transformers, + base_indention, + warn_empty = TRUE) { + more_specs <- cache_more_specs( + include_roxygen_examples = TRUE, base_indention = base_indention + ) -text <- assert_text(text) -pd_nested <- compute_parse_data_nested(text, transformers, more_specs) -if (nrow(pd_nested) == 0) { -if (warn_empty) { -warn("Text to style did not contain any tokens. Returning empty string.") -} -return("") -} -transformers <- transformers_subset( -if(getRversion() < 3.4) text else pd_nested$text[!pd_nested$is_cached], -transformers -) -blank_lines_to_next_expr <- find_blank_lines_to_next_block(pd_nested) + text <- assert_text(text) + pd_nested <- compute_parse_data_nested(text, transformers, more_specs) + if (nrow(pd_nested) == 0) { + if (warn_empty) { + warn("Text to style did not contain any tokens. Returning empty string.") + } + return("") + } + transformers <- transformers_subset( + if (getRversion() < 3.4) text else pd_nested$text[!pd_nested$is_cached], + transformers + ) + blank_lines_to_next_expr <- find_blank_lines_to_next_block(pd_nested) -text_out <- pd_nested %>% - split(pd_nested$block) %>% - unname() %>% - map2(blank_lines_to_next_expr, - parse_transform_serialize_r_block, - transformers = transformers, - base_indention = base_indention - ) %>% - unlist() + text_out <- pd_nested %>% + split(pd_nested$block) %>% + unname() %>% + map2(blank_lines_to_next_expr, + parse_transform_serialize_r_block, + transformers = transformers, + base_indention = base_indention + ) %>% + unlist() -if (can_verify_roundtrip(transformers)) { -verify_roundtrip(text, text_out) -} -text_out <- convert_newlines_to_linebreaks(text_out) -if (cache_is_activated()) { -cache_by_expression(text_out, transformers, more_specs = more_specs) -} -text_out + if (can_verify_roundtrip(transformers)) { + verify_roundtrip(text, text_out) + } + text_out <- convert_newlines_to_linebreaks(text_out) + if (cache_is_activated()) { + cache_by_expression(text_out, transformers, more_specs = more_specs) + } + text_out } From fd4440c2e8c5b3d7adfdfee70d98f9a86fba7440 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 24 Jan 2021 01:15:37 +0100 Subject: [PATCH 16/31] save another assignment --- R/transform-files.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/transform-files.R b/R/transform-files.R index c4713eb5b..b2e884bd1 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -228,13 +228,11 @@ parse_transform_serialize_r <- function(text, if (getRversion() < 3.4) text else pd_nested$text[!pd_nested$is_cached], transformers ) - blank_lines_to_next_expr <- find_blank_lines_to_next_block(pd_nested) - text_out <- pd_nested %>% split(pd_nested$block) %>% unname() %>% - map2(blank_lines_to_next_expr, + map2(find_blank_lines_to_next_block(pd_nested), parse_transform_serialize_r_block, transformers = transformers, base_indention = base_indention From 21b1f2a0671d63752f75b5940b9850d2ce7db657 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 24 Jan 2021 01:22:58 +0100 Subject: [PATCH 17/31] remove apparently useless rule --- R/rules-spaces.R | 14 -------------- R/style-guides.R | 2 -- 2 files changed, 16 deletions(-) diff --git a/R/rules-spaces.R b/R/rules-spaces.R index 7c6b7ed12..72f53da72 100644 --- a/R/rules-spaces.R +++ b/R/rules-spaces.R @@ -185,20 +185,6 @@ set_space_in_curly_curly <- function(pd) { pd } -add_space_before_brace <- function(pd_flat) { - # TODO remove this, it has no effect since { can only appear in the first - # position of the nest and taking lead(op_after, default = FALSE) will always - # yield a vector of FALSE only. - op_after <- pd_flat$token %in% "'{'" - if (!any(op_after)) { - return(pd_flat) - } - op_before <- lead(op_after, default = FALSE) - idx_before <- op_before & (pd_flat$newlines == 0L) & pd_flat$token != "'('" - pd_flat$spaces[idx_before] <- pmax(pd_flat$spaces[idx_before], 1L) - pd_flat -} - add_space_after_comma <- function(pd_flat) { comma_after <- (pd_flat$token == "','") & (pd_flat$newlines == 0L) pd_flat$spaces[comma_after] <- pmax(pd_flat$spaces[comma_after], 1L) diff --git a/R/style-guides.R b/R/style-guides.R index 50263e9c5..2d4d23f16 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -91,7 +91,6 @@ tidyverse_style <- function(scope = "tokens", remove_space_before_closing_paren, remove_space_before_opening_paren = if (strict) remove_space_before_opening_paren, add_space_after_for_if_while, - add_space_before_brace, remove_space_before_comma, style_space_around_math_token = partial( style_space_around_math_token, strict, @@ -199,7 +198,6 @@ tidyverse_style <- function(scope = "tokens", remove_space_before_opening_paren = c("'('", "'['", "LBB"), add_space_after_for_if_while = c("IF", "WHILE", "FOR"), add_space_before_brace = "'{'", - remove_space_before_comma = "','", set_space_between_eq_sub_and_comma = "EQ_SUB", style_space_around_math_token = c( math_token_spacing$zero, From 4e7d97f4b5ec5e88989aee9765878d3dde8c598f Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 24 Jan 2021 01:37:13 +0100 Subject: [PATCH 18/31] get rid of condition that always hold --- R/style-guides.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/style-guides.R b/R/style-guides.R index 2d4d23f16..f0c9c53fa 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -82,8 +82,7 @@ tidyverse_style <- function(scope = "tokens", indent_without_paren = partial(indent_without_paren, indent_by = indent_by ), - update_indention_ref_fun_dec = - if ("indention" %in% scope) update_indention_ref_fun_dec + update_indention_ref_fun_dec = update_indention_ref_fun_dec ) } space_manipulators <- if ("spaces" %in% scope) { From 1b5498ea54db3b26f4a8558c48008976c3c2c2bf Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 24 Jan 2021 12:11:47 +0100 Subject: [PATCH 19/31] deactivate removal for some very common operators they will almost allways be present unless the expression is like 1+1 which is pretty quick to style anyways --- R/style-guides.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/style-guides.R b/R/style-guides.R index f0c9c53fa..ebfeee0c8 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -193,8 +193,8 @@ tidyverse_style <- function(scope = "tokens", add_line_break_after_pipe = "SPECIAL-PIPE" ), space = list( - remove_space_before_closing_paren = c("')'", "']'"), - remove_space_before_opening_paren = c("'('", "'['", "LBB"), + # remove_space_before_closing_paren = c("')'", "']'"), + # remove_space_before_opening_paren = c("'('", "'['", "LBB"), add_space_after_for_if_while = c("IF", "WHILE", "FOR"), add_space_before_brace = "'{'", set_space_between_eq_sub_and_comma = "EQ_SUB", @@ -203,7 +203,7 @@ tidyverse_style <- function(scope = "tokens", math_token_spacing$one ), style_space_around_tilde = "'~'", - remove_space_after_opening_paren = c("'('", "'['", "LBB"), + # remove_space_after_opening_paren = c("'('", "'['", "LBB"), remove_space_after_excl = "'!'", set_space_after_bang_bang = "'!'", remove_space_before_dollar = "'$'", @@ -215,7 +215,7 @@ tidyverse_style <- function(scope = "tokens", set_space_in_curly_curly = c("'{'", "'}'") ), indention = list( - indent_braces = c("'('", "'['", "'{'", "')'", "']'", "'}'"), + # indent_braces = c("'('", "'['", "'{'", "')'", "']'", "'}'"), unindent_fun_dec = "FUNCTION", indent_eq_sub = c("EQ_SUB", "EQ_FORMALS"), # TODO rename update_indention_ref_fun_dec = "FUNCTION" From 5da948b63286824055c074bc24e018aa28c2a961 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 24 Jan 2021 21:26:01 +0100 Subject: [PATCH 20/31] more doc, formalize dropper --- API | 3 +- NAMESPACE | 1 + R/style-guides.R | 107 ++++++++++++++---- R/transform-files.R | 11 +- man/create_style_guide.Rd | 4 +- man/specify_transformer_dropping.Rd | 69 +++++++++++ ...formers_subset.Rd => transformers_drop.Rd} | 9 +- ...mers-subset.R => test-transformers-drop.R} | 50 ++++---- 8 files changed, 194 insertions(+), 60 deletions(-) create mode 100644 man/specify_transformer_dropping.Rd rename man/{transformers_subset.Rd => transformers_drop.Rd} (84%) rename tests/testthat/{test-transformers-subset.R => test-transformers-drop.R} (57%) diff --git a/API b/API index fe6a4d98f..725e716d4 100644 --- a/API +++ b/API @@ -6,10 +6,11 @@ cache_activate(cache_name = NULL, verbose = TRUE) cache_clear(cache_name = NULL, ask = TRUE) cache_deactivate(verbose = TRUE) cache_info(cache_name = NULL, format = "both") -create_style_guide(initialize = default_style_guide_attributes, line_break = NULL, space = NULL, token = NULL, indention = NULL, use_raw_indention = FALSE, reindention = tidyverse_reindention(), style_guide_name = NULL, style_guide_version = NULL, more_specs_style_guide = NULL, subset_transformers = NULL) +create_style_guide(initialize = default_style_guide_attributes, line_break = NULL, space = NULL, token = NULL, indention = NULL, use_raw_indention = FALSE, reindention = tidyverse_reindention(), style_guide_name = NULL, style_guide_version = NULL, more_specs_style_guide = NULL, transformers_drop = specify_transformer_dropping()) default_style_guide_attributes(pd_flat) specify_math_token_spacing(zero = "'^'", one = c("'+'", "'-'", "'*'", "'/'")) specify_reindention(regex_pattern = NULL, indention = 0, comments_only = TRUE) +specify_transformer_dropping(spaces = NULL, indention = NULL, line_breaks = NULL, tokens = NULL) style_dir(path = ".", ..., style = tidyverse_style, transformers = style(...), filetype = c("R", "Rprofile"), recursive = TRUE, exclude_files = NULL, exclude_dirs = c("packrat", "renv"), include_roxygen_examples = TRUE, base_indention = 0, dry = "off") style_file(path, ..., style = tidyverse_style, transformers = style(...), include_roxygen_examples = TRUE, base_indention = 0, dry = "off") style_pkg(pkg = ".", ..., style = tidyverse_style, transformers = style(...), filetype = c("R", "Rprofile"), exclude_files = "R/RcppExports.R", exclude_dirs = c("packrat", "renv"), include_roxygen_examples = TRUE, base_indention = 0, dry = "off") diff --git a/NAMESPACE b/NAMESPACE index 67f3fcd43..a21dae794 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,7 @@ export(create_style_guide) export(default_style_guide_attributes) export(specify_math_token_spacing) export(specify_reindention) +export(specify_transformer_dropping) export(style_dir) export(style_file) export(style_pkg) diff --git a/R/style-guides.R b/R/style-guides.R index ebfeee0c8..857169e4f 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -173,26 +173,8 @@ tidyverse_style <- function(scope = "tokens", ) } - subset_transformers <- list( - token = list( - resolve_semicolon = "';'", - add_brackets_in_pipe = "SPECIAL-PIPE", - # before 3.6, these assignments are not wrapped into top level expression - # and `text` supplied to transformer_subset() is "", so it appears to not - # contain EQ_ASSIGN, and the transformer is falsely removed. - # compute_parse_data_nested / text_to_flat_pd ('a = 4') - if (getRversion() >= 3.6) force_assignment_op <- "EQ_ASSIGN", - wrap_if_else_while_for_fun_multi_line_in_curly = c("IF", "WHILE", "FOR", "FUNCTION") - ), - line_break = list( - set_line_break_before_curly_opening = "'{'", - remove_line_break_before_round_closing_after_curly = "'}'", - remove_line_breaks_in_fun_dec = "FUNCTION", - set_line_break_around_curly_curly = "'{'", - style_line_break_around_curly = "'{'", - add_line_break_after_pipe = "SPECIAL-PIPE" - ), - space = list( + transformers_drop <- specify_transformer_dropping( + spaces = list( # remove_space_before_closing_paren = c("')'", "']'"), # remove_space_before_opening_paren = c("'('", "'['", "LBB"), add_space_after_for_if_while = c("IF", "WHILE", "FOR"), @@ -219,6 +201,24 @@ tidyverse_style <- function(scope = "tokens", unindent_fun_dec = "FUNCTION", indent_eq_sub = c("EQ_SUB", "EQ_FORMALS"), # TODO rename update_indention_ref_fun_dec = "FUNCTION" + ), + line_breaks = list( + set_line_break_before_curly_opening = "'{'", + remove_line_break_before_round_closing_after_curly = "'}'", + remove_line_breaks_in_fun_dec = "FUNCTION", + set_line_break_around_curly_curly = "'{'", + style_line_break_around_curly = "'{'", + add_line_break_after_pipe = "SPECIAL-PIPE" + ), + tokens = list( + resolve_semicolon = "';'", + add_brackets_in_pipe = "SPECIAL-PIPE", + # before 3.6, these assignments are not wrapped into top level expression + # and `text` supplied to transformers_drop() is "", so it appears to not + # contain EQ_ASSIGN, and the transformer is falsely removed. + # compute_parse_data_nested / text_to_flat_pd ('a = 4') + if (getRversion() >= 3.6) force_assignment_op <- "EQ_ASSIGN", + wrap_if_else_while_for_fun_multi_line_in_curly = c("IF", "WHILE", "FOR", "FUNCTION") ) ) @@ -236,7 +236,7 @@ tidyverse_style <- function(scope = "tokens", style_guide_name = style_guide_name, style_guide_version = styler_version, more_specs_style_guide = args, - subset_transformers = subset_transformers + transformers_drop = transformers_drop ) } @@ -279,7 +279,7 @@ tidyverse_style <- function(scope = "tokens", #' they will yield generic code and we loose the specific value of `arg` (see #' [styler::cache_make_key()]), even when unquoting these inputs with `!!` #' beforehand in `purrr::partial()`. -#' @param subset_transformers A list specifying under which conditions +#' @param transformers_drop A list specifying under which conditions #' transformer functions can be dropped since they have no effect on the #' code to format. This is argument experimental and may change in future #' releases without prior notification. @@ -310,7 +310,7 @@ create_style_guide <- function(initialize = default_style_guide_attributes, style_guide_name = NULL, style_guide_version = NULL, more_specs_style_guide = NULL, - subset_transformers = NULL) { + transformers_drop = specify_transformer_dropping()) { lst( # transformer functions initialize = lst(initialize), @@ -324,11 +324,70 @@ create_style_guide <- function(initialize = default_style_guide_attributes, style_guide_name, style_guide_version, more_specs_style_guide, - subset_transformers + transformers_drop ) %>% map(compact) } +#' Specify which token must be absent for a transformer to be dropped +#' +#' Transformer functions can be safely removed from the list of transformers +#' to be applied on every *nest* with [transformers_drop()] if the tokens that trigger a manipulation of +#' the parse data are absent in the text to style. +#' +#' Note that the negative formulation (must be absent in order to be dropped) +#' means that when you add a new rule and you forget +#' to add a rule for when to drop it, it will not be dropped. If we required to +#' specify the complement (which token must be present for the transformer to be +#' kept), the transformer would be silently removed, which is less save. +#' @param spaces,indention,line_breaks,tokens Each a list #TODO or `NULL` where +#' the name of each element is the concerning transformer, the value is an +#' unnamed vector with tokens that match the rule. See 'Examples' +#' +#' @section Warning: +#' It is the responsibility of the developer to ensure expected behavior, in +#' particular that: +#' * the name of the supplied dropping criteria matches the name of the +#' transformer function. +#' * the dropping criteria (name + token) reflects correctly under which +#' circumstances the transformer does not have an impact on styling and can +#' therefore be safely removed without affecting the styling outcome. +#' +#' @examples +#' dropping <- specify_transformer_dropping( +#' spaces = c(remove_space_after_excl = "'!'") +#' ) +#' style_guide <- create_style_guide( +#' space = list(remove_space_after_excl = styler:::remove_space_after_excl), +#' transformers_drop = dropping +#' ) +#' # transformers_drop() will remove the transformer when the code does not +#' # contain an exclamation mark +#' style_guide_with_some_transformers_dropped <- styler:::transformers_drop( +#' "x <- 3;2", style_guide +#' ) +#' setdiff( +#' names(style_guide$space), +#' names(style_guide_with_some_transformers_dropped) +#' ) +#' # note that dropping all transformers of a scope means that this scope +#' # has an empty named list for this scope +#' style_guide_with_some_transformers_dropped$space +#' # this is not the same as if this scope was never specified. +#' tidyverse_style(scope = "none")$space +#' # Hence, styler should check for length 0 to decide if a scope is present or +#' # not, not via `is.null()` and we can use the `is.null()` check to see if +#' # this scope was initially required by the user. +#' @export +specify_transformer_dropping <- function(spaces = NULL, + indention = NULL, + line_breaks = NULL, + tokens = NULL) { + lst( + space = spaces, indention, line_break = line_breaks, + token = tokens + ) +} #' Specify what is re-indented how #' diff --git a/R/transform-files.R b/R/transform-files.R index b2e884bd1..782c93deb 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -224,7 +224,7 @@ parse_transform_serialize_r <- function(text, } return("") } - transformers <- transformers_subset( + transformers <- transformers_drop( if (getRversion() < 3.4) text else pd_nested$text[!pd_nested$is_cached], transformers ) @@ -261,7 +261,8 @@ parse_transform_serialize_r <- function(text, #' line). #' @param transformers the transformers. #' @keywords internal -transformers_subset <- function(text, transformers) { +#' @seealso specify_transformer_dropping +transformers_drop <- function(text, transformers) { is_colon <- text == ";" if (any(is_colon)) { # ; can only be parsed when on the same line as other token, not the case @@ -270,7 +271,7 @@ transformers_subset <- function(text, transformers) { } token <- unique(tokenize(text)$token) for (scope in c("line_break", "space", "token", "indention")) { - rules <- transformers$subset_transformers[[scope]] + rules <- transformers$transformers_drop[[scope]] for (rule in names(rules)) { if (!any(rules[[rule]] %in% token)) { transformers[[scope]][rule] <- NULL @@ -308,7 +309,7 @@ apply_transformers <- function(pd_nested, transformers) { pd_nested, c( transformers$initialize, transformers$line_break, set_multi_line, - if (!is.null(transformers$line_break)) update_newlines + if (length(transformers$line_break) != 0) update_newlines ) ) @@ -338,7 +339,7 @@ apply_transformers <- function(pd_nested, transformers) { #' Needed for reverse engineering the scope. #' @keywords internal can_verify_roundtrip <- function(transformers) { - is.null(transformers$token) + length(transformers$token) == 0 } #' Verify the styling diff --git a/man/create_style_guide.Rd b/man/create_style_guide.Rd index f14165696..b5926ffcf 100644 --- a/man/create_style_guide.Rd +++ b/man/create_style_guide.Rd @@ -15,7 +15,7 @@ create_style_guide( style_guide_name = NULL, style_guide_version = NULL, more_specs_style_guide = NULL, - subset_transformers = NULL + transformers_drop = specify_transformer_dropping() ) } \arguments{ @@ -57,7 +57,7 @@ they will yield generic code and we loose the specific value of \code{arg} (see \code{\link[=cache_make_key]{cache_make_key()}}), even when unquoting these inputs with \verb{!!} beforehand in \code{purrr::partial()}.} -\item{subset_transformers}{A list specifying under which conditions +\item{transformers_drop}{A list specifying under which conditions transformer functions can be dropped since they have no effect on the code to format. This is argument experimental and may change in future releases without prior notification.} diff --git a/man/specify_transformer_dropping.Rd b/man/specify_transformer_dropping.Rd new file mode 100644 index 000000000..d923c7fc2 --- /dev/null +++ b/man/specify_transformer_dropping.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/style-guides.R +\name{specify_transformer_dropping} +\alias{specify_transformer_dropping} +\title{Specify which token must be absent for a transformer to be dropped} +\usage{ +specify_transformer_dropping( + spaces = NULL, + indention = NULL, + line_breaks = NULL, + tokens = NULL +) +} +\arguments{ +\item{spaces, indention, line_breaks, tokens}{Each a list #TODO or \code{NULL} where +the name of each element is the concerning transformer, the value is an +unnamed vector with tokens that match the rule. See 'Examples'} +} +\description{ +Transformer functions can be safely removed from the list of transformers +to be applied on every \emph{nest} with \code{\link[=transformers_drop]{transformers_drop()}} if the tokens that trigger a manipulation of +the parse data are absent in the text to style. +} +\details{ +Note that the negative formulation (must be absent in order to be dropped) +means that when you add a new rule and you forget +to add a rule for when to drop it, it will not be dropped. If we required to +specify the complement (which token must be present for the transformer to be +kept), the transformer would be silently removed, which is less save. +} +\section{Warning}{ + +It is the responsibility of the developer to ensure expected behavior, in +particular that: +\itemize{ +\item the name of the supplied dropping criteria matches the name of the +transformer function. +\item the dropping criteria (name + token) reflects correctly under which +circumstances the transformer does not have an impact on styling and can +therefore be safely removed without affecting the styling outcome. +} +} + +\examples{ +dropping <- specify_transformer_dropping( + spaces = c(remove_space_after_excl = "'!'") +) +style_guide <- create_style_guide( + space = list(remove_space_after_excl = styler:::remove_space_after_excl), + transformers_drop = dropping +) +# transformers_drop() will remove the transformer when the code does not +# contain an exclamation mark +style_guide_with_some_transformers_dropped <- styler:::transformers_drop( + "x <- 3;2", style_guide +) +setdiff( + names(style_guide$space), + names(style_guide_with_some_transformers_dropped) +) +# note that dropping all transformers of a scope means that this scope +# has an empty named list for this scope +style_guide_with_some_transformers_dropped$space +# this is not the same as if this scope was never specified. +tidyverse_style(scope = "none")$space +# Hence, styler should check for length 0 to decide if a scope is present or +# not, not via `is.null()` and we can use the `is.null()` check to see if +# this scope was initially required by the user. +} diff --git a/man/transformers_subset.Rd b/man/transformers_drop.Rd similarity index 84% rename from man/transformers_subset.Rd rename to man/transformers_drop.Rd index 7cbabf850..8cd267b65 100644 --- a/man/transformers_subset.Rd +++ b/man/transformers_drop.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/transform-files.R -\name{transformers_subset} -\alias{transformers_subset} +\name{transformers_drop} +\alias{transformers_drop} \title{Remove transformers that are not needed} \usage{ -transformers_subset(text, transformers) +transformers_drop(text, transformers) } \arguments{ \item{text}{Text to parse. Can also be the column \code{text} of the output of @@ -19,4 +19,7 @@ applicable in contexts that don't occur often, e.g. for most code, we don't expect ";" to be in it, so we don't need to apply \code{resolve_semicolon()} on every \emph{nest}. } +\seealso{ +specify_transformer_dropping +} \keyword{internal} diff --git a/tests/testthat/test-transformers-subset.R b/tests/testthat/test-transformers-drop.R similarity index 57% rename from tests/testthat/test-transformers-subset.R rename to tests/testthat/test-transformers-drop.R index c0ad9e212..3049150e0 100644 --- a/tests/testthat/test-transformers-subset.R +++ b/tests/testthat/test-transformers-drop.R @@ -9,35 +9,35 @@ remove_space_after_excl_ <- function(pd_flat) { t <- create_style_guide( space = lst(remove_space_after_excl_), - subset_transformers = list(space = list(remove_space_after_excl_ = c("'!'"))), + transformers_drop = list(space = list(remove_space_after_excl_ = c("'!'"))), style_guide_name = "styler::t@https://github.com/r-lib", style_guide_version = as.character(packageVersion("styler")) ) -t_no_subset <- create_style_guide( +t_no_drop <- create_style_guide( space = lst(remove_space_after_excl_), - subset_transformers = NULL, + transformers_drop = NULL, ) -t_empty_subset1 <- create_style_guide( +t_empty_drop1 <- create_style_guide( space = lst(remove_space_after_excl_), - subset_transformers = list(space = list()), + transformers_drop = list(space = list()), ) -t_empty_subset2 <- create_style_guide( +t_empty_drop2 <- create_style_guide( space = lst(remove_space_after_excl_), - subset_transformers = list(), + transformers_drop = list(), ) test_that("transformers are not removed if they are used", { - t_new <- transformers_subset( + t_new <- transformers_drop( "!x", t ) expect_equal(t_new, t) }) test_that("transformers are removed if they are unused", { - t_fun <- transformers_subset( + t_fun <- transformers_drop( "x", t ) t_manual <- t @@ -46,26 +46,26 @@ test_that("transformers are removed if they are unused", { }) -test_that("if no subset_transformers is specified, no transformer is removed and no error issued", { - t_fun <- transformers_subset( - "x", t_no_subset +test_that("if no transformers_drop is specified, no transformer is removed and no error issued", { + t_fun <- transformers_drop( + "x", t_no_drop ) - expect_equal(t_fun, t_no_subset) + expect_equal(t_fun, t_no_drop) - t_fun <- transformers_subset( - "x", t_empty_subset1 + t_fun <- transformers_drop( + "x", t_empty_drop1 ) - expect_equal(t_fun, t_empty_subset1) + expect_equal(t_fun, t_empty_drop1) - t_fun <- transformers_subset( - "x", t_empty_subset2 + t_fun <- transformers_drop( + "x", t_empty_drop2 ) - expect_equal(t_fun, t_empty_subset2) + expect_equal(t_fun, t_empty_drop2) }) test_that('semi-colon is parsed without error', { expect_equal( - transformers_subset(c("!a", ";", "b"), t), + transformers_drop(c("!a", ";", "b"), t), t ) }) @@ -73,9 +73,9 @@ test_that('semi-colon is parsed without error', { test_that('can handle old style guide without transformer object', { t_new <- t - t_new$subset_transformers <- NULL + t_new$transformers_drop <- NULL expect_error( - transformers_subset(c("!a", ";", "b"), t_new), + transformers_drop(c("!a", ";", "b"), t_new), NA ) expect_error( @@ -85,17 +85,17 @@ test_that('can handle old style guide without transformer object', { }) test_that("can handle default", { - t_no_subset <- create_style_guide( + t_no_drop <- create_style_guide( space = lst(remove_space_after_excl_), style_guide_name = "styler::t@https://github.com/r-lib", style_guide_version = as.character(packageVersion("styler")) ) expect_error( - transformers_subset(c("!a", ";", "b"), t_no_subset), + transformers_drop(c("!a", ";", "b"), t_no_drop), NA ) expect_error( - style_text('a =2 ', transformers = t_no_subset), + style_text('a =2 ', transformers = t_no_drop), NA ) }) From 25cf594f20b6118701ba616196a1ce85036fdac8 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 24 Jan 2021 21:53:27 +0100 Subject: [PATCH 21/31] doc improvement --- R/style-guides.R | 14 +++++++------- man/specify_transformer_dropping.Rd | 14 +++++++------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/R/style-guides.R b/R/style-guides.R index 857169e4f..f499a0c59 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -329,20 +329,20 @@ create_style_guide <- function(initialize = default_style_guide_attributes, map(compact) } -#' Specify which token must be absent for a transformer to be dropped +#' Specify which tokens must be absent for a transformer to be dropped #' #' Transformer functions can be safely removed from the list of transformers -#' to be applied on every *nest* with [transformers_drop()] if the tokens that trigger a manipulation of -#' the parse data are absent in the text to style. +#' to be applied on every *nest* with [transformers_drop()] if the tokens that +#' trigger a manipulation of the parse data are absent in the text to style. #' #' Note that the negative formulation (must be absent in order to be dropped) #' means that when you add a new rule and you forget #' to add a rule for when to drop it, it will not be dropped. If we required to -#' specify the complement (which token must be present for the transformer to be -#' kept), the transformer would be silently removed, which is less save. -#' @param spaces,indention,line_breaks,tokens Each a list #TODO or `NULL` where +#' specify the complement (which tokens must be present for the transformer to +#' be kept), the transformer would be silently removed, which is less save. +#' @param spaces,indention,line_breaks,tokens Each a list or `NULL` where #' the name of each element is the concerning transformer, the value is an -#' unnamed vector with tokens that match the rule. See 'Examples' +#' unnamed vector with tokens that match the rule. See 'Examples'. #' #' @section Warning: #' It is the responsibility of the developer to ensure expected behavior, in diff --git a/man/specify_transformer_dropping.Rd b/man/specify_transformer_dropping.Rd index d923c7fc2..1bcf6d662 100644 --- a/man/specify_transformer_dropping.Rd +++ b/man/specify_transformer_dropping.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/style-guides.R \name{specify_transformer_dropping} \alias{specify_transformer_dropping} -\title{Specify which token must be absent for a transformer to be dropped} +\title{Specify which tokens must be absent for a transformer to be dropped} \usage{ specify_transformer_dropping( spaces = NULL, @@ -12,21 +12,21 @@ specify_transformer_dropping( ) } \arguments{ -\item{spaces, indention, line_breaks, tokens}{Each a list #TODO or \code{NULL} where +\item{spaces, indention, line_breaks, tokens}{Each a list or \code{NULL} where the name of each element is the concerning transformer, the value is an -unnamed vector with tokens that match the rule. See 'Examples'} +unnamed vector with tokens that match the rule. See 'Examples'.} } \description{ Transformer functions can be safely removed from the list of transformers -to be applied on every \emph{nest} with \code{\link[=transformers_drop]{transformers_drop()}} if the tokens that trigger a manipulation of -the parse data are absent in the text to style. +to be applied on every \emph{nest} with \code{\link[=transformers_drop]{transformers_drop()}} if the tokens that +trigger a manipulation of the parse data are absent in the text to style. } \details{ Note that the negative formulation (must be absent in order to be dropped) means that when you add a new rule and you forget to add a rule for when to drop it, it will not be dropped. If we required to -specify the complement (which token must be present for the transformer to be -kept), the transformer would be silently removed, which is less save. +specify the complement (which tokens must be present for the transformer to +be kept), the transformer would be silently removed, which is less save. } \section{Warning}{ From 7dac9eb081413d48d1837a2ba9d24dd63398578a Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 24 Jan 2021 22:02:23 +0100 Subject: [PATCH 22/31] add news bullet --- NEWS.md | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 08eb85409..407ef64e6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -21,6 +21,11 @@ style tokens, you had to always also style spaces, indention, line breaks as well (#705, #707). +- New argument `transformer_drop` in `create_style_guide()` to be populated with + new helper function `specify_transformer_dropping()` for specifying conditions + under which transformers are not going to be used and can therefore be + omitted without effecting the result of styling (#711). + ## Major changes @@ -31,9 +36,10 @@ or focus loss, so this feature becomes less relevant. (#631). - blank lines in function calls and headers are now removed, for the former only when there are no comments before or after the blank line (#629, #630, #635). -- speed improvements: (~10%) when cache is activated because transformers are not - captured as character anymore (#679), ~ 3% in low-level optimization (#691). - Require magrittr 2.0 gives about 7% speed improvement (#681). +- speed improvements: ~10% when cache is activated because transformers are not + captured as character anymore (#679), ~3% in low-level optimization (#691). + 7% by requiring magrittr 2.0 (#681), ~8% by dropping unused transformers + (#711) . - `#<<` is now recognized as the xaringan marker and no space is added after`#` (#700). From 62ebd4bce9e88b0402dfa625b452a2c2345fd5dd Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 24 Jan 2021 23:12:54 +0100 Subject: [PATCH 23/31] list is so much faster than lst --- R/style-guides.R | 94 ++++++++++++++++++++++----------------------- R/transform-code.R | 2 +- R/transform-files.R | 4 +- 3 files changed, 50 insertions(+), 50 deletions(-) diff --git a/R/style-guides.R b/R/style-guides.R index f499a0c59..edc2fb72c 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -74,9 +74,9 @@ tidyverse_style <- function(scope = "tokens", indention_manipulators <- if ("indention" %in% scope) { - lst( + list( indent_braces = partial(indent_braces, indent_by = indent_by), - unindent_fun_dec, + unindent_fun_dec = unindent_fun_dec, indent_op = partial(indent_op, indent_by = indent_by), indent_eq_sub = partial(indent_eq_sub, indent_by = indent_by), indent_without_paren = partial(indent_without_paren, @@ -86,11 +86,11 @@ tidyverse_style <- function(scope = "tokens", ) } space_manipulators <- if ("spaces" %in% scope) { - lst( - remove_space_before_closing_paren, + list( + remove_space_before_closing_paren = remove_space_before_closing_paren, remove_space_before_opening_paren = if (strict) remove_space_before_opening_paren, - add_space_after_for_if_while, - remove_space_before_comma, + add_space_after_for_if_while = add_space_after_for_if_while, + remove_space_before_comma = remove_space_before_comma, style_space_around_math_token = partial( style_space_around_math_token, strict, math_token_spacing$zero, @@ -103,34 +103,34 @@ tidyverse_style <- function(scope = "tokens", spacing_around_op = purrr::partial(set_space_around_op, strict = strict ), - remove_space_after_opening_paren, - remove_space_after_excl, - set_space_after_bang_bang, - remove_space_before_dollar, - remove_space_after_fun_dec, - remove_space_around_colons, + remove_space_after_opening_paren = remove_space_after_opening_paren, + remove_space_after_excl = remove_space_after_excl, + set_space_after_bang_bang = set_space_after_bang_bang, + remove_space_before_dollar = remove_space_before_dollar, + remove_space_after_fun_dec = remove_space_after_fun_dec, + remove_space_around_colons = remove_space_around_colons, start_comments_with_space = partial(start_comments_with_space, force_one = start_comments_with_one_space ), - remove_space_after_unary_pm_nested, + remove_space_after_unary_pm_nested = remove_space_after_unary_pm_nested, spacing_before_comments = if (strict) { set_space_before_comments } else { add_space_before_comments }, - set_space_between_levels, - set_space_between_eq_sub_and_comma, - set_space_in_curly_curly + set_space_between_levels = set_space_between_levels, + set_space_between_eq_sub_and_comma = set_space_between_eq_sub_and_comma, + set_space_in_curly_curly = set_space_in_curly_curly ) } use_raw_indention <- !("indention" %in% scope) line_break_manipulators <- if ("line_breaks" %in% scope) { - lst( - set_line_break_around_comma_and_or, - set_line_break_after_assignment, - set_line_break_before_curly_opening, + list( + set_line_break_around_comma_and_or = set_line_break_around_comma_and_or, + set_line_break_after_assignment = set_line_break_after_assignment, + set_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_breaks_in_fun_dec = @@ -141,7 +141,7 @@ tidyverse_style <- function(scope = "tokens", ), # must be after style_line_break_around_curly as it remove line # breaks again for {{. - set_line_break_around_curly_curly, + set_line_break_around_curly_curly = set_line_break_around_curly_curly, set_line_break_after_opening_if_call_is_multi_line = if (strict) { partial( set_line_break_after_opening_if_call_is_multi_line, @@ -162,12 +162,12 @@ tidyverse_style <- function(scope = "tokens", } token_manipulators <- if ("tokens" %in% scope) { - lst( - fix_quotes, - force_assignment_op, - resolve_semicolon, - add_brackets_in_pipe, - remove_terminal_token_before_and_after, + list( + fix_quotes = fix_quotes, + force_assignment_op = force_assignment_op, + resolve_semicolon = resolve_semicolon, + add_brackets_in_pipe = add_brackets_in_pipe, + remove_terminal_token_before_and_after = remove_terminal_token_before_and_after, wrap_if_else_while_for_fun_multi_line_in_curly = if (strict) wrap_if_else_while_for_fun_multi_line_in_curly ) @@ -311,20 +311,20 @@ create_style_guide <- function(initialize = default_style_guide_attributes, style_guide_version = NULL, more_specs_style_guide = NULL, transformers_drop = specify_transformer_dropping()) { - lst( + list( # transformer functions - initialize = lst(initialize), - line_break, - space, - token, - indention, + initialize = list(initialize = initialize), + line_break = line_break, + space = space, + token = token, + indention = indention, # transformer options - use_raw_indention, - reindention, - style_guide_name, - style_guide_version, - more_specs_style_guide, - transformers_drop + use_raw_indention = use_raw_indention, + reindention = reindention, + style_guide_name = style_guide_name, + style_guide_version = style_guide_version, + more_specs_style_guide = more_specs_style_guide, + transformers_drop = transformers_drop ) %>% map(compact) } @@ -383,8 +383,8 @@ specify_transformer_dropping <- function(spaces = NULL, indention = NULL, line_breaks = NULL, tokens = NULL) { - lst( - space = spaces, indention, line_break = line_breaks, + list( + space = spaces, indention = indention, line_break = line_breaks, token = tokens ) } @@ -415,10 +415,10 @@ NULL specify_reindention <- function(regex_pattern = NULL, indention = 0, comments_only = TRUE) { - lst( - regex_pattern, - indention, - comments_only + list( + regex_pattern = regex_pattern, + indention = indention, + comments_only = comments_only ) } @@ -494,9 +494,9 @@ specify_math_token_spacing <- function(zero = "'^'", one = c("'+'", "'-'", "'*'", "'/'")) { assert_tokens(c(one, zero)) - lst( + list( one = setdiff(c(math_token, one), zero), - zero + zero = zero ) } diff --git a/R/transform-code.R b/R/transform-code.R index eefcaba9d..eeef0856c 100644 --- a/R/transform-code.R +++ b/R/transform-code.R @@ -64,7 +64,7 @@ separate_chunks <- function(lines, filetype) { c(1, r_raw_chunks$ends), c(r_raw_chunks$starts, length(lines)), ~ lines[seq2(.x, .y)] ) - lst(r_chunks, text_chunks) + list(r_chunks = r_chunks, text_chunks = text_chunks) } #' Identifies raw Rmd or Rnw code chunks diff --git a/R/transform-files.R b/R/transform-files.R index 782c93deb..4b1b73184 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -187,7 +187,7 @@ parse_transform_serialize_roxygen <- function(text, transformers, base_indention #' @keywords internal split_roxygen_segments <- function(text, roxygen_examples) { if (is.null(roxygen_examples)) { - return(lst(separated = list(text), selectors = NULL)) + return(list(separated = list(text), selectors = NULL)) } all_lines <- seq2(1L, length(text)) active_segment <- as.integer(all_lines %in% roxygen_examples) @@ -195,7 +195,7 @@ split_roxygen_segments <- function(text, roxygen_examples) { separated <- split(text, factor(segment_id)) restyle_selector <- ifelse(roxygen_examples[1] == 1L, odd_index, even_index) - lst(separated, selectors = restyle_selector(separated)) + list(separated = separated, selectors = restyle_selector(separated)) } #' Parse, transform and serialize text From 80fee9a2e42de0d3283e6c62e3b6200c2669e027 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sun, 24 Jan 2021 23:23:15 +0100 Subject: [PATCH 24/31] put name on right side of if --- R/style-guides.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/style-guides.R b/R/style-guides.R index edc2fb72c..f4ceb00e3 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -217,7 +217,7 @@ tidyverse_style <- function(scope = "tokens", # and `text` supplied to transformers_drop() is "", so it appears to not # contain EQ_ASSIGN, and the transformer is falsely removed. # compute_parse_data_nested / text_to_flat_pd ('a = 4') - if (getRversion() >= 3.6) force_assignment_op <- "EQ_ASSIGN", + force_assignment_op = if (getRversion() >= 3.6) "EQ_ASSIGN", wrap_if_else_while_for_fun_multi_line_in_curly = c("IF", "WHILE", "FOR", "FUNCTION") ) ) From b80a0f2eed2587fcfd7b3f59366c279f27d5daf6 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Mon, 25 Jan 2021 08:50:56 +0100 Subject: [PATCH 25/31] bump CI From c430adcc8e310e465095aa91c57cca2a2233f42e Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Mon, 25 Jan 2021 09:42:55 +0100 Subject: [PATCH 26/31] can't use if condition in assignment because it will assign NULL to the element (instead of not assigning anything --- R/style-guides.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/style-guides.R b/R/style-guides.R index f4ceb00e3..1e3986391 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -217,11 +217,15 @@ tidyverse_style <- function(scope = "tokens", # and `text` supplied to transformers_drop() is "", so it appears to not # contain EQ_ASSIGN, and the transformer is falsely removed. # compute_parse_data_nested / text_to_flat_pd ('a = 4') - force_assignment_op = if (getRversion() >= 3.6) "EQ_ASSIGN", + force_assignment_op = "EQ_ASSIGN", wrap_if_else_while_for_fun_multi_line_in_curly = c("IF", "WHILE", "FOR", "FUNCTION") ) ) + if (getRversion() >= 3.6) { + transformers_drop$token$force_assignment_op <- NULL + } + style_guide_name <- "styler::tidyverse_style@https://github.com/r-lib" create_style_guide( # transformer functions From e2f39311c25a8fe4cc8860122e092a1158785811 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Mon, 25 Jan 2021 11:25:07 +0100 Subject: [PATCH 27/31] more thorough transformer testing --- R/style-guides.R | 4 +- tests/testthat/test-transformers-drop.R | 55 +++++++++++++++++++++++++ 2 files changed, 57 insertions(+), 2 deletions(-) diff --git a/R/style-guides.R b/R/style-guides.R index 1e3986391..8c86baa84 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -178,7 +178,7 @@ tidyverse_style <- function(scope = "tokens", # remove_space_before_closing_paren = c("')'", "']'"), # remove_space_before_opening_paren = c("'('", "'['", "LBB"), add_space_after_for_if_while = c("IF", "WHILE", "FOR"), - add_space_before_brace = "'{'", + # remove_space_before_comma = "','", set_space_between_eq_sub_and_comma = "EQ_SUB", style_space_around_math_token = c( math_token_spacing$zero, @@ -222,7 +222,7 @@ tidyverse_style <- function(scope = "tokens", ) ) - if (getRversion() >= 3.6) { + if (getRversion() < 3.6) { transformers_drop$token$force_assignment_op <- NULL } diff --git a/tests/testthat/test-transformers-drop.R b/tests/testthat/test-transformers-drop.R index 3049150e0..84acd4b7e 100644 --- a/tests/testthat/test-transformers-drop.R +++ b/tests/testthat/test-transformers-drop.R @@ -45,6 +45,61 @@ test_that("transformers are removed if they are unused", { expect_equal(t_fun, t_manual) }) +test_that("tidyverse transformers are correctly dropped", { + t_style <- tidyverse_style() + + t_fun <- transformers_drop( + "x", t_style + ) + # test that all dropping rules match an actual rule in the style guide + scopes <- intersect( + names(t_fun$transformers_drop), + names(t_fun) + ) + purrr::map2(t_fun$transformers_drop, t_style[scopes], function(x, y) { + # all x must be in y. select the x that are not in y + diff <- setdiff(names(x),names(y)) + if (length(diff) > 0) { + rlang::abort(paste( + "transformer_dropping specifies exclusion rules for transformers that ", + "are not in the style guilde. Please add the rule to the style guide ", + "or remove the dropping rules:", paste(diff, collapse = ", ")) + ) + } + }) + names_line_break <- c( + "set_line_break_around_comma_and_or", + "set_line_break_after_assignment", + "set_line_break_after_opening_if_call_is_multi_line", + "set_line_break_before_closing_call", + "remove_line_break_in_fun_call", + "set_linebreak_after_ggplot2_plus" + ) + expect_setequal(names(t_fun$line_break), names_line_break) + + names_spaces <- c( + "remove_space_before_closing_paren", + "remove_space_before_opening_paren", + "remove_space_before_comma", + "spacing_around_op", + "remove_space_after_opening_paren", + "set_space_between_levels" + ) + + expect_setequal(names(t_fun$space), names_spaces) + + names_indention <- c("indent_braces", "indent_op", "indent_without_paren") + expect_setequal(names(t_fun$indention), names_indention) + + names_tokens <- c( + "fix_quotes", + if (getRversion() < 3.6) "force_assignment_op", + "remove_terminal_token_before_and_after" + ) + expect_setequal(names(t_fun$token), names_tokens) + +}) + test_that("if no transformers_drop is specified, no transformer is removed and no error issued", { t_fun <- transformers_drop( From 96ede0b475f6bde2254394634fa5e14a42e82211 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Mon, 25 Jan 2021 11:55:26 +0100 Subject: [PATCH 28/31] more docs --- R/style-guides.R | 18 ++++++++++---- R/testing.R | 23 +++++++++++++++++ man/create_style_guide.Rd | 8 ++++-- man/specify_transformer_dropping.Rd | 11 ++++++--- man/test_transformers_dropping.Rd | 17 +++++++++++++ tests/testthat/test-serialize_tests.R | 23 +++++++++++++++++ tests/testthat/test-transformers-drop.R | 33 +++++++++---------------- 7 files changed, 102 insertions(+), 31 deletions(-) create mode 100644 man/test_transformers_dropping.Rd diff --git a/R/style-guides.R b/R/style-guides.R index 8c86baa84..b3cee64f7 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -285,8 +285,12 @@ tidyverse_style <- function(scope = "tokens", #' beforehand in `purrr::partial()`. #' @param transformers_drop A list specifying under which conditions #' transformer functions can be dropped since they have no effect on the -#' code to format. This is argument experimental and may change in future -#' releases without prior notification. +#' code to format, most easily constructed with +#' [specify_transformer_dropping()]. This is argument experimental and may +#' change in future releases without prior notification. It was mainly +#' introduced to improve speed. Listing transformers here that occur almost +#' always in code does not make sense because the process of excluding them +#' also takes some time. #' @examples #' set_line_break_before_curly_opening <- function(pd_flat) { #' op <- pd_flat$token %in% "'{'" @@ -335,9 +339,11 @@ create_style_guide <- function(initialize = default_style_guide_attributes, #' Specify which tokens must be absent for a transformer to be dropped #' -#' Transformer functions can be safely removed from the list of transformers -#' to be applied on every *nest* with [transformers_drop()] if the tokens that -#' trigger a manipulation of the parse data are absent in the text to style. +#' `{styler}` can remove transformer functions safely removed from the list of +#' transformers to be applied on every *nest* with [transformers_drop()] if the +#' tokens that trigger a manipulation of the parse data are absent in the text +#' to style. `specify_transformer_dropping()` helps you specify these +#' conditions. #' #' Note that the negative formulation (must be absent in order to be dropped) #' means that when you add a new rule and you forget @@ -357,6 +363,8 @@ create_style_guide <- function(initialize = default_style_guide_attributes, #' circumstances the transformer does not have an impact on styling and can #' therefore be safely removed without affecting the styling outcome. #' +#' You can use the unexported function [test_transformers_dropping()] for some +#' checks. #' @examples #' dropping <- specify_transformer_dropping( #' spaces = c(remove_space_after_excl = "'!'") diff --git a/R/testing.R b/R/testing.R index 6d7c90883..3d6d79a3d 100644 --- a/R/testing.R +++ b/R/testing.R @@ -341,3 +341,26 @@ fresh_testthat_cache <- function() { cache_more_specs_default <- function() { cache_more_specs(include_roxygen_examples = TRUE, base_indention = 0) } + +#' Check if the transformers_dropping in [create_style_guide()] is consistent +#' with the transformers specified. +#' @param transformers The output of [create_style_guide()] we want to test. +#' @keywords internal +test_transformers_dropping <- function(transformers) { + scopes <- intersect( + names(transformers$transformers_drop), + names(transformers) + ) + + purrr::walk2(transformers$transformers_drop, transformers[scopes], function(x, y) { + # all x must be in y. select the x that are not in y + diff <- setdiff(names(x), names(y)) + if (length(diff) > 0) { + rlang::abort(paste( + "transformer_dropping specifies exclusion rules for transformers that ", + "are not in the style guilde. Please add the rule to the style guide ", + "or remove the dropping rules:", paste(diff, collapse = ", ") + )) + } + }) +} diff --git a/man/create_style_guide.Rd b/man/create_style_guide.Rd index b5926ffcf..256345a71 100644 --- a/man/create_style_guide.Rd +++ b/man/create_style_guide.Rd @@ -59,8 +59,12 @@ beforehand in \code{purrr::partial()}.} \item{transformers_drop}{A list specifying under which conditions transformer functions can be dropped since they have no effect on the -code to format. This is argument experimental and may change in future -releases without prior notification.} +code to format, most easily constructed with +\code{\link[=specify_transformer_dropping]{specify_transformer_dropping()}}. This is argument experimental and may +change in future releases without prior notification. It was mainly +introduced to improve speed. Listing transformers here that occur almost +always in code does not make sense because the process of excluding them +also takes some time.} } \description{ This is a helper function to create a style guide, which is technically diff --git a/man/specify_transformer_dropping.Rd b/man/specify_transformer_dropping.Rd index 1bcf6d662..faa5a690a 100644 --- a/man/specify_transformer_dropping.Rd +++ b/man/specify_transformer_dropping.Rd @@ -17,9 +17,11 @@ the name of each element is the concerning transformer, the value is an unnamed vector with tokens that match the rule. See 'Examples'.} } \description{ -Transformer functions can be safely removed from the list of transformers -to be applied on every \emph{nest} with \code{\link[=transformers_drop]{transformers_drop()}} if the tokens that -trigger a manipulation of the parse data are absent in the text to style. +\code{{styler}} can remove transformer functions safely removed from the list of +transformers to be applied on every \emph{nest} with \code{\link[=transformers_drop]{transformers_drop()}} if the +tokens that trigger a manipulation of the parse data are absent in the text +to style. \code{specify_transformer_dropping()} helps you specify these +conditions. } \details{ Note that the negative formulation (must be absent in order to be dropped) @@ -39,6 +41,9 @@ transformer function. circumstances the transformer does not have an impact on styling and can therefore be safely removed without affecting the styling outcome. } + +You can use the unexported function \code{\link[=test_transformers_dropping]{test_transformers_dropping()}} for some +checks. } \examples{ diff --git a/man/test_transformers_dropping.Rd b/man/test_transformers_dropping.Rd new file mode 100644 index 000000000..ff2a9f5fd --- /dev/null +++ b/man/test_transformers_dropping.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/testing.R +\name{test_transformers_dropping} +\alias{test_transformers_dropping} +\title{Check if the transformers_dropping in \code{\link[=create_style_guide]{create_style_guide()}} is consistent +with the transformers specified.} +\usage{ +test_transformers_dropping(transformers) +} +\arguments{ +\item{transformers}{The output of \code{\link[=create_style_guide]{create_style_guide()}} we want to test.} +} +\description{ +Check if the transformers_dropping in \code{\link[=create_style_guide]{create_style_guide()}} is consistent +with the transformers specified. +} +\keyword{internal} diff --git a/tests/testthat/test-serialize_tests.R b/tests/testthat/test-serialize_tests.R index 19faf3f9b..5d5843beb 100644 --- a/tests/testthat/test-serialize_tests.R +++ b/tests/testthat/test-serialize_tests.R @@ -26,3 +26,26 @@ test_that("properly detects match", { "identical" ) }) + +test_that('detects non-matching style guides', { + sg <- create_style_guide( + space = list( + a1 = function(...) NULL, + b1 = function(... ) 1 + ), + transformers_drop = specify_transformer_dropping( + spaces = c(a1 = "'+'") + ) + ) + expect_silent(test_transformers_dropping(sg)) + + sg <- create_style_guide( + space = list( + a1 = function(...) NULL + ), + transformers_drop = specify_transformer_dropping( + spaces = c(a2 = "'+'") + ) + ) + expect_error(test_transformers_dropping(sg)) +}) diff --git a/tests/testthat/test-transformers-drop.R b/tests/testthat/test-transformers-drop.R index 84acd4b7e..fd91a220e 100644 --- a/tests/testthat/test-transformers-drop.R +++ b/tests/testthat/test-transformers-drop.R @@ -9,7 +9,9 @@ remove_space_after_excl_ <- function(pd_flat) { t <- create_style_guide( space = lst(remove_space_after_excl_), - transformers_drop = list(space = list(remove_space_after_excl_ = c("'!'"))), + transformers_drop = specify_transformer_dropping( + spaces = list(remove_space_after_excl_ = c("'!'")) + ), style_guide_name = "styler::t@https://github.com/r-lib", style_guide_version = as.character(packageVersion("styler")) ) @@ -45,28 +47,18 @@ test_that("transformers are removed if they are unused", { expect_equal(t_fun, t_manual) }) +test_that("tidyverse transformers are correctly named", { + # test that all dropping rules match an actual rule in the style guide + expect_silent( + test_transformers_dropping(tidyverse_style()) + ) +}) + test_that("tidyverse transformers are correctly dropped", { + # TODO maybe there is a more minimal test than this. t_style <- tidyverse_style() + t_fun <- transformers_drop("x", t_style) - t_fun <- transformers_drop( - "x", t_style - ) - # test that all dropping rules match an actual rule in the style guide - scopes <- intersect( - names(t_fun$transformers_drop), - names(t_fun) - ) - purrr::map2(t_fun$transformers_drop, t_style[scopes], function(x, y) { - # all x must be in y. select the x that are not in y - diff <- setdiff(names(x),names(y)) - if (length(diff) > 0) { - rlang::abort(paste( - "transformer_dropping specifies exclusion rules for transformers that ", - "are not in the style guilde. Please add the rule to the style guide ", - "or remove the dropping rules:", paste(diff, collapse = ", ")) - ) - } - }) names_line_break <- c( "set_line_break_around_comma_and_or", "set_line_break_after_assignment", @@ -97,7 +89,6 @@ test_that("tidyverse transformers are correctly dropped", { "remove_terminal_token_before_and_after" ) expect_setequal(names(t_fun$token), names_tokens) - }) From 45dca2af8b6075e8a189b98bf0b354ded2875da0 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Sat, 23 Jan 2021 21:55:18 +0100 Subject: [PATCH 29/31] random roxygenize --- inst/WORDLIST | 1 + man/caching.Rd | 8 ++++---- man/save_after_styling_is_active.Rd | 13 +++++++++++++ 3 files changed, 18 insertions(+), 4 deletions(-) create mode 100644 man/save_after_styling_is_active.Rd diff --git a/inst/WORDLIST b/inst/WORDLIST index 9fcb604ce..0b4fe44db 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,3 +1,4 @@ +addin Addin addins Addins diff --git a/man/caching.Rd b/man/caching.Rd index 86c7ceec7..4983dc4c1 100644 --- a/man/caching.Rd +++ b/man/caching.Rd @@ -12,15 +12,15 @@ Code is cached by expression and the cache is shared across all APIs (e.g. } \section{Manage the cache}{ -See \code{\link[=cache_info]{cache_info()}},\code{\link[=cache_deactivate]{cache_deactivate()}} or \code{\link[=cache_clear]{cache_clear()}} for utilities to -manage the cache. You can deactivate it altogether with \code{\link[=cache_activate]{cache_activate()}}. +See \code{\link[=cache_info]{cache_info()}},\code{\link[=cache_activate]{cache_activate()}} or \code{\link[=cache_clear]{cache_clear()}} for utilities to +manage the cache. You can deactivate it altogether with \code{\link[=cache_deactivate]{cache_deactivate()}}. Since we leverage \code{{R.cache}} to manage the cache, you can also use any \code{{R.cache}} functionality to manipulate it. } \section{Interactive setup}{ -styler by default uses caching via the \code{{R.cache}} package. When interacting +\code{{styler}} by default uses caching via the \code{{R.cache}} package. When interacting with \code{{styler}}, you will be asked to let it create a permanent cache on your file system that styler will use in case it is not set already up for another tool that uses \code{{R.cache}}. We encourage users to let \code{{R.cache}} create a @@ -41,7 +41,7 @@ probably give the prompt anyways if called interactively. \section{Non-interactive use}{ Note that if you have never authorized \code{{R.cache}} to create the cache in a -permanent directory and you use styler non-interactively, it will build the +permanent directory and you use \code{{styler}} non-interactively, it will build the cache in a temporary directory. To create a permanent cache, follow the section 'Non-interactive setup' or 'Interactive setup' above. } diff --git a/man/save_after_styling_is_active.Rd b/man/save_after_styling_is_active.Rd new file mode 100644 index 000000000..3199e0b12 --- /dev/null +++ b/man/save_after_styling_is_active.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/addins.R +\name{save_after_styling_is_active} +\alias{save_after_styling_is_active} +\title{Heuristic to see if a file styled with the addin should be saved or not.} +\usage{ +save_after_styling_is_active() +} +\description{ +Using the R option \code{"styler.save_after_styling"} and if unset, checks legacy +method via environment variable \code{save_after_styling}. +} +\keyword{internal} From 3f3ab1cf5d388549ce07f2ed0fc21d7d3a0a9fcf Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Mon, 25 Jan 2021 15:03:48 +0100 Subject: [PATCH 30/31] consistently use transformers_drop --- API | 4 ++-- NAMESPACE | 2 +- R/style-guides.R | 20 +++++++++---------- R/testing.R | 6 +++--- R/transform-files.R | 2 +- man/create_style_guide.Rd | 4 ++-- ...opping.Rd => specify_transformers_drop.Rd} | 12 +++++------ man/test_transformers_drop.Rd | 17 ++++++++++++++++ man/test_transformers_dropping.Rd | 17 ---------------- man/transformers_drop.Rd | 2 +- tests/testthat/test-serialize_tests.R | 8 ++++---- tests/testthat/test-transformers-drop.R | 4 ++-- 12 files changed, 49 insertions(+), 49 deletions(-) rename man/{specify_transformer_dropping.Rd => specify_transformers_drop.Rd} (90%) create mode 100644 man/test_transformers_drop.Rd delete mode 100644 man/test_transformers_dropping.Rd diff --git a/API b/API index 725e716d4..80b09fbe1 100644 --- a/API +++ b/API @@ -6,11 +6,11 @@ cache_activate(cache_name = NULL, verbose = TRUE) cache_clear(cache_name = NULL, ask = TRUE) cache_deactivate(verbose = TRUE) cache_info(cache_name = NULL, format = "both") -create_style_guide(initialize = default_style_guide_attributes, line_break = NULL, space = NULL, token = NULL, indention = NULL, use_raw_indention = FALSE, reindention = tidyverse_reindention(), style_guide_name = NULL, style_guide_version = NULL, more_specs_style_guide = NULL, transformers_drop = specify_transformer_dropping()) +create_style_guide(initialize = default_style_guide_attributes, line_break = NULL, space = NULL, token = NULL, indention = NULL, use_raw_indention = FALSE, reindention = tidyverse_reindention(), style_guide_name = NULL, style_guide_version = NULL, more_specs_style_guide = NULL, transformers_drop = specify_transformers_drop()) default_style_guide_attributes(pd_flat) specify_math_token_spacing(zero = "'^'", one = c("'+'", "'-'", "'*'", "'/'")) specify_reindention(regex_pattern = NULL, indention = 0, comments_only = TRUE) -specify_transformer_dropping(spaces = NULL, indention = NULL, line_breaks = NULL, tokens = NULL) +specify_transformers_drop(spaces = NULL, indention = NULL, line_breaks = NULL, tokens = NULL) style_dir(path = ".", ..., style = tidyverse_style, transformers = style(...), filetype = c("R", "Rprofile"), recursive = TRUE, exclude_files = NULL, exclude_dirs = c("packrat", "renv"), include_roxygen_examples = TRUE, base_indention = 0, dry = "off") style_file(path, ..., style = tidyverse_style, transformers = style(...), include_roxygen_examples = TRUE, base_indention = 0, dry = "off") style_pkg(pkg = ".", ..., style = tidyverse_style, transformers = style(...), filetype = c("R", "Rprofile"), exclude_files = "R/RcppExports.R", exclude_dirs = c("packrat", "renv"), include_roxygen_examples = TRUE, base_indention = 0, dry = "off") diff --git a/NAMESPACE b/NAMESPACE index a21dae794..7ab16f529 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,7 +9,7 @@ export(create_style_guide) export(default_style_guide_attributes) export(specify_math_token_spacing) export(specify_reindention) -export(specify_transformer_dropping) +export(specify_transformers_drop) export(style_dir) export(style_file) export(style_pkg) diff --git a/R/style-guides.R b/R/style-guides.R index b3cee64f7..a43abacb5 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -173,7 +173,7 @@ tidyverse_style <- function(scope = "tokens", ) } - transformers_drop <- specify_transformer_dropping( + transformers_drop <- specify_transformers_drop( spaces = list( # remove_space_before_closing_paren = c("')'", "']'"), # remove_space_before_opening_paren = c("'('", "'['", "LBB"), @@ -286,7 +286,7 @@ tidyverse_style <- function(scope = "tokens", #' @param transformers_drop A list specifying under which conditions #' transformer functions can be dropped since they have no effect on the #' code to format, most easily constructed with -#' [specify_transformer_dropping()]. This is argument experimental and may +#' [specify_transformers_drop()]. This is argument experimental and may #' change in future releases without prior notification. It was mainly #' introduced to improve speed. Listing transformers here that occur almost #' always in code does not make sense because the process of excluding them @@ -318,7 +318,7 @@ create_style_guide <- function(initialize = default_style_guide_attributes, style_guide_name = NULL, style_guide_version = NULL, more_specs_style_guide = NULL, - transformers_drop = specify_transformer_dropping()) { + transformers_drop = specify_transformers_drop()) { list( # transformer functions initialize = list(initialize = initialize), @@ -342,7 +342,7 @@ create_style_guide <- function(initialize = default_style_guide_attributes, #' `{styler}` can remove transformer functions safely removed from the list of #' transformers to be applied on every *nest* with [transformers_drop()] if the #' tokens that trigger a manipulation of the parse data are absent in the text -#' to style. `specify_transformer_dropping()` helps you specify these +#' to style. `specify_transformers_drop()` helps you specify these #' conditions. #' #' Note that the negative formulation (must be absent in order to be dropped) @@ -363,10 +363,10 @@ create_style_guide <- function(initialize = default_style_guide_attributes, #' circumstances the transformer does not have an impact on styling and can #' therefore be safely removed without affecting the styling outcome. #' -#' You can use the unexported function [test_transformers_dropping()] for some +#' You can use the unexported function [test_transformers_drop()] for some #' checks. #' @examples -#' dropping <- specify_transformer_dropping( +#' dropping <- specify_transformers_drop( #' spaces = c(remove_space_after_excl = "'!'") #' ) #' style_guide <- create_style_guide( @@ -391,10 +391,10 @@ create_style_guide <- function(initialize = default_style_guide_attributes, #' # not, not via `is.null()` and we can use the `is.null()` check to see if #' # this scope was initially required by the user. #' @export -specify_transformer_dropping <- function(spaces = NULL, - indention = NULL, - line_breaks = NULL, - tokens = NULL) { +specify_transformers_drop <- function(spaces = NULL, + indention = NULL, + line_breaks = NULL, + tokens = NULL) { list( space = spaces, indention = indention, line_break = line_breaks, token = tokens diff --git a/R/testing.R b/R/testing.R index 3d6d79a3d..9ef3a09ba 100644 --- a/R/testing.R +++ b/R/testing.R @@ -342,11 +342,11 @@ cache_more_specs_default <- function() { cache_more_specs(include_roxygen_examples = TRUE, base_indention = 0) } -#' Check if the transformers_dropping in [create_style_guide()] is consistent +#' Check if the transformers_drop in [create_style_guide()] is consistent #' with the transformers specified. #' @param transformers The output of [create_style_guide()] we want to test. #' @keywords internal -test_transformers_dropping <- function(transformers) { +test_transformers_drop <- function(transformers) { scopes <- intersect( names(transformers$transformers_drop), names(transformers) @@ -357,7 +357,7 @@ test_transformers_dropping <- function(transformers) { diff <- setdiff(names(x), names(y)) if (length(diff) > 0) { rlang::abort(paste( - "transformer_dropping specifies exclusion rules for transformers that ", + "transformers_drop specifies exclusion rules for transformers that ", "are not in the style guilde. Please add the rule to the style guide ", "or remove the dropping rules:", paste(diff, collapse = ", ") )) diff --git a/R/transform-files.R b/R/transform-files.R index 4b1b73184..cccae05ec 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -261,7 +261,7 @@ parse_transform_serialize_r <- function(text, #' line). #' @param transformers the transformers. #' @keywords internal -#' @seealso specify_transformer_dropping +#' @seealso specify_transformers_drop transformers_drop <- function(text, transformers) { is_colon <- text == ";" if (any(is_colon)) { diff --git a/man/create_style_guide.Rd b/man/create_style_guide.Rd index 256345a71..ef1e8add1 100644 --- a/man/create_style_guide.Rd +++ b/man/create_style_guide.Rd @@ -15,7 +15,7 @@ create_style_guide( style_guide_name = NULL, style_guide_version = NULL, more_specs_style_guide = NULL, - transformers_drop = specify_transformer_dropping() + transformers_drop = specify_transformers_drop() ) } \arguments{ @@ -60,7 +60,7 @@ beforehand in \code{purrr::partial()}.} \item{transformers_drop}{A list specifying under which conditions transformer functions can be dropped since they have no effect on the code to format, most easily constructed with -\code{\link[=specify_transformer_dropping]{specify_transformer_dropping()}}. This is argument experimental and may +\code{\link[=specify_transformers_drop]{specify_transformers_drop()}}. This is argument experimental and may change in future releases without prior notification. It was mainly introduced to improve speed. Listing transformers here that occur almost always in code does not make sense because the process of excluding them diff --git a/man/specify_transformer_dropping.Rd b/man/specify_transformers_drop.Rd similarity index 90% rename from man/specify_transformer_dropping.Rd rename to man/specify_transformers_drop.Rd index faa5a690a..e8b33732a 100644 --- a/man/specify_transformer_dropping.Rd +++ b/man/specify_transformers_drop.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/style-guides.R -\name{specify_transformer_dropping} -\alias{specify_transformer_dropping} +\name{specify_transformers_drop} +\alias{specify_transformers_drop} \title{Specify which tokens must be absent for a transformer to be dropped} \usage{ -specify_transformer_dropping( +specify_transformers_drop( spaces = NULL, indention = NULL, line_breaks = NULL, @@ -20,7 +20,7 @@ unnamed vector with tokens that match the rule. See 'Examples'.} \code{{styler}} can remove transformer functions safely removed from the list of transformers to be applied on every \emph{nest} with \code{\link[=transformers_drop]{transformers_drop()}} if the tokens that trigger a manipulation of the parse data are absent in the text -to style. \code{specify_transformer_dropping()} helps you specify these +to style. \code{specify_transformers_drop()} helps you specify these conditions. } \details{ @@ -42,12 +42,12 @@ circumstances the transformer does not have an impact on styling and can therefore be safely removed without affecting the styling outcome. } -You can use the unexported function \code{\link[=test_transformers_dropping]{test_transformers_dropping()}} for some +You can use the unexported function \code{\link[=test_transformers_drop]{test_transformers_drop()}} for some checks. } \examples{ -dropping <- specify_transformer_dropping( +dropping <- specify_transformers_drop( spaces = c(remove_space_after_excl = "'!'") ) style_guide <- create_style_guide( diff --git a/man/test_transformers_drop.Rd b/man/test_transformers_drop.Rd new file mode 100644 index 000000000..14dc9606e --- /dev/null +++ b/man/test_transformers_drop.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/testing.R +\name{test_transformers_drop} +\alias{test_transformers_drop} +\title{Check if the transformers_drop in \code{\link[=create_style_guide]{create_style_guide()}} is consistent +with the transformers specified.} +\usage{ +test_transformers_drop(transformers) +} +\arguments{ +\item{transformers}{The output of \code{\link[=create_style_guide]{create_style_guide()}} we want to test.} +} +\description{ +Check if the transformers_drop in \code{\link[=create_style_guide]{create_style_guide()}} is consistent +with the transformers specified. +} +\keyword{internal} diff --git a/man/test_transformers_dropping.Rd b/man/test_transformers_dropping.Rd deleted file mode 100644 index ff2a9f5fd..000000000 --- a/man/test_transformers_dropping.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/testing.R -\name{test_transformers_dropping} -\alias{test_transformers_dropping} -\title{Check if the transformers_dropping in \code{\link[=create_style_guide]{create_style_guide()}} is consistent -with the transformers specified.} -\usage{ -test_transformers_dropping(transformers) -} -\arguments{ -\item{transformers}{The output of \code{\link[=create_style_guide]{create_style_guide()}} we want to test.} -} -\description{ -Check if the transformers_dropping in \code{\link[=create_style_guide]{create_style_guide()}} is consistent -with the transformers specified. -} -\keyword{internal} diff --git a/man/transformers_drop.Rd b/man/transformers_drop.Rd index 8cd267b65..19623db73 100644 --- a/man/transformers_drop.Rd +++ b/man/transformers_drop.Rd @@ -20,6 +20,6 @@ expect ";" to be in it, so we don't need to apply \code{resolve_semicolon()} on every \emph{nest}. } \seealso{ -specify_transformer_dropping +specify_transformers_drop } \keyword{internal} diff --git a/tests/testthat/test-serialize_tests.R b/tests/testthat/test-serialize_tests.R index 5d5843beb..77433ee1d 100644 --- a/tests/testthat/test-serialize_tests.R +++ b/tests/testthat/test-serialize_tests.R @@ -33,19 +33,19 @@ test_that('detects non-matching style guides', { a1 = function(...) NULL, b1 = function(... ) 1 ), - transformers_drop = specify_transformer_dropping( + transformers_drop = specify_transformers_drop( spaces = c(a1 = "'+'") ) ) - expect_silent(test_transformers_dropping(sg)) + expect_silent(test_transformers_drop(sg)) sg <- create_style_guide( space = list( a1 = function(...) NULL ), - transformers_drop = specify_transformer_dropping( + transformers_drop = specify_transformers_drop( spaces = c(a2 = "'+'") ) ) - expect_error(test_transformers_dropping(sg)) + expect_error(test_transformers_drop(sg)) }) diff --git a/tests/testthat/test-transformers-drop.R b/tests/testthat/test-transformers-drop.R index fd91a220e..a93aa4921 100644 --- a/tests/testthat/test-transformers-drop.R +++ b/tests/testthat/test-transformers-drop.R @@ -9,7 +9,7 @@ remove_space_after_excl_ <- function(pd_flat) { t <- create_style_guide( space = lst(remove_space_after_excl_), - transformers_drop = specify_transformer_dropping( + transformers_drop = specify_transformers_drop( spaces = list(remove_space_after_excl_ = c("'!'")) ), style_guide_name = "styler::t@https://github.com/r-lib", @@ -50,7 +50,7 @@ test_that("transformers are removed if they are unused", { test_that("tidyverse transformers are correctly named", { # test that all dropping rules match an actual rule in the style guide expect_silent( - test_transformers_dropping(tidyverse_style()) + test_transformers_drop(tidyverse_style()) ) }) From 4e8a24869eeee9ded13bf46a58ddb610d8459e96 Mon Sep 17 00:00:00 2001 From: Lorenz Walthert Date: Mon, 25 Jan 2021 20:41:53 +0100 Subject: [PATCH 31/31] minor consistency edits --- NEWS.md | 4 ++-- R/style-guides.R | 2 +- R/testing.R | 6 ++++-- man/specify_transformers_drop.Rd | 2 +- man/test_transformers_drop.Rd | 7 +++---- 5 files changed, 11 insertions(+), 10 deletions(-) diff --git a/NEWS.md b/NEWS.md index 407ef64e6..125839a46 100644 --- a/NEWS.md +++ b/NEWS.md @@ -21,8 +21,8 @@ style tokens, you had to always also style spaces, indention, line breaks as well (#705, #707). -- New argument `transformer_drop` in `create_style_guide()` to be populated with - new helper function `specify_transformer_dropping()` for specifying conditions +- New argument `transformers_drop` in `create_style_guide()` to be populated with + new helper function `specify_transformers_drop()` for specifying conditions under which transformers are not going to be used and can therefore be omitted without effecting the result of styling (#711). diff --git a/R/style-guides.R b/R/style-guides.R index a43abacb5..5fae0f40c 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -350,7 +350,7 @@ create_style_guide <- function(initialize = default_style_guide_attributes, #' to add a rule for when to drop it, it will not be dropped. If we required to #' specify the complement (which tokens must be present for the transformer to #' be kept), the transformer would be silently removed, which is less save. -#' @param spaces,indention,line_breaks,tokens Each a list or `NULL` where +#' @param spaces,indention,line_breaks,tokens Each a list (or `NULL`) where #' the name of each element is the concerning transformer, the value is an #' unnamed vector with tokens that match the rule. See 'Examples'. #' diff --git a/R/testing.R b/R/testing.R index 9ef3a09ba..b5b00f0d1 100644 --- a/R/testing.R +++ b/R/testing.R @@ -342,8 +342,10 @@ cache_more_specs_default <- function() { cache_more_specs(include_roxygen_examples = TRUE, base_indention = 0) } -#' Check if the transformers_drop in [create_style_guide()] is consistent -#' with the transformers specified. +#' Test `transformers_drop` for consistency +#' +#' Check if the argument `transformers_drop` in [create_style_guide()] is +#' consistent with the transformers specified in that function. #' @param transformers The output of [create_style_guide()] we want to test. #' @keywords internal test_transformers_drop <- function(transformers) { diff --git a/man/specify_transformers_drop.Rd b/man/specify_transformers_drop.Rd index e8b33732a..e9069cc33 100644 --- a/man/specify_transformers_drop.Rd +++ b/man/specify_transformers_drop.Rd @@ -12,7 +12,7 @@ specify_transformers_drop( ) } \arguments{ -\item{spaces, indention, line_breaks, tokens}{Each a list or \code{NULL} where +\item{spaces, indention, line_breaks, tokens}{Each a list (or \code{NULL}) where the name of each element is the concerning transformer, the value is an unnamed vector with tokens that match the rule. See 'Examples'.} } diff --git a/man/test_transformers_drop.Rd b/man/test_transformers_drop.Rd index 14dc9606e..bd2bfa381 100644 --- a/man/test_transformers_drop.Rd +++ b/man/test_transformers_drop.Rd @@ -2,8 +2,7 @@ % Please edit documentation in R/testing.R \name{test_transformers_drop} \alias{test_transformers_drop} -\title{Check if the transformers_drop in \code{\link[=create_style_guide]{create_style_guide()}} is consistent -with the transformers specified.} +\title{Test \code{transformers_drop} for consistency} \usage{ test_transformers_drop(transformers) } @@ -11,7 +10,7 @@ test_transformers_drop(transformers) \item{transformers}{The output of \code{\link[=create_style_guide]{create_style_guide()}} we want to test.} } \description{ -Check if the transformers_drop in \code{\link[=create_style_guide]{create_style_guide()}} is consistent -with the transformers specified. +Check if the argument \code{transformers_drop} in \code{\link[=create_style_guide]{create_style_guide()}} is +consistent with the transformers specified in that function. } \keyword{internal}