get_code to return concatenated code string and removed format_expression

NEWS.md

@@ -4,6 +4,7 @@
 
 * Exported the `qenv` class from the package.
 * The `@code` field in the `qenv` class now holds `character`, not `expression`.
+* The `get_code` method  returns a single concatenated string of the code.
 
 # teal.code 0.4.1
 

R/qenv-constructor.R

@@ -24,7 +24,7 @@ setMethod(
   "new_qenv",
   signature = c(env = "environment", code = "expression"),
   function(env, code) {
-    new_qenv(env, format_expression(code))
+    new_qenv(env, paste(lang2calls(code), collapse = "\n"))
   }
 )
 
@@ -51,7 +51,7 @@ setMethod(
   "new_qenv",
   signature = c(env = "environment", code = "language"),
   function(env, code) {
-    new_qenv(env = env, code = format_expression(code))
+    new_qenv(env = env, code = paste(lang2calls(code), collapse = "\n"))
   }
 )
 

R/qenv-eval_code.R

@@ -85,13 +85,13 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
 #' @rdname eval_code
 #' @export
 setMethod("eval_code", signature = c("qenv", "language"), function(object, code) {
-  eval_code(object, code = format_expression(code))
+  eval_code(object, code = paste(lang2calls(code), collapse = "\n"))
 })
 
 #' @rdname eval_code
 #' @export
 setMethod("eval_code", signature = c("qenv", "expression"), function(object, code) {
-  eval_code(object, code = format_expression(code))
+  eval_code(object, code = paste(lang2calls(code), collapse = "\n"))
 })
 
 #' @rdname eval_code

R/qenv-get_code.R

@@ -27,9 +27,13 @@ setGeneric("get_code", function(object, deparse = TRUE, ...) {
 setMethod("get_code", signature = "qenv", function(object, deparse = TRUE) {
   checkmate::assert_flag(deparse)
   if (deparse) {
-    object@code
+    if (length(object@code) == 0) {
+      object@code
+    } else {
+      paste(object@code, collapse = "\n")
+    }
   } else {
-    parse(text = object@code, keep.source = TRUE)
+    parse(text = paste(c("{", object@code, "}"), collapse = "\n"), keep.source = TRUE)
   }
 })
 
@@ -41,7 +45,7 @@ setMethod("get_code", signature = "qenv.error", function(object) {
       sprintf(
         "%s\n\ntrace: \n %s\n",
         conditionMessage(object),
-        paste(format_expression(object$trace), collapse = "\n ")
+        paste(lang2calls(object$trace), collapse = "\n ")
       ),
       class = c("validation", "try-error", "simpleError")
     )

R/qenv-get_warnings.R

@@ -42,7 +42,7 @@ setMethod("get_warnings", signature = c("qenv"), function(object) {
       if (warn == "") {
         return(NULL)
       }
-      sprintf("%swhen running code:\n%s", warn, paste(format_expression(expr), collapse = "\n"))
+      sprintf("%swhen running code:\n%s", warn, paste(lang2calls(expr), collapse = "\n"))
     },
     warn = as.list(object@warnings),
     expr = as.list(as.character(object@code))
@@ -52,7 +52,7 @@ setMethod("get_warnings", signature = c("qenv"), function(object) {
   sprintf(
     "~~~ Warnings ~~~\n\n%s\n\n~~~ Trace ~~~\n\n%s",
     paste(lines, collapse = "\n\n"),
-    paste(get_code(object), collapse = "\n")
+    get_code(object)
   )
 })
 

R/qenv-replace_code.R

@@ -32,19 +32,24 @@ setGeneric("replace_code", function(object, code) standardGeneric("replace_code"
 #' @keywords internal
 setMethod("replace_code", signature = c("qenv", "character"), function(object, code) {
   masked_code <- get_code(object)
-  masked_code[length(masked_code)] <- code
-  object@code <- masked_code
+  code_lines <- unlist(strsplit(masked_code, "\n"))
+
+  if (!is.null(code_lines)) {
+    code_lines[length(code_lines)] <- code
+    object@code <- paste(code_lines, collapse = "\n")
+  }
+
   object
 })
 
 #' @keywords internal
 setMethod("replace_code", signature = c("qenv", "language"), function(object, code) {
-  replace_code(object, code = format_expression(code))
+  replace_code(object, code = paste(lang2calls(code), collapse = "\n"))
 })
 
 #' @keywords internal
 setMethod("replace_code", signature = c("qenv", "expression"), function(object, code) {
-  replace_code(object, code = format_expression(code))
+  replace_code(object, code = paste(lang2calls(code), collapse = "\n"))
 })
 
 #' @keywords internal

R/utils.R

@@ -24,12 +24,6 @@ dev_suppress <- function(x) {
   force(x)
 }
 
-format_expression <- function(code) {
-  code <- lang2calls(code)
-  paste(code, collapse = "\n")
-}
-
-
 # convert language object or lists of language objects to list of simple calls
 # @param x `language` object or a list of thereof
 # @return

README.md

@@ -88,7 +88,7 @@ qenv_2[["y"]]
 ```
 
 ```r
-cat(paste(get_code(qenv_2), collapse = "\n"))
+cat(get_code(qenv_2))
 #> x <- 5
 #> y <- x * 2
 #> z <- y * 2

tests/testthat/test-qenv-replace_code.R

@@ -30,7 +30,9 @@ testthat::test_that("code_replace replaces last element of the code", {
   qr <- replace_code(qq, replacement)
   previous <- get_code(qq)
   current <- get_code(qr)
-  testthat::expect_identical(current, c(head(previous, -1), replacement))
+
+  previous <- head(strsplit(previous, split = "\n")[[1]], -1)
+  testthat::expect_identical(current, paste0(c(previous, replacement), collapse = "\n"))
 })
 
 # edge cases ----

tests/testthat/test-qenv-within.R

@@ -29,7 +29,7 @@ testthat::test_that("styling of input code does not impact evaluation results",
   all_code <- get_code(q)
   testthat::expect_identical(
     all_code,
-    rep("1 + 1", 4L)
+    paste(rep("1 + 1", 4L), collapse = "\n")
   )
 
   q <- new_qenv()
@@ -48,7 +48,7 @@ testthat::test_that("styling of input code does not impact evaluation results",
   all_code <- get_code(q)
   testthat::expect_identical(
     all_code,
-    rep("1 + 1\n2 + 2", 4L)
+    paste(rep("1 + 1\n2 + 2", 4L), collapse = "\n")
   )
 })
 

tests/testthat/test-qenv_get_code.R

@@ -1,7 +1,7 @@
 testthat::test_that("get_code returns code (character by default) of qenv object", {
   q <- new_qenv(list2env(list(x = 1)), code = quote(x <- 1))
   q <- eval_code(q, quote(y <- x))
-  testthat::expect_equal(get_code(q), c("x <- 1", "y <- x"))
+  testthat::expect_equal(get_code(q), paste(c("x <- 1", "y <- x"), collapse = "\n"))
 })
 
 testthat::test_that("get_code returns code elements being code-blocks as character(1)", {
@@ -13,15 +13,15 @@ testthat::test_that("get_code returns code elements being code-blocks as charact
       z <- 5
     })
   )
-  testthat::expect_equal(get_code(q), c("x <- 1", "y <- x\nz <- 5"))
+  testthat::expect_equal(get_code(q), paste(c("x <- 1", "y <- x\nz <- 5"), collapse = "\n"))
 })
 
 testthat::test_that("get_code returns expression of qenv object if deparse = FALSE", {
   q <- new_qenv(list2env(list(x = 1)), code = quote(x <- 1))
   q <- eval_code(q, quote(y <- x))
   testthat::expect_equivalent(
     toString(get_code(q, deparse = FALSE)),
-    toString(parse(text = q@code, keep.source = TRUE))
+    toString(parse(text = paste(c("{", q@code, "}"), collapse = "\n"), keep.source = TRUE))
   )
 })
 

tests/testthat/test-utils.R

@@ -59,47 +59,3 @@ testthat::test_that("lang2calls returns atomics and symbols wrapped in list", {
   testthat::expect_identical(lang2calls(list("x")), list("x"))
   testthat::expect_identical(lang2calls(list(as.symbol("x"))), list(as.symbol("x")))
 })
-
-
-testthat::test_that(
-  "format_expression turns expression/calls or lists thereof into character strings without curly brackets",
-  {
-    expr1 <- expression({
-      i <- iris
-      m <- mtcars
-    })
-    expr2 <- expression(
-      i <- iris,
-      m <- mtcars
-    )
-    expr3 <- list(
-      expression(i <- iris),
-      expression(m <- mtcars)
-    )
-    cll1 <- quote({
-      i <- iris
-      m <- mtcars
-    })
-    cll2 <- list(
-      quote(i <- iris),
-      quote(m <- mtcars)
-    )
-
-    # function definition
-    fundef <- quote(
-      format_expression <- function(x) {
-        x + x
-        return(x)
-      }
-    )
-
-    testthat::expect_identical(format_expression(expr1), "i <- iris\nm <- mtcars")
-    testthat::expect_identical(format_expression(expr2), "i <- iris\nm <- mtcars")
-    testthat::expect_identical(format_expression(expr3), "i <- iris\nm <- mtcars")
-    testthat::expect_identical(format_expression(cll1), "i <- iris\nm <- mtcars")
-    testthat::expect_identical(format_expression(cll2), "i <- iris\nm <- mtcars")
-    testthat::expect_identical(
-      format_expression(fundef), "format_expression <- function(x) {\n    x + x\n    return(x)\n}"
-    )
-  }
-)

vignettes/qenv.Rmd

@@ -51,7 +51,7 @@ To extract objects from a `qenv`, use `[[`; this is particularly useful for disp
 ```{r}
 print(q2[["y"]])
 
-cat(paste(get_code(q2), collapse = "\n"))
+cat(get_code(q2))
 ```
 
 ### Substitutions