callr Background Process r_bg() Poll Progress via non-blocking while loop

[louis]

My first post; here we go!

The context of my question is a shiny app, but the essence of the question is agnostic of shiny. Consequently, I have listed this as a general post.

Core Question
I am using the callr package to run a background process for a long-running function with the r_bg() function. I understand the method $is_alive() indicates whether the background process has completed (i.e., rx$is_alive() == FALSE , where rx is a call to r_bg()).

The long-running functions I have in mind:

1. Save data from the shiny app - no return value
2. Run an API call using httr, which retrieves files but does not itself return anything to an R object. These files could be read into R objects later on, for example.

Goal: My goal is to poll rx$is_alive() on some interval (e.g., 2 seconds) and take some action upon completion. Specifically, in a shiny app for multiple users my goal is to display a modal to one user while they wait while also keeping the main R process available for other users. This post has an analogous, yet different, goal. I hope to do all of this in a single observeEvent that triggers multiple side-effects. If I build this with multiple reactives and observers I would have concerns about their execution order and keeping track of the modal.

The intended workflow is as follows:

1. One user clicks a button, triggering an observer
2. A modal appears for that user, preventing that one user from taking subsequent actions within the shiny app. (i.e., in the modal footer = NULL). E.g., the app is saving data that should not be modified at the same time.
3. The background process using callr::r_bg() begins.
4. The main R process on which shiny relies is made immediately available so other users can use the shiny app
5. When the background process completes, the modal is removed for the user in question (using removeModal()). That user can now take subsequent actions within the shiny app.

Note: I've read the RStudio documentation on async using future and promises. Admittedly, I am not clear as to when this approach makes sense over a pure callr background process. I have also seen the future plan(callr). I do not have a chain of reactive objects, so the "one and done background process" made sense to me. If I'm mistaken, let me know.

Attempt 1: Simple while loop: A quick approach would be the following, but this blocks the main R process because of Sys.sleep(), defeating the purpose of a background process:

while (rx$is_alive() == TRUE) {
      Sys.sleep(2)
      print("Hello")
    }

Attempt 2: Shiny invalidators: Shiny has invalidateLater() and shinyjs has delay(), but these functions are to be used in a reactive context, rather than within a loop. My reading, and tinkering, show that even in a reactive context such as an observer these functions run once, rather than the interval provided. For example, I cannot run a while loop every 2 seconds within one observer using these functions.

Attempt 3: The later package and recursion: I read about a non-blocking loop using later and recursion here. I modified the approach to use an if-statement to stop the recursion when the condition is met. However, in practice I found that because this "while loop" is non-blocking, the user in question is not stalled (i.e., the modal disappears immediately). If I understand the recursion correctly, the entirety of the loop happens in the background. Here's a simple example of the conditional recursion approach:

print_time2 = function(interval = 2) {
  print(Sys.time())
  
  # Only call the next recursion if a condition is met
  if ( round(second(Sys.time())) <= 55) {
    later::later(print_time2, interval)
  }
}

print_time2()

Shiny app example:
Here's how it looks in a small shiny app.

library(shiny)
library(callr)

ui <- fluidPage(
  actionButton(inputId = "save_all_data", "Save!")
)

server <- function(input, output, session) {
  
  # Save data
  observeEvent(input$save_all_data, {
    
    showModal(modalDialog(
      title = "Saving!",
      "Saving your data . . .",
      footer = NULL
    ))
    
    rx <- callr::r_bg(func = data_saver,
                      args = list("user_save_folder" = "a_remote_folder"),
                      supervise = TRUE)
    
    # This will consume the main R process
    while (rx$is_alive() == TRUE) {
      Sys.sleep(2)
      print("Background process still running. . .")
    }
    
    print("The process finished!")
    
    removeModal()
    
  })
}

shinyApp(ui, server)

Thanks for your feedback,
Louis

EDIT with solution
I would have replied, but the thread was closed. Here is a solution I came up with.

library(shiny)
library(callr)
library(dplyr)

long_job <- function() { 
  Sys.sleep(5)
  
  df <- cbind(mtcars, data.frame(current_ts = Sys.time()))
  write.csv(df, file = "df.csv", row.names = FALSE)
}


ui <- fluidPage(
  actionButton(inputId = "start", label = "Start!")
)

server <- function(input, output, session) {
  
  rv <- reactiveValues(ts = Sys.time())
  
  observeEvent(input$start, {
    showModal(modalDialog(
      title = "Pop up!",
      "This is a pop up!"
    ))
  })
  
  long_run <- eventReactive(input$start, {
    x <- callr::r_bg(
      func = long_job,
      supervise = TRUE
    )
    return(x)
  })
  
  observe({
    invalidateLater(2000)
    # print("Observer triggered!")
    
    # print the current value of long_run()$is_alive()
    # print(long_run()$is_alive())
    
    if(isolate(long_run()$is_alive()) == FALSE & file.mtime("df.csv") > isolate(rv$ts)) {
      removeModal()
      print("The if statement ran")
    }
    
    # Update reactiveValues() variable with current timestamp, and compare it to the file mtime
    rv$ts <- Sys.time()
  })
}

shinyApp(ui, server)