implement expression processing suggested in #35; closes #35

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)

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
+}

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)) {

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")
 

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)
+})