Как мы можем дать пользовательское сообщение об ошибке в R блестящий для приложения?

Question

Я создал блестящее приложение, которое получает запрос на выборку от пользователя внутри поля textarea, а затем запускает его, когда пользователь нажимает Go. И данные приведены в таблице ниже. Теперь, если пользователь вводит какой-то неправильный запрос, или если в запросе есть какая-либо ошибка, тогда пользователь должен получить сообщение об ошибке «Пожалуйста, исправьте запрос!». Прямо сейчас я получаю это сообщение об ошибке «Произошла ошибка. Проверьте ваши журналы или свяжитесь с автором приложения для уточнения», если пользователь вводит что-то неправильно в поле textarea. Я получаю это даже после того, как я удалил строку ошибки sanatize из моего кода. Любая помощь будет высоко ценится

server <- function(input, output, session) {
  resultTable <-  data.frame()
  observeEvent(input$tableName, {
    nQuery = paste("SELECT * FROM ",db, ".dbo.[",input$tableName,"]" ,sep = "" )
    updateTextAreaInput(session, "query", value = nQuery)
  })
  observeEvent(input$runQuery, {
    resultTable <<- sqlQuery (channel = conn, query = input$query)
    output$table <- renderDataTable(resultTable)
    }
  )
}

Answer 1

Если вы установите версию GitHub inyWidgets , у вас будет функция execute_safely для отображения ошибки во всплывающем окне:

# Install dev version
devtools::install_github("dreamRs/shinyWidgets")

# then something like that:

library(shinyWidgets)

server <- function(input, output, session) {
  resultTable <-  data.frame()
  observeEvent(input$tableName, {
    nQuery = paste("SELECT * FROM ",db, ".dbo.[",input$tableName,"]" ,sep = "" )
    updateTextAreaInput(session, "query", value = nQuery)
  })

  result <- eventReactive(input$runQuery, {
    execute_safely(sqlQuery (channel = conn, query = input$query))
  })

  output$table <- renderDataTable(result())
}

Воспроизводимый пример:

library(RSQLite)
library(shiny)
# dev: devtools::install_github("dreamRs/shinyWidgets")
library(shinyWidgets)



# Fake database
con <- dbConnect(RSQLite::SQLite(), ":memory:")
dbWriteTable(con, "mtcars", mtcars) # write a table

ui <- fluidPage(
  textAreaInput(inputId = "query", label = "Query:", value = "SELECT * FROM mtcars"),
  actionButton(inputId = "runQuery", label = "Run query"),
  tableOutput("table")
)

server <- function(input, output, session) {

  result <- eventReactive(input$runQuery, {
    execute_safely(dbGetQuery(conn = con, statement = input$query))
  })

  output$table <- renderTable(result())

}

shinyApp(ui, server)

Если вы напишите неверный запрос, вы получите всплывающее сообщение об ошибке: