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)
The error is that you don't pass a reactive to your module. In the line
processxServer(
"process1",
command = "echo",
args = as.character(reactive({input[[NS("process1", "delay")]]})())
)
you evaluate your reactive before passing it to the module, therefore the module only gets the default at startup. I've changed it so that the unevaluated reactive is passed to the module and only evaluated when you make the startProcess function. However, this makes you a bit less flexible with the ... because now startProcess assumes that there is the argument args passed.
library(shiny)
library("processx")
#shiny module to start asynchronous processes using processx package
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
# make argument list
dots <- list(...)
dots$args <- as.character(dots$args())
arg_list <- c(dots, stderr = "2>&1", stdout = logfile(), supervise = TRUE)
process(
do.call(processx::process$new, arg_list)
)
}
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 = reactive({input[[NS("process1", "delay")]]})
)
}
shinyApp(ui = ui, server = server)
Also, your definition of the delay slider is a bit outside of the shiny module concept. NS is thought to be called in the module ui, so that the definition of which elements belong to which namespace is clearly separated (but it obviously also works with your approach).