diff --git a/R/automation.R b/R/automation.R index a20b02055..8f202be8e 100644 --- a/R/automation.R +++ b/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( diff --git a/man/runCrunchAutomation.Rd b/man/runCrunchAutomation.Rd index 3fcd04874..82bee64e8 100644 --- a/man/runCrunchAutomation.Rd +++ b/man/runCrunchAutomation.Rd @@ -5,7 +5,7 @@ \alias{showScriptErrors} \title{Run a crunch automation script} \usage{ -runCrunchAutomation(dataset, script, is_file = string_is_file_like(script)) +runCrunchAutomation(dataset, script, is_file = NULL, ...) showScriptErrors() } @@ -13,11 +13,14 @@ showScriptErrors() \item{dataset}{A crunch dataset} \item{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.} \item{is_file}{The default guesses whether a file or string was used in the \code{script} argument, but you can override the heuristics by specifying \code{TRUE} for a file, and \code{FALSE} for a string.} + +\item{...}{Additional options, passed on to the API} } \value{ For \code{runCrunchAutomation()}: an updated dataset (invisibly), diff --git a/tests/testthat/test-automation.R b/tests/testthat/test-automation.R index bbab78aca..146b3cab2 100644 --- a/tests/testthat/test-automation.R +++ b/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)) }) -}) \ No newline at end of file +})