From 066dd4fd2488d91c5b9d788aaf54ca72059e7cc2 Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 27 Nov 2023 16:50:18 +0530 Subject: [PATCH 1/6] update get_code method to retun single concatneted string. --- NEWS.md | 1 + R/qenv-get_code.R | 6 +++++- R/qenv-get_warnings.R | 2 +- R/qenv-replace_code.R | 9 +++++++-- README.md | 2 +- tests/testthat/test-qenv-replace_code.R | 4 +++- tests/testthat/test-qenv-within.R | 4 ++-- tests/testthat/test-qenv_get_code.R | 4 ++-- vignettes/qenv.Rmd | 2 +- 9 files changed, 23 insertions(+), 11 deletions(-) diff --git a/NEWS.md b/NEWS.md index dd3bf91dd..a5bcb0f29 100644 --- a/NEWS.md +++ b/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 diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R index 0c23cb8df..52e801d6c 100644 --- a/R/qenv-get_code.R +++ b/R/qenv-get_code.R @@ -27,7 +27,11 @@ 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 || identical(object@code, "")) { + character(0) + } else { + paste(object@code, collapse = "\n") + } } else { parse(text = object@code, keep.source = TRUE) } diff --git a/R/qenv-get_warnings.R b/R/qenv-get_warnings.R index e8ec714db..b69596be2 100644 --- a/R/qenv-get_warnings.R +++ b/R/qenv-get_warnings.R @@ -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) ) }) diff --git a/R/qenv-replace_code.R b/R/qenv-replace_code.R index 45f0f0cdd..694d1e566 100644 --- a/R/qenv-replace_code.R +++ b/R/qenv-replace_code.R @@ -32,8 +32,13 @@ 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 }) diff --git a/README.md b/README.md index 4f69171b6..357b32fae 100644 --- a/README.md +++ b/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 diff --git a/tests/testthat/test-qenv-replace_code.R b/tests/testthat/test-qenv-replace_code.R index 78b50f12a..c2a12a078 100644 --- a/tests/testthat/test-qenv-replace_code.R +++ b/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 ---- diff --git a/tests/testthat/test-qenv-within.R b/tests/testthat/test-qenv-within.R index cc9e278f5..6f337c072 100644 --- a/tests/testthat/test-qenv-within.R +++ b/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") ) }) diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R index e60ac5f2d..6346445e6 100644 --- a/tests/testthat/test-qenv_get_code.R +++ b/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,7 +13,7 @@ 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", { diff --git a/vignettes/qenv.Rmd b/vignettes/qenv.Rmd index 5b0a8c73e..964e762d2 100644 --- a/vignettes/qenv.Rmd +++ b/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 From 744968b2f476a9bd223d1268e618c78028a8af8b Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 27 Nov 2023 16:51:06 +0530 Subject: [PATCH 2/6] fixing styling. --- R/qenv-get_code.R | 2 +- R/qenv-replace_code.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R index 52e801d6c..17b7f887c 100644 --- a/R/qenv-get_code.R +++ b/R/qenv-get_code.R @@ -27,7 +27,7 @@ setGeneric("get_code", function(object, deparse = TRUE, ...) { setMethod("get_code", signature = "qenv", function(object, deparse = TRUE) { checkmate::assert_flag(deparse) if (deparse) { - if(length(object@code) == 0 || identical(object@code, "")) { + if (length(object@code) == 0 || identical(object@code, "")) { character(0) } else { paste(object@code, collapse = "\n") diff --git a/R/qenv-replace_code.R b/R/qenv-replace_code.R index 694d1e566..bc03c40c2 100644 --- a/R/qenv-replace_code.R +++ b/R/qenv-replace_code.R @@ -34,7 +34,7 @@ setMethod("replace_code", signature = c("qenv", "character"), function(object, c masked_code <- get_code(object) code_lines <- unlist(strsplit(masked_code, "\n")) - if(!is.null(code_lines)) { + if (!is.null(code_lines)) { code_lines[length(code_lines)] <- code object@code <- paste(code_lines, collapse = "\n") } From 6aece426055cdd42de07d3df12516f7f65babb7c Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 27 Nov 2023 17:15:36 +0530 Subject: [PATCH 3/6] simplyfying logic --- R/qenv-get_code.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R index 17b7f887c..b995d7446 100644 --- a/R/qenv-get_code.R +++ b/R/qenv-get_code.R @@ -27,8 +27,8 @@ setGeneric("get_code", function(object, deparse = TRUE, ...) { setMethod("get_code", signature = "qenv", function(object, deparse = TRUE) { checkmate::assert_flag(deparse) if (deparse) { - if (length(object@code) == 0 || identical(object@code, "")) { - character(0) + if (length(object@code) == 0) { + object@code } else { paste(object@code, collapse = "\n") } From 0b4905e1c3e44514f0af1f7ec0767a30b330647e Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 27 Nov 2023 18:08:46 +0530 Subject: [PATCH 4/6] removed format_expression function --- NEWS.md | 1 + R/qenv-constructor.R | 4 ++-- R/qenv-eval_code.R | 4 ++-- R/qenv-get_code.R | 2 +- R/qenv-get_warnings.R | 2 +- R/qenv-replace_code.R | 4 ++-- R/utils.R | 6 ----- tests/testthat/test-utils.R | 44 ------------------------------------- 8 files changed, 9 insertions(+), 58 deletions(-) diff --git a/NEWS.md b/NEWS.md index a5bcb0f29..637a5ca57 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,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. +* Removed internal `format_expression` function. # teal.code 0.4.1 diff --git a/R/qenv-constructor.R b/R/qenv-constructor.R index 694623a85..ed7969847 100644 --- a/R/qenv-constructor.R +++ b/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")) } ) diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R index b3dbe16e6..c95d181b7 100644 --- a/R/qenv-eval_code.R +++ b/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 diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R index b995d7446..281ebea6d 100644 --- a/R/qenv-get_code.R +++ b/R/qenv-get_code.R @@ -45,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") ) diff --git a/R/qenv-get_warnings.R b/R/qenv-get_warnings.R index b69596be2..8807593e5 100644 --- a/R/qenv-get_warnings.R +++ b/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)) diff --git a/R/qenv-replace_code.R b/R/qenv-replace_code.R index bc03c40c2..f3ceb99be 100644 --- a/R/qenv-replace_code.R +++ b/R/qenv-replace_code.R @@ -44,12 +44,12 @@ setMethod("replace_code", signature = c("qenv", "character"), function(object, c #' @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 diff --git a/R/utils.R b/R/utils.R index ae090be55..e5a475764 100644 --- a/R/utils.R +++ b/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 diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 52da288c4..6ec1f89d2 100644 --- a/tests/testthat/test-utils.R +++ b/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}" - ) - } -) From 26a27ff332bbd103114e7ecadcf534c2ba5c1d80 Mon Sep 17 00:00:00 2001 From: kartikeya kirar Date: Tue, 28 Nov 2023 12:14:56 +0530 Subject: [PATCH 5/6] Update NEWS.md Co-authored-by: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Signed-off-by: kartikeya kirar --- NEWS.md | 1 - 1 file changed, 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 637a5ca57..a5bcb0f29 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,7 +5,6 @@ * 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. -* Removed internal `format_expression` function. # teal.code 0.4.1 From af08aea8cedbbbabc6ffb4b7274c0a65c70c00d3 Mon Sep 17 00:00:00 2001 From: unknown Date: Tue, 28 Nov 2023 20:51:54 +0530 Subject: [PATCH 6/6] return expression of length(1) --- R/qenv-get_code.R | 2 +- tests/testthat/test-qenv_get_code.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R index 281ebea6d..167ddf516 100644 --- a/R/qenv-get_code.R +++ b/R/qenv-get_code.R @@ -33,7 +33,7 @@ setMethod("get_code", signature = "qenv", function(object, deparse = TRUE) { paste(object@code, collapse = "\n") } } else { - parse(text = object@code, keep.source = TRUE) + parse(text = paste(c("{", object@code, "}"), collapse = "\n"), keep.source = TRUE) } }) diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R index 6346445e6..609203773 100644 --- a/tests/testthat/test-qenv_get_code.R +++ b/tests/testthat/test-qenv_get_code.R @@ -21,7 +21,7 @@ testthat::test_that("get_code returns expression of qenv object if deparse = FAL 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)) ) })