From 2753917043e29c90eb1cd36493b08a82be7b00b7 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Tue, 22 Nov 2022 09:46:52 +0100 Subject: [PATCH 1/4] warnings are displayed --- R/common.R | 4 +++- R/commonerrorcheck.R | 20 ++++++++++++++++++++ 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/R/common.R b/R/common.R index 5d56e34e..e2b3244c 100644 --- a/R/common.R +++ b/R/common.R @@ -112,12 +112,14 @@ runJaspResults <- function(name, title, dataKey, options, stateKey, functionCall # ensure an analysis always starts with a clean hashtable of computed jasp Objects emptyRecomputed() + warnings <- list() 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 = function(w) warnings <<- c(warnings, list(w))), error=function(e) e, jaspAnalysisAbort=function(e) e ) + .appendOutputFromR(jaspResults, warnings) if (!jaspResultsCalledFromJasp()) { diff --git a/R/commonerrorcheck.R b/R/commonerrorcheck.R index 8cc1c3dc..38b887bf 100644 --- a/R/commonerrorcheck.R +++ b/R/commonerrorcheck.R @@ -46,6 +46,26 @@ signalCondition(e) } +.sendWarning <- function(w) { + # Sends warning w to an object `warnings` in the parent frame + warnings <<- c(warnings, list(w)) +} + +.appendOutputFromR <- function(container, warnings) { + if(identical(warnings, list())) return() + + # Adds a warning element to a jaspContainer + warnings <- vapply(warnings, as.character, character(1)) + warnings <- trimws(warnings) + text <- paste0("
  • ", warnings, "
    • ", collapse = "") + text <- paste0("") + + output <- createJaspContainer(title = gettext("Output from R"), initCollapsed = TRUE) + output[["__warnings__"]] <- createJaspHtml(title = gettext("Warnings"), text = text) + + container[["__output__"]] <- 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). From 6edc1fcf5ec0a20bc77d358b16e86d6ce0589ea3 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Tue, 22 Nov 2022 10:44:41 +0100 Subject: [PATCH 2/4] improve how the warnings are displayed --- R/commonerrorcheck.R | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/R/commonerrorcheck.R b/R/commonerrorcheck.R index 38b887bf..7858716c 100644 --- a/R/commonerrorcheck.R +++ b/R/commonerrorcheck.R @@ -46,24 +46,29 @@ signalCondition(e) } -.sendWarning <- function(w) { - # Sends warning w to an object `warnings` in the parent frame - warnings <<- c(warnings, list(w)) -} - .appendOutputFromR <- function(container, warnings) { + # currently adds only warnings, do we also want messages or something? if(identical(warnings, list())) return() - + + output <- createJaspContainer(title = gettext("Output from R"), initCollapsed = TRUE) + # Adds a warning element to a jaspContainer - warnings <- vapply(warnings, as.character, character(1)) - warnings <- trimws(warnings) - text <- paste0("
  • ", warnings, "
    • ", collapse = "") + 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 <- createJaspContainer(title = gettext("Output from R"), initCollapsed = TRUE) - output[["__warnings__"]] <- createJaspHtml(title = gettext("Warnings"), text = text) + output[["warnings"]] <- createJaspHtml(title = gettext("Warnings"), text = text) - container[["__output__"]] <- output + container[[".outputFromR"]] <- output } From 1e5f0ccac014b41f384c39bedcfc9f1f86a63ce2 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 23 Nov 2022 15:53:37 +0100 Subject: [PATCH 3/4] add getDeveloperMode() --- src/jaspModuleRegistration.h | 1 + src/jaspObject.cpp | 5 +++++ src/jaspObject.h | 1 + 3 files changed, 7 insertions(+) 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(); From d218b053021eec91768621535a1cc4871f3689c5 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 23 Nov 2022 16:17:56 +0100 Subject: [PATCH 4/4] display warnings only in developer mode --- R/common.R | 6 +++--- R/commonerrorcheck.R | 10 ++++++++-- R/setOrRetrieve.R | 7 ++++++- 3 files changed, 17 insertions(+), 6 deletions(-) diff --git a/R/common.R b/R/common.R index e2b3244c..c57ffbce 100644 --- a/R/common.R +++ b/R/common.R @@ -111,15 +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() - warnings <- list() analysisResult <- tryCatch( - expr=withCallingHandlers(expr=analysis(jaspResults=jaspResults, dataset=dataset, options=options), error=.addStackTrace, warning = function(w) warnings <<- c(warnings, list(w))), + expr=withCallingHandlers(expr=analysis(jaspResults=jaspResults, dataset=dataset, options=options), error=.addStackTrace, warning = .addWarnings), error=function(e) e, jaspAnalysisAbort=function(e) e ) - .appendOutputFromR(jaspResults, warnings) + .appendOutputFromR(jaspResults) if (!jaspResultsCalledFromJasp()) { diff --git a/R/commonerrorcheck.R b/R/commonerrorcheck.R index 7858716c..4aed13d6 100644 --- a/R/commonerrorcheck.R +++ b/R/commonerrorcheck.R @@ -46,9 +46,15 @@ signalCondition(e) } -.appendOutputFromR <- function(container, warnings) { +.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(identical(warnings, list())) return() + if (!getDeveloperMode() || identical(warnings, list())) return() output <- createJaspContainer(title = gettext("Output from R"), initCollapsed = TRUE) 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"]]`.