Script dryrun

R/automation.R

@@ -98,10 +98,12 @@ setMethod("scriptSavepoint", "Script", function(x) {
 #'
 #' @param dataset A crunch dataset
 #' @param script A path to a text file with crunch automation syntax
-#' or a string the syntax loaded in R.
+#' or a string the syntax loaded in R. If multiple paths are provided,
+#' they will be concatenated together and performed as a single script.
 #' @param is_file The default guesses whether a file or string was
 #' used in the `script` argument, but you can override the heuristics
 #' by specifying `TRUE` for a file, and `FALSE` for a string.
+#' @param ... Additional options, passed on to the API
 #'
 #' @return For `runCrunchAutomation()`: an updated dataset (invisibly),
 #' For `showScriptErrors()`, when run after a failure, a list with two items:
@@ -126,32 +128,68 @@ setMethod("scriptSavepoint", "Script", function(x) {
 #' }
 #' @export
 #' @seealso [`automation-undo`] & [`script-catalog`]
-runCrunchAutomation <- function(dataset, script, is_file = string_is_file_like(script)) {
+runCrunchAutomation <- function(dataset, script, is_file = NULL, ...) {
     reset_automation_error_env()
     stopifnot(is.dataset(dataset))
     stopifnot(is.character(script))
 
-    if (is_file) {
-        automation_error_env$file <- script
-        script <- readLines(script, encoding = "UTF-8", warn = FALSE)
+    if (is.null(is_file)) is_file <- strings_are_file_like(script)
+
+    if (all(is_file)) {
+        combined <- read_scripts(script)
+        automation_error_env$file <- combined$file
+        script <- combined$text
     } else {
         automation_error_env$file <- NULL
     }
-    if (length(script) != 1) script <- paste(script, collapse = "\n")
+    script <- paste(script, collapse = "\n")
 
     crPOST(
         shojiURL(dataset, "catalogs", "scripts"),
-        body = toJSON(wrapEntity(body = list(body = script))),
+        body = toJSON(wrapEntity(body = list(body = script, ...))),
         status.handlers = list(`400` = crunchAutomationErrorHandler)
     )
     invisible(refresh(dataset))
 }
 
-string_is_file_like <- function(x) {
-    length(x) == 1 && # length 1 string
-        !grepl("\\n", x) && # no new lines
+# Helper that combines multiple script text files
+read_scripts <- function(scripts) {
+    if (length(scripts) == 1) {
+        out <- list(text = readLines(scripts, encoding = "UTF-8", warn = FALSE), file = scripts)
+    } else {
+        text <- lapply(scripts, function(file) {
+            c(paste0("# ", file), readLines(file, encoding = "UTF-8", warn = FALSE))
+        })
+
+        # Calculate end by from cumulative sum
+        script_ends <- cumsum(lengths(text))
+        # Starts are 1, then the end of the previous one plus one
+        script_starts <- c(1, script_ends[-length(script_ends)] + 1)
+        file_info <- data.frame(
+            file = scripts,
+            start = script_starts,
+            end = script_ends,
+            stringsAsFactors = FALSE
+        )
+
+        out <- list(text = unlist(text), file = file_info)
+    }
+    out
+}
+
+# Helper that untangles the line numbers from combined text
+untangle_error_files <- function(errors, file_info) {
+    if (!is.data.frame(file_info)) return(errors)
+    errors$file <- as.character(cut(errors$line, c(0, file_info$end), labels = file_info$file))
+    # Usually you'd have to subtract 1 here, but because of comment line added, it is offset
+    errors$line <- errors$line - file_info$start[match(errors$file, file_info$file)]
+    errors
+}
+
+strings_are_file_like <- function(x) {
+    !grepl("\\n", x) & # no new lines
         # ends with a file extension ('.' + any num of letters/nums) or exists
-        (grepl("\\.[[:alnum:]]+$", x) || file.exists(x))
+        (grepl("\\.[[:alnum:]]+$", x) | file.exists(x))
 }
 
 # Where we store error information from crunch automation
@@ -169,7 +207,7 @@ showScriptErrors <- function() {
     if (is.null(out) || is.null(out$errors)) return(invisible(out))
 
     if (!is.null(out$file) && rstudio_markers_available()) {
-        make_rstudio_markers(out)
+        make_rstudio_markers(out$errors)
     } else {
         message(automation_errors_text(out$errors))
     }
@@ -185,9 +223,9 @@ make_rstudio_markers <- function(errors) {
     markers <- data.frame(
         type = "error",
         file = errors$file,
-        line = ifelse(is.na(errors$errors$line), 1, errors$errors$line),
-        column = ifelse(is.na(errors$errors$column), 1, errors$errors$column),
-        message = errors$errors$message,
+        line = ifelse(is.na(errors$line), 1, errors$line),
+        column = ifelse(is.na(errors$column), 1, errors$column),
+        message = errors$message,
         stringsAsFactors = FALSE
     )
     rstudioapi::sourceMarkers("crunchAutomation", markers)
@@ -215,10 +253,17 @@ crunchAutomationErrorHandler <- function(response) {
             }
         )
 
+        # Sometimes no further information is provided
+        if (length(errors) == 0) {
+            halt("Error when running Crunch Automation script, but no futher information is available.") # nocov
+        }
         errors <- do.call(
             function(...) rbind(..., stringsAsFactors = FALSE),
             errors
         )
+        if (is.data.frame(automation_error_env$file)) {
+            errors <- untangle_error_files(errors, automation_error_env$file)
+        }
 
         automation_error_env$errors <- errors
 
@@ -246,12 +291,10 @@ automation_errors_text <- function(errors, display_num = Inf) {
         errors <- errors[seq_len(display_num), ]
     }
 
-    out <- paste0(
-        " - ",
-        ifelse(is.na(errors$line), "", paste0("(line ", errors$line, ") ")),
-        errors$message,
-        collapse = "\n"
-    )
+    file_info <- if (length(unique(errors$file)) > 1) paste0(errors$file, ":") else ""
+    line_info <- ifelse(is.na(errors$line), "", paste0("(", file_info, "line ", errors$line, ") "))
+
+    out <- paste0(" - ", line_info, errors$message, collapse = "\n")
 
     if (orig_num_errors - display_num > 0) {
         out <- paste0(

tests/testthat/test-automation.R

@@ -1,11 +1,63 @@
 context("Automation")
 
-test_that("string_is_file_like behaves", {
-    expect_true(string_is_file_like("test.txt"))
-    expect_true(string_is_file_like("test.crunch"))
-    expect_false(string_is_file_like("RENAME v1 TO age;\nSET EXCLUSION v1 > 21;"))
-    expect_false(string_is_file_like("test1.txt\ntest2.txt"))
-    expect_false(string_is_file_like("test"))
+test_that("strings_are_file_like behaves", {
+    expect_true(strings_are_file_like("test.txt"))
+    expect_true(strings_are_file_like("test.crunch"))
+    expect_false(strings_are_file_like("RENAME v1 TO age;\nSET EXCLUSION v1 > 21;"))
+    expect_false(strings_are_file_like("test1.txt\ntest2.txt"))
+    expect_false(strings_are_file_like("test"))
+    expect_equal(strings_are_file_like(c("test.txt", "test")), c(TRUE, FALSE))
+})
+
+test_that("read_scripts works", {
+    temp1 <- tempfile()
+    writeLines(c("a", "b"), temp1)
+    temp2 <- tempfile()
+    writeLines(c("c", "d", "e"), temp2)
+
+    expect_equal(read_scripts(temp1), list(text = c("a", "b"), file = temp1))
+    expect_equal(
+        read_scripts(c(temp1, temp2)),
+        list(
+            text = c(paste0("# ", temp1), "a", "b", paste0("# ", temp2), "c", "d", "e"),
+            file = data.frame(
+                file = c(temp1, temp2),
+                start = c(1, 4),
+                end = c(3, 7),
+                stringsAsFactors = FALSE
+            )
+        )
+    )
+})
+
+test_that("untangle_error_files works", {
+    file_info <- data.frame(
+        file = c("f1.txt", "f2.txt"),
+        start = c(1, 4),
+        end = c(3, 7),
+        stringsAsFactors = FALSE
+    )
+
+    expect_equal(
+        untangle_error_files(data.frame(line = c(2, 3)), file_info),
+        data.frame(line = c(1, 2), file = c("f1.txt", "f1.txt"), stringsAsFactors = FALSE)
+    )
+
+    expect_equal(
+        untangle_error_files(data.frame(line = c(5, 6)), file_info),
+        data.frame(line = c(1, 2), file = c("f2.txt", "f2.txt"), stringsAsFactors = FALSE)
+    )
+
+    expect_equal(
+        untangle_error_files(data.frame(line = c(2, 7)), file_info),
+        data.frame(line = c(1, 3), file = c("f1.txt", "f2.txt"), stringsAsFactors = FALSE)
+    )
+
+    expect_equal(
+        untangle_error_files(data.frame(line = c(2, 100)), file_info),
+        data.frame(line = c(1, NA), file = c("f1.txt", NA), stringsAsFactors = FALSE)
+    )
+
 })
 
 with_mock_crunch({
@@ -215,6 +267,25 @@ with_mock_crunch({
             expected
         )
     })
+
+    test_that("multiple files are shown in errr text", {
+        expected <- " - (file1:line 1) Error 1\n - (file2:line 2) Error 2"
+        attr(expected, "truncated") <- FALSE
+
+        expect_equal(
+            automation_errors_text(
+                data.frame(
+                    file = c("file1", "file2"),
+                    column = NA,
+                    command = 1:2,
+                    line = 1:2,
+                    message = c("Error 1", "Error 2")
+                ),
+                2
+            ),
+            expected
+        )
+    })
 })
 
 with_test_authentication({
@@ -270,4 +341,4 @@ with_test_authentication({
         ds <- revertScript(ds, scripts(ds)[[1]])
         expect_false("cat_lgl" %in% names(ds))
     })
-})
+})