diff --git a/R/common.R b/R/common.R index 5d56e34e..c57ffbce 100644 --- a/R/common.R +++ b/R/common.R @@ -111,13 +111,15 @@ runJaspResults <- function(name, title, dataKey, options, stateKey, functionCall # ensure an analysis always starts with a clean hashtable of computed jasp Objects emptyRecomputed() + emptyWarnings() analysisResult <- tryCatch( - expr=withCallingHandlers(expr=analysis(jaspResults=jaspResults, dataset=dataset, options=options), error=.addStackTrace), + expr=withCallingHandlers(expr=analysis(jaspResults=jaspResults, dataset=dataset, options=options), error=.addStackTrace, warning = .addWarnings), error=function(e) e, jaspAnalysisAbort=function(e) e ) + .appendOutputFromR(jaspResults) if (!jaspResultsCalledFromJasp()) { diff --git a/R/commonerrorcheck.R b/R/commonerrorcheck.R index 8cc1c3dc..4aed13d6 100644 --- a/R/commonerrorcheck.R +++ b/R/commonerrorcheck.R @@ -46,6 +46,37 @@ signalCondition(e) } +.addWarnings <- function(w) { + .internal[["warnings"]] <- c(.internal[["warnings"]], list(w)) +} + +.appendOutputFromR <- function(container) { + warnings <- .internal[["warnings"]] + # display only in developer mode + # currently adds only warnings, do we also want messages or something? + if (!getDeveloperMode() || identical(warnings, list())) return() + + output <- createJaspContainer(title = gettext("Output from R"), initCollapsed = TRUE) + + # Adds a warning element to a jaspContainer + text <- vapply(warnings, function(w) { + # oh lord forgive me for the code I am about to write right now: + # as.character can produce special symbols that are used to render the text in a different format in the R console, so the warning may become unintelligible + # so instead we `cat()` the output which prints the formatted text + # and capture the output as text again (without formatting) + w <- capture.output(cat(as.character(w))) + w <- paste0(w, collapse = "
") + return(w) + }, character(1)) + + text <- paste0("
  • ", text, "

  • ", collapse = "") + text <- paste0("") + + output[["warnings"]] <- createJaspHtml(title = gettext("Warnings"), text = text) + + container[[".outputFromR"]] <- output +} + .generateErrorMessage <- function(type, opening=FALSE, concatenate=NULL, grouping=NULL, ...) { # Generic function to create an error message (mostly used by .hasErrors() but it can be called directly). diff --git a/R/setOrRetrieve.R b/R/setOrRetrieve.R index 9b52b834..30beaf97 100644 --- a/R/setOrRetrieve.R +++ b/R/setOrRetrieve.R @@ -2,7 +2,8 @@ # It's not 100% clear if "address" is the best choice here, but it should be a little bit faster than constructing hashes using identical. # See also https://github.com/wch/r-source/blob/trunk/src/library/utils/src/hashtab.c recomputedHashtab = hashtab(type = "address", NULL), - lastRecomputed = TRUE + lastRecomputed = TRUE, + warnings = list() ), parent = emptyenv()) saveHashOfJaspObject <- function(x) { @@ -20,6 +21,10 @@ emptyRecomputed <- function() { setRecomputed(TRUE) } +emptyWarnings <- function() { + .internal[["warnings"]] <- list() +} + #' Set or retrieve a jaspObject #' @description `%setOrRetrieve%` is a useful shorthand for a common pattern. #' @param lhs an assignment into a jaspObject, e.g., `container[["table"]]`. diff --git a/src/jaspModuleRegistration.h b/src/jaspModuleRegistration.h index 1f2cb456..df78be60 100644 --- a/src/jaspModuleRegistration.h +++ b/src/jaspModuleRegistration.h @@ -37,6 +37,7 @@ RCPP_MODULE(jaspResults) Rcpp::function("writeSealFilename", jaspResults::writeSealFilename); Rcpp::function("setResponseData", jaspResults::setResponseData); Rcpp::function("setDeveloperMode", jaspResults::setDeveloperMode); + Rcpp::function("getDeveloperMode", jaspResults::getDeveloperMode); Rcpp::function("setSaveLocation", jaspResults::setSaveLocation); Rcpp::function("setWriteSealLocation", jaspResults::setWriteSealLocation); diff --git a/src/jaspObject.cpp b/src/jaspObject.cpp index 9130e8cd..89e69eff 100644 --- a/src/jaspObject.cpp +++ b/src/jaspObject.cpp @@ -580,6 +580,11 @@ void jaspObject::setDeveloperMode(bool developerMode) _developerMode = developerMode; } +bool jaspObject::getDeveloperMode() +{ + return _developerMode; +} + bool jaspObject::connectedToJaspResults() { diff --git a/src/jaspObject.h b/src/jaspObject.h index d1179767..ed8c2ab4 100644 --- a/src/jaspObject.h +++ b/src/jaspObject.h @@ -130,6 +130,7 @@ class jaspObject static int getCurrentTimeMs(); static void setDeveloperMode(bool developerMode); + static bool getDeveloperMode(); bool connectedToJaspResults();