From ded1aa331ab883f4cb1c67e3fdf6e502aea4a6bf Mon Sep 17 00:00:00 2001 From: jrwishart Date: Sun, 12 Oct 2025 07:37:39 +1100 Subject: [PATCH 1/6] Untracked: Rethrow UserErrors in exceptions --- R/mergingandstackingutilities.R | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/R/mergingandstackingutilities.R b/R/mergingandstackingutilities.R index 4e518ce..e394730 100644 --- a/R/mergingandstackingutilities.R +++ b/R/mergingandstackingutilities.R @@ -61,9 +61,16 @@ createExceptionHandler <- function(intercept.messages, { if (length(replacement.messages) == 1 && length(intercept.messages) > 1) replacement.messages <- rep(replacement.messages, length(intercept.messages)) - condition.fun <- if (warn) warning else stop - function(e) - { + function(e) { + condition.fun <- function(...) { + if (warn) { + warning(..., call. = FALSE) + } else if (inherits(e, "UserError")) { + StopForUserError(...) + } else { + stop(..., call. = FALSE) + } + } msg.found <- FALSE for (i in seq_along(intercept.messages)) { From 0e2fdf9ba3a8f306a58addbf64d20ddf35455d40 Mon Sep 17 00:00:00 2001 From: jrwishart Date: Sun, 12 Oct 2025 09:09:28 +1100 Subject: [PATCH 2/6] fixup! Untracked: Rethrow UserErrors in exceptions --- R/mergingandstackingutilities.R | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/R/mergingandstackingutilities.R b/R/mergingandstackingutilities.R index e394730..6ed9284 100644 --- a/R/mergingandstackingutilities.R +++ b/R/mergingandstackingutilities.R @@ -56,10 +56,13 @@ readDataSetsFromDisplayrCloudDrive <- function(data.set.names) result } -createExceptionHandler <- function(intercept.messages, - replacement.messages, warn = FALSE) -{ - if (length(replacement.messages) == 1 && length(intercept.messages) > 1) +#' @importFrom flipU StopForUserError +createExceptionHandler <- function( + intercept.messages, + replacement.messages, + warn = FALSE +) { + if (length(replacement.messages) == 1 && length(intercept.messages) > 1) { replacement.messages <- rep(replacement.messages, length(intercept.messages)) function(e) { condition.fun <- function(...) { @@ -72,16 +75,15 @@ createExceptionHandler <- function(intercept.messages, } } msg.found <- FALSE - for (i in seq_along(intercept.messages)) - { - if (grepl(intercept.messages[i], e$message)) - { - condition.fun(replacement.messages[i], call. = FALSE) + for (i in seq_along(intercept.messages)) { + if (grepl(intercept.messages[i], e$message)) { + condition.fun(replacement.messages[i]) msg.found <- TRUE } } - if (!msg.found) - condition.fun(e$message, call. = FALSE) + if (!msg.found) { + condition.fun(e$message) + } } } From 038afdcdb0ea48427101f142edcad43a8154d8a6 Mon Sep 17 00:00:00 2001 From: jrwishart Date: Sun, 12 Oct 2025 09:10:10 +1100 Subject: [PATCH 3/6] Version bump --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9da6865..5bbfc97 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: flipData Type: Package Title: Functions for extracting and describing data -Version: 1.8.9 +Version: 1.8.10 Author: Displayr Maintainer: Displayr Description: Functions for extracting data from formulas and From 524e83c5a3f439c3d5ab545b049c7432a7be606d Mon Sep 17 00:00:00 2001 From: jrwishart Date: Mon, 13 Oct 2025 09:26:07 +1100 Subject: [PATCH 4/6] Some linting changes --- R/mergingandstackingutilities.R | 71 +++++++++++++++++++-------------- 1 file changed, 41 insertions(+), 30 deletions(-) diff --git a/R/mergingandstackingutilities.R b/R/mergingandstackingutilities.R index 6ed9284..ce23987 100644 --- a/R/mergingandstackingutilities.R +++ b/R/mergingandstackingutilities.R @@ -12,18 +12,22 @@ readDataSets <- function(data.set.names, min.data.sets = 1) data.set.names <- vapply(data.set.names, trimws, character(1), USE.NAMES = FALSE) - if (length(data.set.names) < min.data.sets) + if (length(data.set.names) < min.data.sets) { StopForUserError("At least ", min.data.sets, " data set(s) are required.") + } - if (!all(grepl('.+\\.sav$', data.set.names, ignore.case = TRUE))) { - StopForUserError("An input data file was not an SPSS .sav data file. ", - "Only SPSS .sav data files are accepted.") + if (!all(grepl(".+\\.sav$", data.set.names, ignore.case = TRUE))) { + StopForUserError( + "An input data file was not an SPSS .sav data file. ", + "Only SPSS .sav data files are accepted." + ) } - if (IsDisplayrCloudDriveAvailable()) + if (IsDisplayrCloudDriveAvailable()) { readDataSetsFromDisplayrCloudDrive(data.set.names) - else + } else { readLocalDataSets(data.set.names) + } } #' @param data.set.paths A character vector of paths to local data files. @@ -34,7 +38,7 @@ readDataSets <- function(data.set.names, min.data.sets = 1) readLocalDataSets <- function(data.set.paths, parser = read_sav) { result <- lapply(data.set.paths, function(path) { - handler = createReadErrorHandler(path) + handler <- createReadErrorHandler(path) InterceptExceptions(parser(path), error.handler = handler) }) names(result) <- basename(data.set.paths) @@ -49,7 +53,7 @@ readLocalDataSets <- function(data.set.paths, parser = read_sav) readDataSetsFromDisplayrCloudDrive <- function(data.set.names) { result <- lapply(data.set.names, function(nm) { - handler = createReadErrorHandler(nm) + handler <- createReadErrorHandler(nm) InterceptExceptions(QLoadData(nm), error.handler = handler) }) names(result) <- data.set.names @@ -89,12 +93,16 @@ createExceptionHandler <- function( createReadErrorHandler <- function(data.set.name) { - replacement.msg <- paste0("The data file '", data.set.name, "' could not be parsed. ", - "The data file may be fixed by inserting it in a Displayr document, ", - "exporting it as an SPSS file (.sav) via the Publish button, ", - "and then uploading it back to the cloud drive.") - intercept.msgs <- c("Invalid file, or file has unsupported features", - "Unable to convert string to the requested encoding") + replacement.msg <- paste0( + "The data file '", data.set.name, "' could not be parsed. ", + "The data file may be fixed by inserting it in a Displayr document, ", + "exporting it as an SPSS file (.sav) via the Publish button, ", + "and then uploading it back to the cloud drive." + ) + intercept.msgs <- c( + "Invalid file, or file has unsupported features", + "Unable to convert string to the requested encoding" + ) createExceptionHandler(intercept.msgs, replacement.msg, warn = FALSE) } @@ -106,10 +114,8 @@ createReadErrorHandler <- function(data.set.name) #' @importFrom flipAPI QSaveData IsDisplayrCloudDriveAvailable #' @importFrom flipU InterceptExceptions #' @importFrom tools file_path_sans_ext -writeDataSet <- function(data.set, data.set.name, is.saved.to.cloud) -{ - if (is.saved.to.cloud) - { +writeDataSet <- function(data.set, data.set.name, is.saved.to.cloud) { + if (is.saved.to.cloud) { warn.msg <- paste0("The data file ", data.set.name, " has been compressed into ", file_path_sans_ext(data.set.name), ".zip on the Cloud Drive as it is too large. ", @@ -117,13 +123,15 @@ writeDataSet <- function(data.set, data.set.name, is.saved.to.cloud) "used in a Displayr document.") error.msg <- paste0("The data file could not be saved due to invalid characters ", "in some of the variable names. Please contact support for assistance.") - InterceptExceptions(QSaveData(data.set, data.set.name, 2e9), # 2e9 bytes seems to be just below the API upload limit for the cloud drive - warning.handler = createExceptionHandler("Object compressed into a zip file", - warn.msg, TRUE), - error.handler = createExceptionHandler("must have valid SPSS variable names", - error.msg, FALSE)) - }else + # 2e9 bytes seems to be just below the API upload limit for the cloud drive + InterceptExceptions( + QSaveData(data.set, data.set.name, 2e9), + warning.handler = createExceptionHandler("Object compressed into a zip file", warn.msg, TRUE), + error.handler = createExceptionHandler("must have valid SPSS variable names", error.msg, FALSE) + ) + } else { write_sav(data.set, data.set.name) + } } #' @description Creates a list of metadata for a data set @@ -248,12 +256,12 @@ variableType <- function(variable) StopForUserError("Variable type not recognised") } -NUMERIC.VARIABLE.TYPE = "Numeric"; -TEXT.VARIABLE.TYPE = "Text"; -CATEGORICAL.VARIABLE.TYPE = "Categorical"; -DATE.VARIABLE.TYPE = "Date"; -DATE.TIME.VARIABLE.TYPE = "Date/Time"; -DURATION.VARIABLE.TYPE = "Duration"; +NUMERIC.VARIABLE.TYPE <- "Numeric" +TEXT.VARIABLE.TYPE <- "Text" +CATEGORICAL.VARIABLE.TYPE <- "Categorical" +DATE.VARIABLE.TYPE <- "Date" +DATE.TIME.VARIABLE.TYPE <- "Date/Time" +DURATION.VARIABLE.TYPE <- "Duration" #' @param var.types A character vector containing variable types (see function #' variableType). @@ -351,6 +359,9 @@ splitByComma <- function(input.text, ignore.commas.in.parentheses = FALSE) result <- result[result != ""] result } + result <- trimws(result) + result <- result[result != ""] + result } #' @param x A vector. From 578ea37da6b385b98375fd57d6ac21a05841bf51 Mon Sep 17 00:00:00 2001 From: jrwishart Date: Mon, 13 Oct 2025 09:26:37 +1100 Subject: [PATCH 5/6] Add .github to .Rbuildignore --- .Rbuildignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.Rbuildignore b/.Rbuildignore index 7856c9b..f925cfb 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -2,3 +2,4 @@ ^\.Rproj\.user$ .*~ ^\.circleci/config\.yml$ +^\.github/ From 63ffcf79df73f23cdd781a467f8d0083697300f5 Mon Sep 17 00:00:00 2001 From: jrwishart Date: Mon, 13 Oct 2025 10:00:52 +1100 Subject: [PATCH 6/6] Add missing brace --- R/mergingandstackingutilities.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/mergingandstackingutilities.R b/R/mergingandstackingutilities.R index ce23987..7523230 100644 --- a/R/mergingandstackingutilities.R +++ b/R/mergingandstackingutilities.R @@ -68,6 +68,7 @@ createExceptionHandler <- function( ) { if (length(replacement.messages) == 1 && length(intercept.messages) > 1) { replacement.messages <- rep(replacement.messages, length(intercept.messages)) + } function(e) { condition.fun <- function(...) { if (warn) {