feat: format errors

DESCRIPTION

@@ -23,14 +23,20 @@ Depends:
     R (>= 3.1),
     methods,
     progress,
-    R6
+    R6,
+Imports: 
+    cli, 
+    dplyr, 
+    purrr, 
+    stringr
 Suggests: 
-    testthat (>= 2.1.0)
+    testthat (>= 2.1.0),
+    DSLite
 License: LGPL (>= 2.1)
 URL: https://github.com/datashield/DSI/,
   https://datashield.github.io/DSI/, https://datashield.org/
 BugReports: https://github.com/datashield/DSI/issues
-RoxygenNote: 7.2.1
+RoxygenNote: 7.3.1
 Encoding: UTF-8
 Collate: 
     'DSObject.R'

NAMESPACE

@@ -59,3 +59,10 @@ exportClasses(DSResult)
 import(R6)
 import(methods)
 import(progress)
+importFrom(cli,cli_abort)
+importFrom(cli,cli_alert_warning)
+importFrom(cli,cli_bullets)
+importFrom(dplyr,"%>%")
+importFrom(purrr,imap_chr)
+importFrom(purrr,map)
+importFrom(stringr,str_replace_all)

R/datashield.errors.R

@@ -1,13 +1,62 @@
-#' List R last errors
+#' datashield.errors
 #'
-#' Get the R last errors available after the datashield.assign or datashield.aggregate calls in the Datashield R session.
+#' Retrieve and display the last errors occurred in a DataSHIELD session.
 #'
+#' This function retrieves the last errors occurred in a DataSHIELD session
+#' and displays them in a formatted manner using bullet points.
+#'
+#' @param type Specify format for return message. If type == "message", a formatted message is 
+#' returned. If type == "assign" a named vector is returned which will be formatted and returned 
+#' within datashield.assign.
+#' @return NULL if no errors are found, otherwise prints the errors.
+#' @importFrom cli cli_bullets
 #' @export
-datashield.errors <- function() {
+datashield.errors <- function(type = "message") {
   env <- getOption("datashield.env", globalenv())
   if (exists(".datashield.last_errors", envir = env)) {
-    get(".datashield.last_errors", envir = env)
+    errors <- get(".datashield.last_errors", envir = env)
+    neat <- .format_errors(errors)
+    if(type == "assign") {
+      return(neat) 
+    } else if(type == "message"){
+      cli_bullets(neat) 
+    }
+
   } else {
     NULL
   }
 }
+
+#' Format Errors
+#'
+#' Format errors into a character vector with specified prefix.
+#'
+#' This function formats a list of errors into a character vector with each
+#' error message prefixed by a cross.
+#'
+#' @param errors A list of errors to be formatted.
+#' @return A character vector containing formatted error messages.
+#' @importFrom dplyr %>%
+#' @importFrom purrr imap_chr
+#' @importFrom stringr str_replace_all
+#' @noRd
+.format_errors <- function(errors){
+  no_brackets <- .remove_curly_brackets(errors)
+  errors <- unlist(no_brackets)
+  names(errors) <- rep("x", length(errors))
+  return(errors)
+}
+
+#' Remove Curly Brackets from Strings
+#'
+#' This function replaces all curly brackets in the input strings with parentheses.
+#'
+#' @param errors A list of strings that may contain curly brackets.
+#' @return A list of strings with curly brackets replaced by parentheses.
+#' @importFrom purrr map
+#' @importFrom stringr str_replace_all
+.remove_curly_brackets <- function(errors) {
+  errors <- errors %>% map(~str_replace_all(.x, "\\{", "("))
+  errors <- errors %>% map(~str_replace_all(.x, "\\}", ")"))
+  return(errors)
+}

R/utils.R

@@ -114,13 +114,14 @@
 }
 
 #' Check if there are last errors
+#' @importFrom cli cli_abort cli_alert_warning
 #' @keywords internal
 .checkLastErrors <- function(env=getOption("datashield.env", globalenv())) {
   if (exists(".datashield.last_errors", envir = env)) {
     if (getOption("datashield.errors.stop", TRUE)) {
-      stop("There are some DataSHIELD errors, list them with datashield.errors()", call. = FALSE)
+      cli_abort("There are some DataSHIELD errors, list them with datashield.errors()", call = NULL)
     } else {
-      warning("There are some DataSHIELD errors, list them with datashield.errors()", call. = FALSE)
+      cli_alert_warning("There are some DataSHIELD errors, list them with datashield.errors()")
     }
   }
 }

tests/testthat/test-assign.R

@@ -0,0 +1,59 @@
+library(DSLite)
+library(testthat)
+library(dplyr)
+library(stringr)
+
+options(datashield.env = environment())
+data("mtcars")
+dslite.server <- DSLite::newDSLiteServer(tables = list(mtcars = mtcars))
+data("logindata.dslite.cnsim")
+logindata.dslite.cnsim <- logindata.dslite.cnsim %>%
+  mutate(table = "mtcars")
+dslite.server$config(defaultDSConfiguration(include = c("dsBase", "dsTidyverse", "dsDanger")))
+dslite.server$assignMethod("selectDS", "selectDS")
+dslite.server$aggregateMethod("exists", "base::exists")
+dslite.server$aggregateMethod("classDS", "dsBase::classDS")
+dslite.server$aggregateMethod("lsDS", "dsBase::lsDS")
+conns <- datashield.login(logins = logindata.dslite.cnsim, assign = TRUE)
+
+## ---- Assign expression --------------------------------------------------------------------------
+test_that("datashield.assign.expr returns 'datashield error' message when datashield.return_errors = FALSE", {
+  options("datashield.return_errors" = FALSE)
+  expect_error(
+    datashield.assign.expr(conns, symbol = "G", expr = "doesntwork"), 
+    "There are some DataSHIELD errors, list them with datashield.errors()"
+    )
+})
+
+test_that("datashield.assign.expr returns message when datashield.return_errors = TRUE", {
+  options("datashield.return_errors" = TRUE)
+  expect_error(
+    datashield.assign.expr(conns, symbol = "G", expr = "doesntwork"),
+  )
+})
+
+test_that("datashield.assign.expr throws error if external script called", {
+  options("datashield.return_errors" = TRUE)
+  expect_error(
+    source("testdata/r-fail-loop.R")
+  )
+})
+
+test_that("datashield.assign.expr throws error if external script called", {
+  options("datashield.return_errors" = FALSE)
+  expect_error(
+    source("testdata/r-fail-loop.R")
+  )
+})
+
+test_that("datashield.assign.expr doesn't return errors if there aren't any", {
+  cally <- call("absDS", 10)
+  options("datashield.return_errors" = FALSE)
+  expect_silent(
+    datashield.assign.expr(conns, symbol = "new_obj", expr = cally) 
+  )
+  options("datashield.return_errors" = TRUE)
+  expect_silent(
+    datashield.assign.expr(conns, symbol = "new_obj", expr = cally) 
+  )
+})