incorporate split_code into codebase

Author: m7pr

R/extract_code_as_is_prototype.R

@@ -45,7 +45,12 @@ get_line_ids <- function(pd) {
   Filter(Negate(is.null), c(list(first_comment_ids), call_ids, list(last_comment_ids)))
 }
 
-split_code <- function(code, lines_ids) {
+split_code <- function(code, parsed_code) {
+
+  pd <- utils::getParseData(parsed_code)
+  pd <- pd[pd$token != "';'", ]
+  lines_ids <- get_line_ids(pd)
+
   code_split <- strsplit(code, split = "\n", fixed = TRUE)[[1]]
   code_split_calls <- list()
 

R/qenv-eval_code.R

@@ -29,19 +29,19 @@ setGeneric("eval_code", function(object, code) standardGeneric("eval_code"))
 
 setMethod("eval_code", signature = c("qenv", "character"), function(object, code) {
   parsed_code <- parse(text = code, keep.source = TRUE)
-  comments <- extract_comments(parsed_code)
   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))
-  object@code <- c(object@code, trimws(paste(as.character(parsed_code), comments)))
+
+  code_split <- split_code(code, parsed_code)
+  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(parsed_code)) {
-    single_call <- parsed_code[i]
+  for (i in seq_along(code_split)) {
+    single_call <- parse(text = code_split[[i]], keep.source = FALSE)
     # Using withCallingHandlers to capture warnings and messages.
     # Using tryCatch to capture the error and abort further evaluation.
     x <- withCallingHandlers(

R/utils-get_code_dependency.R

@@ -39,12 +39,12 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
     code <- sub("^\\{(.*)\\}$", "\\1", tcode)
   }
 
-
-  code <- parse(text = code, keep.source = TRUE)
-  pd <- utils::getParseData(code)
+  code <- split_code(code, parsed_code)
+  parsed_code <- parse(text = code, keep.source = TRUE)
+  pd <- utils::getParseData(parsed_code)
   pd <- normalize_pd(pd)
   calls_pd <- extract_calls(pd)
-  comments <- extract_comments(code)
+  comments <- extract_comments(parsed_code)
 
   if (check_names) {
     # Detect if names are actually in code.
@@ -66,7 +66,8 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
   lib_ind <- detect_libraries(calls_pd)
 
   code_ids <- sort(unique(c(lib_ind, ind)))
-  trimws(paste(as.character(code[code_ids]), comments[code_ids]))
+  code[code_ids]
+  #trimws(paste(as.character(code[code_ids]), comments[code_ids]))
 }
 
 #' Locate function call token
@@ -141,12 +142,12 @@ get_children <- function(pd, parent) {
 #' Fixes edge case of comments being shifted to the next call.
 #' @keywords internal
 #' @noRd
-fix_shifted_comments <- function(calls, pattern = "@linksto") {
+fix_shifted_comments <- function(calls) {
   # If the first or the second token is a @linksto COMMENT,
   #  then it belongs to the previous call.
   if (length(calls) >= 2) {
     for (i in 2:length(calls)) {
-      comment_idx <- grep(pattern, calls[[i]][, "text"])
+      comment_idx <- grep("@linksto", calls[[i]][, "text"])
       if (isTRUE(comment_idx[1] <= 2)) {
         calls[[i - 1]] <- rbind(
           calls[[i - 1]],
@@ -156,20 +157,7 @@ fix_shifted_comments <- function(calls, pattern = "@linksto") {
       }
     }
   }
-  calls <- Filter(nrow, calls)
-  # If, after shifting, there are two COMMENTs in one call, paste them.
-  merge_comments <- function(call) {
-    if (sum(call$token == "COMMENT") >= 2) {
-      comments <- call[call$token == "COMMENT", "text"]
-      first_comment_row <- call[which(call$token == "COMMENT")[1], ]
-      call <- call[call$token != "COMMENT", ]
-      first_comment_row$text <- paste(comments, collapse = " ")
-      rbind(call, first_comment_row)
-    } else {
-      call
-    }
-  }
-  lapply(calls, merge_comments)
+  Filter(nrow, calls)
 }
 
 #' Fixes edge case of `<-` assignment operator being called as function,