ShinyFeedback配合fileInput二次上传时提示标签显示异常问题

问题描述 #

开发接收Excel文件输入的Shiny应用时，设计了两层错误防护逻辑：

• 校验上传文件格式是否为.xls或.xlsx
• 校验文件内是否包含名为Special Sheet的工作表

运行时出现如下异常表现：

• 首次上传符合要求的文件时，应用运行表现符合预期，提示标签可正常显示
• 点击浏览按钮再次尝试上传文件时，提示标签无法正确渲染，仅首次上传时可显示正确标签
• 多次上传内容不符合要求的Excel文件时，不会触发该异常
• 后续尝试上传其他格式的文件时，同样会出现提示显示异常的问题

可复现问题的原始代码：

library(shiny)
library(readxl)
library(tools)
library(shinyFeedback)
ui <- fluidPage(
  useShinyFeedback(),
  
  fileInput("file", "upload file", multiple = FALSE),
  tableOutput("data")
)

server <- function(input, output, session) {
  
  data <-  reactive({
    
    req(input$file)
    path <- input$file$datapath
    good_file <- file_ext(path) == "xls" || file_ext(path) == "xlsx"
    feedbackDanger(inputId = "file",
                   show=!good_file,
                   color = "orange",
                   text = "Upload only .xls or .xlsx files")
    req(good_file)
    good_sheet <- "Special Sheet" %in% excel_sheets(path)
    feedbackDanger(inputId = "file",
                   show=!good_sheet,
                   color = "#E6007E",
                   text = "File must contain the special sheet'")
    req(good_sheet)
    read_excel(path)
    
  })
  
  output$data = renderTable(data())
}

shinyApp(ui, server)

问题原因 #

核心问题出在shinyFeedback的提示状态持久化机制：提示是绑定在输入组件上的全局状态，不会随响应式表达式重新执行自动重置。

• 首次上传合法文件时，两次校验的show参数均为FALSE，提示正常隐藏、表格正常渲染
• 后续重新上传文件时，只要响应式流在某一个req()位置中断，就不会执行到后续的feedbackDanger调用，无法更新提示的显示状态，最终导致提示无法正常渲染
• 原代码第二个错误提示末尾多了一个冗余单引号，属于笔误。

修复方案 #

每次触发文件上传、启动校验流程前，先调用hideFeedback()清空输入框上残留的旧提示状态，再依次执行两层校验，同时修正文本笔误即可，修复后完整代码如下：

library(shiny)
library(readxl)
library(tools)
library(shinyFeedback)
ui <- fluidPage(
  useShinyFeedback(),
  
  fileInput("file", "upload file", multiple = FALSE),
  tableOutput("data")
)

server <- function(input, output, session) {
  
  data <-  reactive({
    
    req(input$file)
    # 每次校验前先清空旧的提示状态
    hideFeedback("file")
    path <- input$file$datapath
    good_file <- file_ext(path) == "xls" || file_ext(path) == "xlsx"
    feedbackDanger(inputId = "file",
                   show=!good_file,
                   color = "orange",
                   text = "Upload only .xls or .xlsx files")
    req(good_file)
    good_sheet <- "Special Sheet" %in% excel_sheets(path)
    feedbackDanger(inputId = "file",
                   show=!good_sheet,
                   color = "#E6007E",
                   # 修正原代码冗余的末尾单引号
                   text = "File must contain the special sheet")
    req(good_sheet)
    read_excel(path)
    
  })
  
  output$data = renderTable(data())
}

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Luis Fernandez