#133 code parser alternative (#146)

Fixes #133 

Alternative to #139

---------

Signed-off-by: Marcin <[email protected]>
Co-authored-by: go_gonzo <[email protected]>
Co-authored-by: Aleksander Chlebowski <[email protected]>
Co-authored-by: Dawid Kałędkowski <[email protected]>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: Aleksander Chlebowski <[email protected]>

Author: 5 people

.gitignore

@@ -27,3 +27,4 @@ tmp.*
 vignettes/*.R
 vignettes/*.html
 vignettes/*.md
+tests/testthat/Rplots.pdf

DESCRIPTION

@@ -61,4 +61,5 @@ Collate:
     'qenv-show.R'
     'qenv-within.R'
     'teal.code-package.R'
+    'utils-code_dependency.R'
     'utils.R'

NEWS.md

@@ -1,5 +1,7 @@
 # teal.code 0.4.1.9001
 
+* The `@code` field in the `qenv` class now holds `character`, not `expression`.
+
 # teal.code 0.4.1
 
 ### Miscellaneous

R/qenv-class.R

@@ -3,7 +3,7 @@
 #' Reproducible class with environment and code.
 #' @name qenv-class
 #' @rdname qenv-class
-#' @slot code (`expression`) to reproduce the environment
+#' @slot code (`character`) representing code necessary to reproduce the environment
 #' @slot env (`environment`) environment which content was generated by the evaluation
 #'  of the `code` slot.
 #' @slot id (`integer`) random identifier of the code element to make sure uniqueness
@@ -13,9 +13,9 @@
 #' @keywords internal
 setClass(
   "qenv",
-  slots = c(env = "environment", code = "expression", id = "integer", warnings = "character", messages = "character"),
+  slots = c(env = "environment", code = "character", id = "integer", warnings = "character", messages = "character"),
   prototype = list(
-    env = new.env(parent = parent.env(.GlobalEnv)), code = expression(), id = integer(0),
+    env = new.env(parent = parent.env(.GlobalEnv)), code = character(0), id = integer(0),
     warnings = character(0), messages = character(0)
   )
 )

R/qenv-constructor.R

@@ -10,27 +10,21 @@
 #'
 #' @examples
 #' new_qenv(env = list2env(list(a = 1)), code = quote(a <- 1))
-#' new_qenv(env = list2env(list(a = 1)), code = parse(text = "a <- 1"))
+#' new_qenv(env = list2env(list(a = 1)), code = parse(text = "a <- 1", keep.source = TRUE))
 #' new_qenv(env = list2env(list(a = 1)), code = "a <- 1")
 #'
 #' @return `qenv` object.
 #'
 #' @export
-setGeneric("new_qenv", function(env = new.env(parent = parent.env(.GlobalEnv)), code = expression()) standardGeneric("new_qenv")) # nolint
+setGeneric("new_qenv", function(env = new.env(parent = parent.env(.GlobalEnv)), code = character()) standardGeneric("new_qenv")) # nolint
 
 #' @rdname new_qenv
 #' @export
 setMethod(
   "new_qenv",
   signature = c(env = "environment", code = "expression"),
   function(env, code) {
-    new_env <- rlang::env_clone(env, parent = parent.env(.GlobalEnv))
-    lockEnvironment(new_env, bindings = TRUE)
-    id <- sample.int(.Machine$integer.max, size = length(code))
-    methods::new(
-      "qenv",
-      env = new_env, code = code, warnings = rep("", length(code)), messages = rep("", length(code)), id = id
-    )
+    new_qenv(env, format_expression(code))
   }
 )
 
@@ -40,7 +34,14 @@ setMethod(
   "new_qenv",
   signature = c(env = "environment", code = "character"),
   function(env, code) {
-    new_qenv(env, code = parse(text = code, keep.source = FALSE))
+    new_env <- rlang::env_clone(env, parent = parent.env(.GlobalEnv))
+    lockEnvironment(new_env, bindings = TRUE)
+    if (length(code) > 0) code <- paste(code, collapse = "\n")
+    id <- sample.int(.Machine$integer.max, size = length(code))
+    methods::new(
+      "qenv",
+      env = new_env, code = code, warnings = rep("", length(code)), messages = rep("", length(code)), id = id
+    )
   }
 )
 
@@ -50,8 +51,7 @@ setMethod(
   "new_qenv",
   signature = c(env = "environment", code = "language"),
   function(env, code) {
-    code_expr <- as.expression(code)
-    new_qenv(env = env, code = code_expr)
+    new_qenv(env = env, code = format_expression(code))
   }
 )
 

R/qenv-eval_code.R

@@ -21,31 +21,33 @@ setGeneric("eval_code", function(object, code) standardGeneric("eval_code"))
 
 #' @rdname eval_code
 #' @export
-setMethod("eval_code", signature = c("qenv", "expression"), function(object, code) {
-  id <- sample.int(.Machine$integer.max, size = length(code))
+setMethod("eval_code", signature = c("qenv", "character"), function(object, code) {
+  id <- sample.int(.Machine$integer.max, size = 1)
 
   object@id <- c(object@id, id)
   object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv))
+  code <- paste(code, collapse = "\n")
   object@code <- c(object@code, code)
 
   current_warnings <- ""
   current_messages <- ""
 
-  for (code_line in code) {
-    # Using withCallingHandlers to capture ALL warnings and messages.
-    # Using tryCatch to capture the FIRST error and abort further evaluation.
+  parsed_code <- parse(text = code, keep.source = TRUE)
+  for (single_call in parsed_code) {
+    # Using withCallingHandlers to capture warnings and messages.
+    # Using tryCatch to capture the error and abort further evaluation.
     x <- withCallingHandlers(
       tryCatch(
         {
-          eval(code_line, envir = object@env)
+          eval(single_call, envir = object@env)
           NULL
         },
         error = function(e) {
           errorCondition(
             message = sprintf(
               "%s \n when evaluating qenv code:\n%s",
               .ansi_strip(conditionMessage(e)),
-              paste(format_expression(code), collapse = "\n")
+              deparse1(single_call)
             ),
             class = c("qenv.error", "try-error", "simpleError"),
             trace = object@code
@@ -61,28 +63,30 @@ setMethod("eval_code", signature = c("qenv", "expression"), function(object, cod
         invokeRestart("muffleMessage")
       }
     )
+
     if (!is.null(x)) {
       return(x)
     }
-
-    object@warnings <- c(object@warnings, current_warnings)
-    object@messages <- c(object@messages, current_messages)
   }
+
+
+  object@warnings <- c(object@warnings, current_warnings)
+  object@messages <- c(object@messages, current_messages)
+
   lockEnvironment(object@env, bindings = TRUE)
   object
 })
 
 #' @rdname eval_code
 #' @export
 setMethod("eval_code", signature = c("qenv", "language"), function(object, code) {
-  code_char <- as.expression(code)
-  eval_code(object, code_char)
+  eval_code(object, code = format_expression(code))
 })
 
 #' @rdname eval_code
 #' @export
-setMethod("eval_code", signature = c("qenv", "character"), function(object, code) {
-  eval_code(object, code = parse(text = code, keep.source = FALSE))
+setMethod("eval_code", signature = c("qenv", "expression"), function(object, code) {
+  eval_code(object, code = format_expression(code))
 })
 
 #' @rdname eval_code

R/qenv-get_code.R

@@ -26,9 +26,9 @@ setGeneric("get_code", function(object, deparse = TRUE) {
 setMethod("get_code", signature = "qenv", function(object, deparse = TRUE) {
   checkmate::assert_flag(deparse)
   if (deparse) {
-    format_expression(object@code)
-  } else {
     object@code
+  } else {
+    parse(text = object@code, keep.source = TRUE)
   }
 })