From a4c011beceb1b18e4d55fbf4b4b4ce5ce5a670cb Mon Sep 17 00:00:00 2001 From: Greg Freedman Ellis Date: Tue, 23 Mar 2021 14:46:01 -0500 Subject: [PATCH 1/5] Allow passing further options to script API --- R/automation.R | 5 +++-- man/runCrunchAutomation.Rd | 9 ++++++++- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/R/automation.R b/R/automation.R index a20b02055..d4eecb6ed 100644 --- a/R/automation.R +++ b/R/automation.R @@ -102,6 +102,7 @@ setMethod("scriptSavepoint", "Script", function(x) { #' @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,7 +127,7 @@ 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 = string_is_file_like(script), ...) { reset_automation_error_env() stopifnot(is.dataset(dataset)) stopifnot(is.character(script)) @@ -141,7 +142,7 @@ runCrunchAutomation <- function(dataset, script, is_file = string_is_file_like(s 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)) diff --git a/man/runCrunchAutomation.Rd b/man/runCrunchAutomation.Rd index 3fcd04874..5cdb5f475 100644 --- a/man/runCrunchAutomation.Rd +++ b/man/runCrunchAutomation.Rd @@ -5,7 +5,12 @@ \alias{showScriptErrors} \title{Run a crunch automation script} \usage{ -runCrunchAutomation(dataset, script, is_file = string_is_file_like(script)) +runCrunchAutomation( + dataset, + script, + is_file = string_is_file_like(script), + ... +) showScriptErrors() } @@ -18,6 +23,8 @@ or a string the syntax loaded in R.} \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), From 5866f49be77e13963ef9714b7820ee1763932642 Mon Sep 17 00:00:00 2001 From: Greg Freedman Ellis Date: Tue, 23 Mar 2021 15:08:21 -0500 Subject: [PATCH 2/5] Can perform multiple scripts as one --- R/automation.R | 35 +++++++++++++++++++++++--------- man/runCrunchAutomation.Rd | 10 +++------ tests/testthat/test-automation.R | 29 ++++++++++++++++++++------ 3 files changed, 51 insertions(+), 23 deletions(-) diff --git a/R/automation.R b/R/automation.R index d4eecb6ed..808441f07 100644 --- a/R/automation.R +++ b/R/automation.R @@ -98,7 +98,8 @@ 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. @@ -127,18 +128,21 @@ 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"), @@ -148,11 +152,22 @@ runCrunchAutomation <- function(dataset, script, is_file = string_is_file_like(s invisible(refresh(dataset)) } -string_is_file_like <- function(x) { - length(x) == 1 && # length 1 string - !grepl("\\n", x) && # no new lines +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)) + }) + out <- list(text = unlist(text), file = NULL) + } + out +} + +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 diff --git a/man/runCrunchAutomation.Rd b/man/runCrunchAutomation.Rd index 5cdb5f475..82bee64e8 100644 --- a/man/runCrunchAutomation.Rd +++ b/man/runCrunchAutomation.Rd @@ -5,12 +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() } @@ -18,7 +13,8 @@ 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 diff --git a/tests/testthat/test-automation.R b/tests/testthat/test-automation.R index bbab78aca..da433c0d8 100644 --- a/tests/testthat/test-automation.R +++ b/tests/testthat/test-automation.R @@ -1,11 +1,28 @@ 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"), 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"), + file = NULL + ) + ) }) with_mock_crunch({ From bac0145130d07e03641dbdbb4dcdf0a86c87898d Mon Sep 17 00:00:00 2001 From: Greg Freedman Ellis Date: Tue, 23 Mar 2021 15:11:57 -0500 Subject: [PATCH 3/5] protect against corner case hit during testing --- R/automation.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/automation.R b/R/automation.R index 808441f07..1b8a10fcc 100644 --- a/R/automation.R +++ b/R/automation.R @@ -231,6 +231,11 @@ 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 From efcbec140309b91cd23db463e6cb3daf75c49a4d Mon Sep 17 00:00:00 2001 From: Greg Freedman Ellis Date: Tue, 23 Mar 2021 16:00:50 -0500 Subject: [PATCH 4/5] untangle line numbers from combined scripts --- R/automation.R | 45 ++++++++++++++++------- tests/testthat/test-automation.R | 62 +++++++++++++++++++++++++++++--- 2 files changed, 91 insertions(+), 16 deletions(-) diff --git a/R/automation.R b/R/automation.R index 1b8a10fcc..ea4e22a29 100644 --- a/R/automation.R +++ b/R/automation.R @@ -152,6 +152,7 @@ runCrunchAutomation <- function(dataset, script, is_file = NULL, ...) { invisible(refresh(dataset)) } +# 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) @@ -159,11 +160,31 @@ read_scripts <- function(scripts) { text <- lapply(scripts, function(file) { c(paste0("# ", file), readLines(file, encoding = "UTF-8", warn = FALSE)) }) - out <- list(text = unlist(text), file = NULL) + + # 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 + ) + + 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 @@ -185,7 +206,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)) } @@ -201,9 +222,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) @@ -235,11 +256,13 @@ crunchAutomationErrorHandler <- function(response) { 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 @@ -267,12 +290,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/tests/testthat/test-automation.R b/tests/testthat/test-automation.R index da433c0d8..146b3cab2 100644 --- a/tests/testthat/test-automation.R +++ b/tests/testthat/test-automation.R @@ -13,18 +13,53 @@ test_that("read_scripts works", { temp1 <- tempfile() writeLines(c("a", "b"), temp1) temp2 <- tempfile() - writeLines(c("c", "d"), temp2) + 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"), - file = NULL + 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({ ds <- loadDataset("test ds") # 1 successful script ds2 <- loadDataset("ECON.sav") # no successful scripts @@ -232,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({ @@ -287,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 +}) From 20f18f0a65889ffa5c2d0096849a454de9c5e203 Mon Sep 17 00:00:00 2001 From: Greg Freedman Ellis Date: Tue, 23 Mar 2021 16:30:38 -0500 Subject: [PATCH 5/5] oops one missed stringsAsFactors --- R/automation.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/automation.R b/R/automation.R index ea4e22a29..8f202be8e 100644 --- a/R/automation.R +++ b/R/automation.R @@ -168,7 +168,8 @@ read_scripts <- function(scripts) { file_info <- data.frame( file = scripts, start = script_starts, - end = script_ends + end = script_ends, + stringsAsFactors = FALSE ) out <- list(text = unlist(text), file = file_info)