I tried boiling this down to a minimal example, but I think I have to provide more or less the full code to show the problem.
Basically I want a shiny app to act as a user friendly GUI to start/stop (multiple) system processes (mostly BASH scripts, for scientific workflows) through the processx package. So I made a shiny module that can start/stop and show a process log (just output from stderr+stdout). The script/command run is decided when calling the module, not in the module itself. It's then important that additional options can be passed on to the different processes depending on the script run, like choosing input/output folders, database files, settings, etc.
The issue is that the value of any additional inputs does not get updated every time the actionButton is clicked, so clicking the start button again (triggering the eventReactive) just starts the process again without the new options/setting.
I have attached the full code here and published an example app on my shinyapps.io account, available here: https://kasperskytte.shinyapps.io/processxmodule/
library(shiny)
#shiny module to start asynchronous processes using processx package
#shiny must be version 1.4.0.9003 or later to use shiny modules, install from github
installGitHub <- function(...) {
if(!require("remotes")) {
install.packages("remotes")
}
remotes::install_github(...)
}
if(any(grepl("^shiny$", installed.packages()[,1]))) {
if(packageVersion("shiny") < "1.4.0.9003") {
installGitHub("rstudio/shiny")
}
} else
installGitHub("rstudio/shiny")
require("shiny")
require("processx")
processxUI <- function(id) {
shiny::tagList(
uiOutput(NS(id, "startStopBtn")),
p(),
uiOutput(NS(id, "processStatus")),
h4("Process log"),
verbatimTextOutput(NS(id, "processLog")),
downloadButton(NS(id, "downloadLogfile"), label = "Export log file")
)
}
processxServer <- function(id, ...) {
moduleServer(id, function(input, output, session) {
#reactive to store processx R6 class object
process <- reactiveVal()
#reactive to store logfile created on start
logfile <- reactiveVal(tempfile())
#start/stop button
output$startStopBtn <- renderUI({
if(isFALSE(processAlive())) {
actionButton(
inputId = NS(id, "startStopProcess"),
label = "Start process"
)
} else if(isTRUE(processAlive())) {
actionButton(
inputId = NS(id, "startStopProcess"),
label = "Kill process"
)
}
})
#start a new process and logfile when actionbutton is pressed
observeEvent(input$startStopProcess, {
#start process if not already running, otherwise kill
startProcess <- function(...) {
#generate new log file for each new process
logfile(tempfile())
#start process piping stderr+stdout to logfile
process(
processx::process$new(
...,
stderr = "2>&1",
stdout = logfile(),
supervise = TRUE
)
)
}
if(is.null(process()$is_alive))
startProcess(...)
else if(!is.null(process()$is_alive))
if(isTRUE(process()$is_alive()))
process()$kill_tree()
else if(isFALSE(process()$is_alive()))
startProcess(...)
})
#read process status every 500 ms (alive or not)
#(only for updating status message below, otherwise use
# process()$is_alive() to avoid refresh interval delay)
processAlive <- reactivePoll(
intervalMillis = 500,
session = session,
checkFunc = function() {
if(!is.null(process()$is_alive))
process()$is_alive()
else
FALSE
},
valueFunc = function() {
if(!is.null(process()$is_alive))
process()$is_alive()
else
FALSE
}
)
#print status message of process and exit status if finished
output$processStatus <- renderUI({
if(isTRUE(processAlive())) {
p("Process is running...")
} else if(isFALSE(processAlive()) && !is.null(process()$get_exit_status)) {
if(process()$get_exit_status() == 0)
p("Process has finished succesfully")
else if(process()$get_exit_status() == -9)
p("Process was killed")
else if(!process()$get_exit_status() %in% c(0, -9))
p(paste0("Process has errored (exit status: ", process()$get_exit_status(), ")"))
}
})
#read logfile every 500 ms
readLogfile <- reactivePoll(
intervalMillis = 500,
session = session,
checkFunc = function() {
if(file.exists(logfile()))
file.info(logfile())[["mtime"]][1]
else
return('No process has run yet')
},
valueFunc = function() {
if(file.exists(logfile()))
readLines(logfile())
else
return('No process has run yet')
}
)
#print process logfile
output$processLog <- renderText({
readLogfile()
},
sep = "\n")
#export process logfile
output$downloadLogfile <- downloadHandler(
filename = function() {
#append module id and date to logfile filename
paste0("logfile_", id, "_", format(Sys.time(), format = "%y%m%d_%H%M%S"), ".txt")
},
content = function(file) {
file.copy(from = logfile(), to = file)
},
contentType = "text/plain"
)
})
}
ui <- navbarPage(
title = "test",
tabPanel(
title = "Test",
column(
width = 4,
wellPanel(
sliderInput(
NS("process1", "delay"),
"Sleep delay",
min = 1,
max = 5,
step = 1,
value = 2)
)
),
column(
width = 8,
fluidRow(
processxUI("process1")
)
)
)
)
server <- function(input, output, session) {
processxServer(
"process1",
command = "echo",
args = as.character(reactive({input[[NS("process1", "delay")]]})())
)
}
shinyApp(ui = ui, server = server)
