Shinylive部署GitHub Pages后无法正常下载CSV数据表求助

问题概述 #

本地Windows 11运行Shinylive应用时，可正常生成甘特图、数据表并下载CSV文件，但部署到GitHub Pages后，点击下载按钮弹出无文件窗口，CSV文件名被追加.htm后缀，contentType = "text/csv"配置未生效。

解决方案 #

Shinylive在静态环境下的下载机制与本地Shiny存在差异，原生downloadHandler无法正确处理MIME类型和文件名。需通过前端JavaScript手动触发下载，替代原生下载逻辑：

• 在UI中添加隐藏元素存储CSV内容与文件名
• 将原生下载按钮替换为普通按钮，绑定自定义下载事件
• 服务器端生成CSV文本内容传递到前端
• 通过JavaScript创建Blob对象并触发下载，确保MIME类型和文件名正确

修改后的完整app.R代码 #

library(tidyverse)
library(ggplot2)
library(DT)
library(shiny)
library(glue)
library(WriteXLS)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      tags$h3("Project Gantt Chart"),
      tags$h4("Add or remove as many tasks as you like for a single project."),
      tags$hr(),
      textInput(inputId = "projectName", label = "Project Name:", placeholder = "e.g., My Project"),
      textInput(inputId = "inTaskName", label = "Task:", placeholder = "e.g., Extract and Link Data"),
      dateInput(inputId = "inStartDate", value = Sys.Date(), min = Sys.Date() - 365, label = "Start Date:"),
      dateInput(inputId = "inEndDate", value = Sys.Date() + 10, min = Sys.Date() - 364, label = "End Date:"),
      actionButton(inputId = "btn", label = "Add Task")
    ),
    mainPanel(
      tags$h3("Task Table View"),
      tags$hr(),
      DTOutput(outputId = "tableTasks"),
      # 替换原生下载按钮为自定义按钮
      actionButton("downloadCSV", "Download Table as CSV file"),
      # 隐藏元素：存储CSV内容和文件名
      uiOutput("csvContent", style = "display: none;"),
      tags$h3("Gantt Chart"),
      tags$h4("Right-click the Gantt chart to copy or save as image."),
      tags$hr(),
      plotOutput(outputId = "plotTasks"),
      # 嵌入下载逻辑的JavaScript
      tags$script(HTML("
        $('#downloadCSV').on('click', function() {
          // 获取前端存储的CSV内容和文件名
          const csvText = $('#csvText').text();
          const filename = $('#csvFilename').text();
          
          // 创建CSV类型的Blob对象
          const blob = new Blob([csvText], { type: 'text/csv;charset=utf-8;' });
          const url = URL.createObjectURL(blob);
          
          // 生成下载链接并触发点击
          const link = document.createElement('a');
          link.href = url;
          link.setAttribute('download', filename);
          document.body.appendChild(link);
          link.click();
          document.body.removeChild(link);
          URL.revokeObjectURL(url);
        });
      "))
    )
  )
)


server <- function(input, output) {
  df <- reactiveValues(
    data = data.frame(
      Task = c("Task 1", "Task 2"),
      StartDate = as.Date(c("2024-03-10", "2024-04-30")),
      EndDate = as.Date(c("2024-04-30", "2024-06-15"))
    ) %>%
      mutate(ID = row_number(), .before = Task) %>%
      mutate(Remove = glue('<button id="custom_btn_{ID}" onclick="Shiny.onInputChange(\\'button_id\\', \\'{ID}\\')">Remove</button>'))
    
  )
  
  observeEvent(input$btn, {
    task_name <- input$inTaskName
    task_start_date <- input$inStartDate
    task_end_date <- input$inEndDate
    
    if (!is.null(task_name) && !is.null(task_start_date) && !is.null(task_end_date)) {
      new_id <- nrow(df$data) + 1
      new_row <- data.frame(
        ID = new_id,
        Task = task_name,
        StartDate = task_start_date,
        EndDate = task_end_date,
        Remove = glue('<button id="custom_btn" onclick="Shiny.onInputChange(\\'button_id\\', \\'{new_id}_', Sys.time(), '\\')">Remove</button>'),
        stringsAsFactors = FALSE
      )
      df$data <- rbind(df$data, new_row)
      df$data <- df$data[order(df$data$ID), ]
    }
  })
  
  observeEvent(input$button_id, {
    actual_id <- unlist(strsplit(input$button_id, "_"))[1]
    df$data <- df$data[-c(as.integer(actual_id)), ]
    df$data$ID <- seq_len(nrow(df$data))
    df$data <- df$data[order(df$data$StartDate), ]
    rownames(df$data) <- NULL
    
    df$data$Remove <- sapply(df$data$ID, function(i) {
      glue('<button id="custom_btn_{i}" onclick="Shiny.onInputChange(\\'button_id\\', \\'{i}_', Sys.time(), '\\')">Remove</button>')
    })
  })
  
  output$tableTasks <- renderDT({
    datatable(data = df$data, escape = FALSE, caption = input$projectName)
  })
  
  output$plotTasks <- renderPlot({
    ggplot(df$data, aes(x = StartDate, xend = EndDate, y = fct_rev(fct_inorder(Task)), yend = Task)) +
      geom_segment(linewidth = 10, color = "#0198f9") +
      labs(
        title = input$projectName,
        x = "Duration",
        y = "Task"
      ) +
      theme_bw() +
      theme(legend.position = "none") +
      theme(
        plot.title = element_text(size = 20),
        axis.text.x = element_text(size = 14),
        axis.text.y = element_text(size = 14)
      )
  })
  
  # 生成CSV文本和文件名，传递到前端隐藏元素
  output$csvContent <- renderUI({
    csv_filename <- paste("TaskData-", Sys.Date(), ".csv", sep="")
    # 将CSV内容转为文本格式
    csv_text <- capture.output(write.csv(df$data, row.names=FALSE))
    tagList(
      tags$span(id = "csvFilename", csv_filename),
      tags$pre(id = "csvText", paste(csv_text, collapse = "\n"))
    )
  })
  
}

shinyApp(ui = ui, server = server)

修改说明 #

• 替换原生downloadButton为actionButton，规避Shinylive静态环境下的下载机制冲突
• 添加uiOutput生成隐藏元素，存储CSV文本内容和目标文件名
• 嵌入JavaScript代码手动处理下载逻辑，确保MIME类型为text/csv，避免文件名被追加.htm后缀
• 服务器端通过capture.output(write.csv(...))将CSV内容转为文本格式，传递给前端

内容的提问来源于stack exchange，提问作者Michael Willox