Я пытаюсь использовать код, предоставленный Дином Аттали, чтобы получить "Занят ..." / "Готово!"/ Обратная связь «Ошибка» после нажатия кнопки ( Ссылка на код ) внутри блестящего модуля .
В приложении app.R ниже показаны две кнопки действия.Первая кнопка используется внутри функции withBusyIndicatorUI из файла helpers.R и работает должным образом.
Вторая кнопка находится внутри блестящего модуля (moduleButton.R) и делает этоне работает как надо.
Есть мысли?
app.R
library(shiny)
library(shinyjs)
source("helpers.R") # Load all the code needed to show feedback on a button click
source("moduleButton.R") # Load module
ui <- fluidPage(
useShinyjs(),
tags$style(appCSS),
# Wrap the button in the function `withBusyIndicatorUI()`
withBusyIndicatorUI(
actionButton(inputId = "button", label = "Button frome app.R", icon = icon("check"), width = NULL)
),
br(),
ActionButtonUI("button2")
)
server <- function(input, output, session) {
callModule(module = ActionButton, id = "button2")
observeEvent(input$button, {
# When the button is clicked, wrap the code in a call to `withBusyIndicatorServer()`
withBusyIndicatorServer("button", {
Sys.sleep(1)
})
})
}
shinyApp(ui = ui, server = server)
moduleButton.R
{# UI Module -----
ActionButtonUI <- function(id) {
ns <- NS(id)
tagList(
useShinyjs(),
tags$style(appCSS),
withBusyIndicatorUI(
actionButton(inputId = ns("button"), label = "Button from module", icon = icon("check"), width = NULL)
)
)
}
}
{# Server Module -----
ActionButton <- function(input, output, session) {
ns <- session$ns
observeEvent(input$button, {
withBusyIndicatorServer("button", {
Sys.sleep(1)
})
})
}
}
помощников. R (с здесь )
# All the code in this file needs to be copied to your Shiny app, and you need
# to call `withBusyIndicatorUI()` and `withBusyIndicatorServer()` in your app.
# You can also include the `appCSS` in your UI, as the example app shows.
# =============================================
# Set up a button to have an animated loading indicator and a checkmark
# for better user experience
# Need to use with the corresponding `withBusyIndicator` server function
withBusyIndicatorUI <- function(button) {
id <- button[['attribs']][['id']]
div(
`data-for-btn` = id,
button,
span(
class = "btn-loading-container",
hidden(
img(src = "ajax-loader-bar.gif", class = "btn-loading-indicator"),
icon("check", class = "btn-done-indicator")
)
),
hidden(
div(class = "btn-err",
div(icon("exclamation-circle"),
tags$b("Error: "),
span(class = "btn-err-msg")
)
)
)
)
}
# Call this function from the server with the button id that is clicked and the
# expression to run when the button is clicked
withBusyIndicatorServer <- function(buttonId, expr) {
# UX stuff: show the "busy" message, hide the other messages, disable the button
loadingEl <- sprintf("[data-for-btn=%s] .btn-loading-indicator", buttonId)
doneEl <- sprintf("[data-for-btn=%s] .btn-done-indicator", buttonId)
errEl <- sprintf("[data-for-btn=%s] .btn-err", buttonId)
shinyjs::disable(buttonId)
shinyjs::show(selector = loadingEl)
shinyjs::hide(selector = doneEl)
shinyjs::hide(selector = errEl)
on.exit({
shinyjs::enable(buttonId)
shinyjs::hide(selector = loadingEl)
})
# Try to run the code when the button is clicked and show an error message if
# an error occurs or a success message if it completes
tryCatch({
value <- expr
shinyjs::show(selector = doneEl)
shinyjs::delay(2000, shinyjs::hide(selector = doneEl, anim = TRUE, animType = "fade",
time = 0.5))
value
}, error = function(err) { errorFunc(err, buttonId) })
}
# When an error happens after a button click, show the error
errorFunc <- function(err, buttonId) {
errEl <- sprintf("[data-for-btn=%s] .btn-err", buttonId)
errElMsg <- sprintf("[data-for-btn=%s] .btn-err-msg", buttonId)
errMessage <- gsub("^ddpcr: (.*)", "\\1", err$message)
shinyjs::html(html = errMessage, selector = errElMsg)
shinyjs::show(selector = errEl, anim = TRUE, animType = "fade")
}
appCSS <- "
.btn-loading-container {
margin-left: 10px;
font-size: 1.2em;
}
.btn-done-indicator {
color: green;
}
.btn-err {
margin-top: 10px;
color: red;
}
"