diff --git a/R/testing.R b/R/testing.R index f585c68e5..191141881 100644 --- a/R/testing.R +++ b/R/testing.R @@ -164,14 +164,16 @@ NULL style_empty <- function(text, base_indention = 0) { transformers <- list( # transformer functions - initialize = default_style_guide_attributes, - line_break = NULL, - space = NULL, - token = NULL, + initialize = list( + default_style_guide_attributes = default_style_guide_attributes + ), + line_break = NULL, + space = NULL, + token = NULL, # transformer options use_raw_indention = FALSE, - reindention = specify_reindention(), - indent_character = " ", + reindention = specify_reindention(), + indent_character = " ", NULL ) transformed_text <- parse_transform_serialize_r(text, @@ -186,14 +188,18 @@ style_empty <- function(text, base_indention = 0) { style_op <- function(text, base_indention = 0) { transformers <- list( # transformer functions - initialize = default_style_guide_attributes, - line_break = NULL, - space = partial(indent_op, indent_by = 2), - token = NULL, + initialize = list( + default_style_guide_attributes = default_style_guide_attributes + ), + line_break = NULL, + space = list( + indent_op = partial(indent_op, indent_by = 2) + ), + token = NULL, # transformer options use_raw_indention = FALSE, - reindention = specify_reindention(), - indent_character = " ", + reindention = specify_reindention(), + indent_character = " ", NULL ) diff --git a/R/transform-files.R b/R/transform-files.R index cf527a16a..7ca49bb38 100644 --- a/R/transform-files.R +++ b/R/transform-files.R @@ -329,8 +329,9 @@ apply_transformers <- function(pd_nested, transformers) { transformed_updated_multi_line <- post_visit( pd_nested, c( - transformers$initialize, transformers$line_break, set_multi_line, - if (length(transformers$line_break) != 0) update_newlines + transformers$initialize, transformers$line_break, + set_multi_line = set_multi_line, + update_newlines = if (length(transformers$line_break) != 0) update_newlines ) ) diff --git a/R/visit.R b/R/visit.R index a05ff54f8..d4ca38166 100644 --- a/R/visit.R +++ b/R/visit.R @@ -23,17 +23,9 @@ pre_visit <- function(pd_nested, funs) { if (length(funs) == 0) { return(pd_nested) } - pd_nested <- visit_one(pd_nested, funs) - children <- pd_nested$child - for (i in seq_along(children)) { - child <- children[[i]] - if (!is.null(child)) { - children[[i]] <- pre_visit(child, funs) - } - } - pd_nested$child <- children - pd_nested + fun <- make_visit_one(funs) + pre_visit_one(pd_nested, fun) } #' @rdname visit @@ -65,16 +57,8 @@ post_visit <- function(pd_nested, funs) { return(pd_nested) } - children <- pd_nested$child - for (i in seq_along(children)) { - child <- children[[i]] - if (!is.null(child)) { - children[[i]] <- post_visit(child, funs) - } - } - pd_nested$child <- children - - visit_one(pd_nested, funs) + fun <- make_visit_one(funs) + post_visit_one(pd_nested, fun) } #' @rdname visit @@ -99,17 +83,33 @@ post_visit_one <- function(pd_nested, fun) { #' Transform a flat parse table with a list of transformers #' -#' Uses [Reduce()] to apply each function of `funs` sequentially to -#' `pd_flat`. +#' Creates a single transformer function from a list of transformer functions. +#' +#' @details +#' For an input of the form `list(f1 = f1, f2 = f2)`, creates a function +#' +#' ```r +#' function(pd_flat) { +#' pd_flat <- f1(pd_flat) +#' pd_flat <- f2(pd_flat) +#' pd_flat +#' } +#' ``` +#' +#' The function's environment is constructed from `rlang::as_environment(funs)`. +#' This makes function sequences called by visitors interpretable in profiling. +#' #' @param pd_flat A flat parse table. -#' @param funs A list of transformer functions. +#' @param funs A named list of transformer functions. #' @family visitors #' @keywords internal -visit_one <- function(pd_flat, funs) { - for (f in funs) { - pd_flat <- f(pd_flat) - } - pd_flat +make_visit_one <- function(funs) { + calls <- map(rlang::syms(names(funs)), ~ rlang::expr(pd_flat <- (!!.x)(pd_flat))) + all_calls <- c(calls, rlang::expr(pd_flat)) + body <- rlang::call2("{", !!!all_calls) + + env <- rlang::as_environment(funs, rlang::base_env()) + rlang::new_function(rlang::pairlist2(pd_flat = ), body, env) } #' Propagate context to terminals diff --git a/man/visit.Rd b/man/visit.Rd index f2a757fc9..8c760bf7b 100644 --- a/man/visit.Rd +++ b/man/visit.Rd @@ -18,8 +18,6 @@ post_visit_one(pd_nested, fun) } \arguments{ \item{pd_nested}{A nested parse table.} - -\item{funs}{A list of transformer functions.} } \description{ Apply a list of functions to each level in a nested parse table. @@ -31,7 +29,7 @@ to the innermost level of nesting first and then going outwards). } \seealso{ Other visitors: -\code{\link{visit_one}()} +\code{\link{make_visit_one}()} } \concept{visitors} \keyword{internal} diff --git a/man/visit_one.Rd b/man/visit_one.Rd deleted file mode 100644 index 7a3bdce6b..000000000 --- a/man/visit_one.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/visit.R -\name{visit_one} -\alias{visit_one} -\title{Transform a flat parse table with a list of transformers} -\usage{ -visit_one(pd_flat, funs) -} -\arguments{ -\item{pd_flat}{A flat parse table.} - -\item{funs}{A list of transformer functions.} -} -\description{ -Uses \code{\link[=Reduce]{Reduce()}} to apply each function of \code{funs} sequentially to -\code{pd_flat}. -} -\seealso{ -Other visitors: -\code{\link{visit}} -} -\concept{visitors} -\keyword{internal} diff --git a/tests/testthat/test-indent-character.R b/tests/testthat/test-indent-character.R index 855cb468c..ca7ca7957 100644 --- a/tests/testthat/test-indent-character.R +++ b/tests/testthat/test-indent-character.R @@ -1,7 +1,9 @@ test_that("indention character can be arbitrary", { sg <- function(indent_by = 1) { create_style_guide( - indention = list(purrr::partial(indent_braces, indent_by = indent_by)), + indention = list( + indent_braces = purrr::partial(indent_braces, indent_by = indent_by) + ), indent_character = "\t", style_guide_name = "test", style_guide_version = 1