Untracked: Rethrow UserErrors in exceptions

.Rbuildignore

@@ -2,3 +2,4 @@
 ^\.Rproj\.user$
 .*~
 ^\.circleci/config\.yml$
+^\.github/

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 <opensource@displayr.com>
 Maintainer: Displayr <opensource@displayr.com>
 Description: Functions for extracting data from formulas and

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,43 +53,57 @@ 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
     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))
-    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))
-        {
-            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)
+        }
     }
 }
 
 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)
 }
 
@@ -97,24 +115,24 @@ 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. ",
                            "It needs to be downloaded, unzipped and re-uploaded to be ",
                            "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
@@ -239,12 +257,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).
@@ -342,6 +360,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.