Confirm message before saving using sweetalertR - r

Question

I use the sweetalertR package to create a confirmation message in the UI (reason for using this package: it looks very nice and the message is highly customizable).
However, I need to implement some code in the server function so that the file is only saved to disk if the confirmation message has been approved. Currently it saves the file already on clicking the save button.
Problem: the sweetalert function seems to have no inputID argument!
library(shiny) #1.5.0
library(shinydashboard) #0.7.1
library(rhandsontable) #0.3.7
# remotes::install_github("timelyportfolio/sweetalertR")
library(sweetalertR) #0.2.0
library("xlsx") #0.6.5
shinyApp(
ui = fluidPage(
box(width = 12,
# Save button
actionButton(inputId = "saveBtn", "Save"),
br(),
# Editable table
rHandsontableOutput("submit_data_edit_table"),
# Confirmation button, see: http://www.buildingwidgets.com/blog/2015/6/29/week-25-sweetalertr
sweetalert(selector = "#saveBtn", text = 'Changes will be saved in a new excel file',
title = 'Confirm changes',
type = "warning",
allowOutsideClick = TRUE,
showCancelButton = TRUE,
cancelButtonText = 'Cancel',
confirmButtonText = 'Confirm',
confirmButtonColor = "darkred",
closeOnConfirm = FALSE,
evalFunction = 'function(){swal("Saved", "Restart the application", "success")}'
)
)
),
server = function(input, output, session) {
# Create a table that can be modified
output$submit_data_edit_table = renderRHandsontable({
if (!is.null(input$submit_data_edit_table)) {
DF = hot_to_r(input$submit_data_edit_table)
} else {
DF = iris
}
rhandsontable(DF,
height = 750
) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE)
})
# Save file based on button press
observe({
# Save button
input$saveBtn
submit_data_edit_table = isolate(input$submit_data_edit_table)
if (!is.null(submit_data_edit_table)) {
# Save table as Excel file
write.xlsx(hot_to_r(input$submit_data_edit_table), file = "newData.xlsx",
sheetName = "Tot",
col.names = TRUE, row.names = FALSE,
append = FALSE)
}
})
}
)

Answer 1

I found a solution: using shinyalert instead. It offers the same functionality and design but is better documented.
I included the following code in the server function:
# Create global variable for confirmation message response
global <- reactiveValues(response = FALSE)
# Update file after table change
observeEvent(input$saveBtn, {
# Trigger confirmation dialog
shinyalert(title = "Confirm changes",
text = "Changes will be saved in a new excel file",
type = "warning",
closeOnClickOutside = TRUE,
showCancelButton = TRUE,
cancelButtonText = 'Cancel',
showConfirmButton = TRUE,
confirmButtonText = 'Confirm',
confirmButtonCol = "darkred",
timer = 15000, # 15 seconds
callbackR = function(x) {
global$response <- x
shinyalert(title = "Saved",
text = "Restart the application",
type = "success")
}
)
print(global$response)
observe({
req(input$shinyalert)
if (!global$response == "FALSE") {
submit_data_edit_table = isolate(input$submit_data_edit_table)
if (!is.null(submit_data_edit_table)) {
# Save as Excel file
write.xlsx(hot_to_r(input$submit_data_edit_table), file = "newData.xlsx",
sheetName = "Tot",
col.names = TRUE, row.names = FALSE,
append = FALSE)
}
# Reset value
global$response <- "FALSE"
} # End of confirmation button if
}) # End of observe
}) # End of observeEvent
And in the UI you simply need to set up shinyalert:
# Set up shinyalert to create confirmation messages
useShinyalert(),
Don't forget to load the package first!
library(shinyalert)