diff --git a/R/reprex.R b/R/reprex.R index b117e8f3..08171675 100644 --- a/R/reprex.R +++ b/R/reprex.R @@ -37,6 +37,7 @@ #' reprex({y <- 1:4; mean(y)}) #' #' # note that you can include newlines in those brackets +#' # in fact, that is probably a good idea #' reprex({ #' x <- 1:4 #' y <- 2:5 @@ -54,8 +55,8 @@ reprex <- function(x = NULL, infile = NULL, venue = c("gh", "so"), ## Do not rearrange this block lightly. If x is expression, take care to not ## evaluate in this frame. - x_uneval <- substitute(x) - if (is.null(x_uneval)) { + x_captured <- substitute(x) + if (is.null(x_captured)) { if (is.null(infile)) { the_source <- clipr::read_clip() } else { @@ -65,7 +66,7 @@ reprex <- function(x = NULL, infile = NULL, venue = c("gh", "so"), if (!is.null(infile)) { message("Input file ignored in favor of expression input in `x`.") } - the_source <- format_deparsed(deparse(x_uneval)) + the_source <- stringify_expression(x_captured) } the_source <- ensure_not_empty(the_source) diff --git a/R/stringify_expression.R b/R/stringify_expression.R new file mode 100644 index 00000000..fbaffcaa --- /dev/null +++ b/R/stringify_expression.R @@ -0,0 +1,58 @@ +## input is quoted()'ed expression +## reprex() takes care of that or, to use directly: +## q <- quote({a + b}) +stringify_expression <- function(q) { + src <- attr(q, "srcref") + + ## if input is, eg 1:5, there is no srcref + if (is.null(src)) { + return(deparse(q)) + } + + ## https://journal.r-project.org/archive/2010-2/RJournal_2010-2_Murdoch.pdf + ## Each element is a vector of 6 integers: (first line, first byte, last line, + ## last byte, first character, last character) + ## ^^ clearly not whole story because I see vectors of length 8 + ## but seems to be true description of first 6 elements + coord <- do.call(rbind, lapply(src, `[`, c(1, 5, 3, 6))) + colnames(coord) <- c("first_line", "first_character", + "last_line", "last_character") + n_statements <- nrow(coord) + ## each row holds coordinates of source for one statement + + ## all statements seem to contain such a reference to same lines of source + lines <- attr(src[[1]], "srcfile")$lines + + ## make sure source is split into character vector anticipated by coord + if (!isTRUE(attr(src[[1]], "srcfile")$fixedNewlines)) { + lines <- strsplit(lines, split = "\n")[[1]] + } + + lines <- lines[coord[1, "first_line"]:coord[n_statements, "last_line"]] + + ## line 1 needs to be pruned, possibly from both ends + ## default is this in order to retain end of line comments + line_1_end <- nchar(lines[1]) + ## but still have to worry about multiple statements in one line, eg {1:5;6:9} + if (n_statements > 1 && coord[2, "last_line", drop = TRUE] == 1) { + line_1 <- coord[ , "last_line", drop = TRUE] == 1 + line_1_end <- max(coord[line_1, "last_character"]) + } + lines[1] <- substr(lines[1], coord[1, "first_character"], line_1_end) + lines[1] <- sub("^\\{", "", lines[1]) + + ## last line may also need to be truncated + n_lines <- length(lines) + ## but don't do anything if line 1 == last line + if (n_statements > 1 && n_lines > 1) { + lines[n_lines] <- substr(lines[n_lines], + coord[n_statements, "first_character"], + coord[n_statements, "last_character"]) + } + + ## this needs to happen after (possibly) truncating last line + if (lines[1] == "" || grepl("^\\s+$", lines[1])) { + lines <- lines[-1] + } + lines +} diff --git a/R/utils.R b/R/utils.R index 8c193cb5..242f72b6 100644 --- a/R/utils.R +++ b/R/utils.R @@ -4,30 +4,6 @@ read_from_template <- function(SLUG) { readLines(SLUG_path) } - -#' format deparsed code, removing brackets and starts of lines if necessary -#' -#' @param deparsed A character vector from a use of deparse -format_deparsed <- function(deparsed) { - # if surrounded by brackets, remove them - if (length(deparsed) > 0 && - deparsed[1] == "{" && - utils::tail(deparsed, 1) == "}") { - deparsed <- utils::tail(utils::head(deparsed, -1), -1) - } - - # if all lines are indented (such as in expression), indent them to same degree - # (note that we're not trimming *all* starting whitespace) - indents <- stringr::str_match(deparsed, "^\\s+")[, 1] - if (!any(is.na(indents))) { - # all are indented at least a bit - deparsed <- stringr::str_sub(deparsed, - start = min(stringr::str_length(indents)) + 1) - } - - deparsed -} - ## from purrr, among other places `%||%` <- function(x, y) { if (is.null(x)) { diff --git a/man/format_deparsed.Rd b/man/format_deparsed.Rd deleted file mode 100644 index 256b4d80..00000000 --- a/man/format_deparsed.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{format_deparsed} -\alias{format_deparsed} -\title{format deparsed code, removing brackets and starts of lines if necessary} -\usage{ -format_deparsed(deparsed) -} -\arguments{ -\item{deparsed}{A character vector from a use of deparse} -} -\description{ -format deparsed code, removing brackets and starts of lines if necessary -} - diff --git a/man/reprex.Rd b/man/reprex.Rd index 4b2bf759..4ac8641d 100644 --- a/man/reprex.Rd +++ b/man/reprex.Rd @@ -52,6 +52,7 @@ reprex() reprex({y <- 1:4; mean(y)}) # note that you can include newlines in those brackets +# in fact, that is probably a good idea reprex({ x <- 1:4 y <- 2:5 diff --git a/tests/testthat/test-reprex.R b/tests/testthat/test-reprex.R index 379e3f93..b1c0f20f 100644 --- a/tests/testthat/test-reprex.R +++ b/tests/testthat/test-reprex.R @@ -34,7 +34,7 @@ test_that("expression input is not evaluated in environment of caller", { test_that("reprex doesn't write into environment of caller", { z <- "don't touch me" - ret <- reprex((z <- "I touched it!"))#,show = FALSE) + ret <- reprex((z <- "I touched it!"), show = FALSE) expect_identical(ret[3], "#> [1] \"I touched it!\"") expect_identical(z, "don't touch me") diff --git a/tests/testthat/test-stringify-expression.R b/tests/testthat/test-stringify-expression.R new file mode 100644 index 00000000..cfeaf93d --- /dev/null +++ b/tests/testthat/test-stringify-expression.R @@ -0,0 +1,72 @@ +context("expression stringification") + +test_that("one statement, naked", { + expect_identical(stringify_expression(1:5), "1:5") +}) + +test_that("one statement, brackets, one line", { + expect_identical(stringify_expression({1:5}), "1:5") +}) + +test_that("one statement, quoted, one line", { + expect_identical(stringify_expression(quote(mean(x))), "mean(x)") +}) + +test_that("one statement, brackets, multiple lines, take 1", { + expect_identical(stringify_expression({ + 1:5 + }), "1:5") +}) + +test_that("one statement, brackets, multiple lines, take 2", { + expect_identical(stringify_expression({1:5 + }), "1:5") +}) + +test_that("one statement, brackets, multiple lines, take 3", { + expect_identical(stringify_expression({ + 1:5}), "1:5") +}) + +# mystery to solve +# +# trying to test an expression like this: +# reprex({1:3;4:6}) +# which appears to work interactively +# but every way I think to test it fails :( +# test_that("multiple statements, brackets", { +# expect_identical(stringify_expression(quote({1:3;4:6})), "1:3;4:6") +# }) +# print(stringify_expression(quote({1:3;4:6}))) +# I have to use quote, but then that causes extra stuff to be absorbed into expr + +test_that("leading comment", { + ret <- stringify_expression(quote({ + #hi + mean(x) + })) + out <- c("#hi", "mean(x)") + expect_identical(trimws(ret), out) +}) + +test_that("embedded comment", { + out <- c("x <- 1:10", "## a comment", "y") + ret <- stringify_expression(quote({ + x <- 1:10 + ## a comment + y + })) + expect_identical(trimws(ret), out) + + ret <- stringify_expression(quote({x <- 1:10 + ## a comment + y + })) + expect_identical(trimws(ret), out) + + ret <- stringify_expression(quote({ + x <- 1:10 + ## a comment + y})) + expect_identical(trimws(ret), out) +})