Error message in Shiny from sourced R script - r

Question

Is there a way to show happenings/errors/warnings from R script which is sourced inside server part of Shiny in Shiny panel?
Following is the sample code which works fine, but I need to see in Shiny if R throws an error while executing sourced GUI_trials2.R and if possible, a window to stream the happenings, like which line of GUI_trials2.R is running currently.
Sample code -
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Required Calcs", tabName = "Requirements")
)
)
uibody <- dashboardBody(
tabItems(
tabItem(tabName = "Requirements", h2("Required Calcs")
,dateInput("ME_DATE_output",label=h2("Execution Date"), value="2020-05-29")
,hr()
,actionButton("calculate", "Calculate this" ))
))
ui = dashboardPage(dashboardHeader(title = "Results"), sidebar, uibody)
server = function(input, output) {
ME_DATE_GUI <- reactive({input$ME_DATE_output})
Code_loc <- "K:/Codes/"
observeEvent(input$calculate, {
ME_DATE <- ME_DATE_GUI()
source(paste0(Code_loc,"GUI_trials2.r"), local = TRUE)
})
}
shinyApp(ui, server)
GUI_trials looks like -
# Use ME_DATE from Shiny
ME_DATE <- as.Date(ME_DATE, format="%Y-%m-%d")
year_N_ME_DATE <- format(ME_DATE,"%Y")
month_N_ME_DATE <- format(ME_DATE,"%m")
month_T_ME_DATE <- months(ME_DATE)
# Location for Outputs
Output_DIR <- "K:/Outputs/"
Output_loc <- paste(Output_DIR,month_N_ME_DATE,". ",month_T_ME_DATE, " ",year_N_ME_DATE,"/",sep="")
success <- "Success"
write.csv(success, paste0(Output_loc,"Success.csv"))
Any help is deeply appreciated!

Answer 1

Use withCallingHandlers()
You can wrap your call to source() as follows and use arbitrary code to handle warnings and messages that arise when the code is run. To handle errors you will need to wrap this again in tryCatch() so your app doesn't crash. For example, you could choose to simply send notifications as follows:
tryCatch(
withCallingHandlers(
source(paste0(Code_loc,"GUI_trials2.r"), local = TRUE),
message = function(m) showNotification(m$message, type = "message"),
warning = function(w) showNotification(w$message, type = "warning")
),
error = function(e) showNotification(e$message, type = "error")
)
You can test this by using something like the following code in your GUI_trials2.R script:
for (i in 1:3) {
warning("This is warning ", i)
Sys.sleep(0.5)
message("This is message", i)
Sys.sleep(0.5)
}
stop("This is a fake error!")
Streaming Output in New Window
The easiest way to do this is to pepper your GUI_trials2.R script with informative calls to message() and then use withCallingHandlers() to output these as above. If you want to be more sophisticated and show these messages in a new window, you could do this by updating a modalDialog(), though this would require the shinyjs package. Here is a basic example:
server = function(input, output) {
ME_DATE_GUI <- reactive({input$ME_DATE_output})
# Show a modal that will be updated as your script is run
observeEvent(input$calculate, {
showModal(modalDialog(
shinyjs::useShinyjs(),
title = "Running my R script",
div("You can put an initial message here", br(), id = "modal_status")
))
Code_loc <- "K:/Codes/"
ME_DATE <- ME_DATE_GUI()
# Run the script and use `withCallingHandlers()` to update the modal.
# add = TRUE means each message will be added to all the previous ones
# instead of replacing them.
tryCatch(
withCallingHandlers(
source(paste0(Code_loc,"GUI_trials2.r"), local = TRUE),
message = function(m) {
shinyjs::html("modal_status", paste(m$message, br()), add = TRUE)
},
warning = function(w) {
shinyjs::html("modal_status", paste(w$message, br()), add = TRUE)
}
),
error = function(e) {
shinyjs::html("modal_status", paste(e$message, br()), add = TRUE)
}
)
})
}
Display Code From source()
The echo = TRUE argument to source() will mean that each expression in the file gets printed in the console. Unfortunately, applying handlers to text as it appears in the console isn't possible in R unless it's a message/warning/error, so echo = TRUE won't be of any use here. However, you could define a custom function, similar to source() which will allow you to handle the code as text before it gets evaluated. Here is an example:
# Default handler just prints the code to console, similar
# to `source(echo = TRUE)`
source2 <- function(file, handler = cli::cat_line, local = FALSE) {
# Copy `source()` method of handling the `local` argument
envir <- if (isTRUE(local))
parent.frame()
else if (isFALSE(local))
.GlobalEnv
else if (is.environment(local))
local
else stop("'local' must be TRUE, FALSE or an environment")
# Read each 'expression' in the source file
exprs <- parse(n = -1, file = file, srcfile = NULL, keep.source = FALSE)
# Apply `handler()` to each expression as text, then
# evaluate the expression as code
for (expr in exprs) {
handler(deparse(expr))
eval(expr, envir)
}
# Return nothing
invisible()
}
This will allow you to do anything you like with the code text before
it gets evaluated. E.g. you could apply some pretty HTML formatting and
then output it as a message, which would allow you to use something very similar to the code above, since withCallingHandlers() would handle
these messages for you:
# Define a function to show a message as code-formatted HTML
html_message <- function(msg) {
with_linebreaks <- paste(msg, collapse = "<br/>")
as_code <- sprintf("<code>%s</code>", with_linebreaks)
spaces_preserved <- gsub(" ", "&nbsp", as_code)
message(spaces_preserved)
}
# Then use very similar code to the above for `server`, so
# something like -
tryCatch(
withCallingHandlers(
source2(file = paste0(Code_loc,"GUI_trials2.r"),
handler = html_message,
local = TRUE),
# ... Same code as in the above example using normal source()
Bonus: Getting Fancy with HTML
If you want to get really fancy you could add some custom HTML formatting to each of your message/warning/error functions, e.g. you could show errors in red like so:
error = function(e) {
shinyjs::html("modal_status", add = TRUE, sprintf(
'<span style = "color: red;">%s</span><br/>', e$message
))
}