WIP #70

Author: gogonzo

R/qenv-class.R

@@ -14,26 +14,14 @@
 #' @exportClass qenv
 setClass(
   "qenv",
-  slots = c(env = "environment", code = "character", id = "integer", warnings = "character", messages = "character"),
+  slots = c(env = "environment", code = "list"),
   prototype = list(
-    env = new.env(parent = parent.env(.GlobalEnv)), code = character(0), id = integer(0),
-    warnings = character(0), messages = character(0)
+    env = new.env(parent = parent.env(.GlobalEnv)), code = list()
   )
 )
 
 #' It takes a `qenv` class and returns `TRUE` if the input is valid
 #' @name qenv-class
 #' @keywords internal
 setValidity("qenv", function(object) {
-  if (length(object@code) != length(object@id)) {
-    "@code and @id slots must have the same length."
-  } else if (length(object@code) != length(object@warnings)) {
-    "@code and @warnings slots must have the same length"
-  } else if (length(object@code) != length(object@messages)) {
-    "@code and @messages slots must have the same length"
-  } else if (any(duplicated(object@id))) {
-    "@id contains duplicated values."
-  } else {
-    TRUE
-  }
 })

R/qenv-eval_code.R

@@ -33,25 +33,20 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
     return(object)
   }
 
-  id <- sample.int(.Machine$integer.max, size = length(parsed_code))
-
-  object@id <- c(object@id, id)
   object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv))
-
   code_split <- split_code(paste(code, collapse = "\n"))
-  object@code <- c(object@code, unlist(code_split))
-
-  current_warnings <- rep("", length(parsed_code))
-  current_messages <- rep("", length(parsed_code))
 
   for (i in seq_along(code_split)) {
-    single_call <- parse(text = code_split[[i]], keep.source = FALSE)
+    current_code <- code_split[[i]]
+    current_call <- parse(text = current_code, keep.source = FALSE)
+    new_object_code <- c(object@code, list(current_code))
+
     # Using withCallingHandlers to capture warnings and messages.
     # Using tryCatch to capture the error and abort further evaluation.
     x <- withCallingHandlers(
       tryCatch(
         {
-          eval(single_call, envir = object@env)
+          eval(current_call, envir = object@env)
           if (!identical(parent.env(object@env), parent.env(.GlobalEnv))) {
             # needed to make sure that @env is always a sibling of .GlobalEnv
             # could be changed when any new package is added to search path (through library or require call)
@@ -64,31 +59,30 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
             message = sprintf(
               "%s \n when evaluating qenv code:\n%s",
               .ansi_strip(conditionMessage(e)),
-              deparse1(single_call)
+              deparse1(current_call)
             ),
             class = c("qenv.error", "try-error", "simpleError"),
-            trace = object@code
+            trace = unlist(new_object_code)
           )
         }
       ),
       warning = function(w) {
-        current_warnings[i] <<- .ansi_strip(sprintf("> %s\n", conditionMessage(w)))
+        attr(current_code, "warning") <<- .ansi_strip(sprintf("> %s\n", conditionMessage(w)))
         invokeRestart("muffleWarning")
       },
       message = function(m) {
-        current_messages[i] <<- .ansi_strip(sprintf("> %s", conditionMessage(m)))
+        attr(current_code, "message") <<- .ansi_strip(sprintf("> %s", conditionMessage(m)))
         invokeRestart("muffleMessage")
       }
     )
 
     if (!is.null(x)) {
       return(x)
     }
-  }
-
 
-  object@warnings <- c(object@warnings, current_warnings)
-  object@messages <- c(object@messages, current_messages)
+    attr(current_code, "id") <- sample.int(.Machine$integer.max, size = 1)
+    object@code <- new_object_code
+  }
 
   lockEnvironment(object@env, bindings = TRUE)
   object

R/qenv-extract.R

@@ -36,13 +36,8 @@
   }
 
   limited_code <- get_code(x, names = names)
-  indexes <- which(x@code %in% limited_code)
-
   x@env <- list2env(mget(x = names, envir = get_env(x)))
   x@code <- limited_code
-  x@id <- x@id[indexes]
-  x@warnings <- x@warnings[indexes]
-  x@messages <- x@messages[indexes]
 
   x
 }

R/qenv-get_code.R

@@ -118,15 +118,16 @@ setMethod("get_code", signature = "qenv", function(object, deparse = TRUE, names
   }
 
   code <- if (!is.null(names)) {
+    # todo:
     get_code_dependency(object@code, names, ...)
   } else {
     object@code
   }
 
   if (deparse) {
-    code
+    unlist(code)
   } else {
-    parse(text = paste(c("{", code, "}"), collapse = "\n"), keep.source = TRUE)
+    parse(text = paste(c("{", unlist(code), "}"), collapse = "\n"), keep.source = TRUE)
   }
 })
 

R/utils-get_code_dependency.R

@@ -26,10 +26,10 @@
 #'
 #' @keywords internal
 get_code_dependency <- function(code, names, check_names = TRUE) {
-  checkmate::assert_character(code)
+  checkmate::assert_list(code, "character")
   checkmate::assert_character(names, any.missing = FALSE)
 
-  if (identical(code, character(0)) || identical(trimws(code), "")) {
+  if (length(code) == 0) {
     return(code)
   }
 

tests/testthat/test-qenv_get_code.R

@@ -460,7 +460,7 @@ testthat::test_that("comments fall into proper calls", {
     # finishing comment
   "
 
-  q <- qenv() |> eval_code(code)
+  q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q),
     c(