Как передать прогресс от вызова API официанту

Вот как выполнить загрузку в JavaScript с помощью индикатора выполнения.

Файл xhr.js, который нужно поместить в подпапку www приложения:

Shiny.addCustomMessageHandler("xhr", function (x) {
  
  // 1. Create a new XMLHttpRequest object
  let xhr = new XMLHttpRequest();

  // 2. Configure it: GET-request for the URL
  let url = "https://raw.githubusercontent.com/stla/bigjson/main/bigjson.json";
  xhr.open("GET", url);

  // 3. Send the request over the network
  xhr.send();

  // 4. This will be called after the response is received
  let response; // variable to store the downloaded file
  xhr.onload = function () {
    if (xhr.status != 200) {
      // analyze HTTP status of the response
      alert(`Error ${xhr.status}: ${xhr.statusText}`); // e.g. 404: Not Found
    } else {
      // show the result in the console
      console.info(`Done, got ${xhr.response.length} bytes`); // response is the server response
      // store the response 
      // we don't send the response to Shiny here because it would block the progress bar
      response = xhr.response;
    }
  };

  let i = 1000; // this is used to slow down the communication with Shiny
  let totalSize = 100293197; // the size of the downloaded file
  let nsteps = 5; // number of steps for the progress bar
  let threshold = 1 / nsteps;
  xhr.onprogress = function (event) {
    if (event.lengthComputable) { // if available, totalSize is not needed
                                  // because it is given in event.total
      let ratio = event.loaded / event.total;
      if (ratio >= threshold) {
        setTimeout(function () {
          Shiny.setInputValue("received", ratio);
          if (ratio === 1) { // send response to Shiny
            Shiny.setInputValue("download", response);
          }
        }, i);
        threshold += 1 / nsteps;
      }
    } else { // event.total is not available
      let ratio = event.loaded / totalSize;
      if (ratio >= threshold) {
        setTimeout(function () {
          Shiny.setInputValue("received", ratio);
          if (ratio === 1) { // send response to Shiny
            Shiny.setInputValue("download", response);
          }
        }, i);
        threshold += 1 / nsteps;
      }
    }
    i += 1000;
  };

  xhr.onerror = function () {
    alert("Request failed");
  };
  
});

Здесь я загружаю файл, размещенный на Github (bigjson.json, около 100 МБ). lengthComputable события onprogress — false; это означает, что это событие не предоставляет общий размер загрузки, и тогда нам придется ввести его вручную.

Это событие постепенно предоставляет загруженный размер. Поскольку это быстро, я замедляюсь с помощью setTimeout.

Приложение:

library(shiny)

ui <- fluidPage(
  tags$head(tags$script(src = "xhr.js")),
  br(),
  actionButton("go", "Go"),
  br(),
  tags$h2("Response will appear here:"),
  verbatimTextOutput("response")
)

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

  # progress bar
  progress <- NULL
  
  observeEvent(input$go, {
    progress <<- Progress$new(session, min = 0, max = 1)
    progress$set(message = "Download in progress")
    # trigger the download in JavaScript
    session$sendCustomMessage("xhr", TRUE)
  })
  
  # input$received contains the ratio of the download in progress
  observeEvent(input$received, {
    progress$set(value = input$received)
    if (input$received == 1) {
      progress$close()
    }
  })
  
  # input$download contains the downloaded file (here a JSON string)
  output$response <- renderPrint({
    req(input$download)
    substr(input$download, 1, 100)
  })

}

shinyApp(ui, server)

Вот способ использования пакета httr для выполнения запроса и будущего пакета. Однако у меня возникла проблема: когда я закрываю приложение, оно не останавливается (тогда мне приходится перезапускать сеанс R) (см. комментарий).

library(shiny)
library(waiter)
library(future)
plan(multisession) # important
library(httr)

foo <- function() {
  # Simulte a slow download
  cap_speed <- httr::config(max_recv_speed_large = 10000)
  GET("http://httpbin.org/bytes/102400", cap_speed)
}

ui <- fluidPage(
  useWaiter(),
  useHostess(),
  waiterShowOnLoad(
    color = "#f7fff7",
    hostess_loader(
      "loader", 
      preset = "circle", 
      text_color = "black",
      class = "label-center",
      center_page = TRUE
    )
  )
)

server <- function(input, output){
  hostess <- Hostess$new("loader")
  
  f <- future({ foo() })  # Create the future
  
  i <- 0
  while(!resolved(f)) {
    i <- i + 1
    hostess$set(min(99, 10 * i)) # the spinner disappears when 100 is attained
  }
  hostess$close()
  print("done") # do not close the app before
  
}

shinyApp(ui, server)