I am trying to record tests in an app with submodules and I end up getting the below error:
Error (test-shinytest2.R:25:3): {shinytest2} recording: test2
Error in `app_find_node_id(self, private, input = input, output = output,
selector = selector)`: Cannot find HTML element with selector #main-sub-submit_user.shiny-bound-input
Backtrace:
▆
1. └─app$click("main-sub-submit_user") at test-shinytest2.R:25:3
2. └─shinytest2:::app_click(...)
3. └─shinytest2:::app_find_node_id(self, private, input = input, output = output, selector = selector)
4. └─shinytest2:::app_abort(...)
5. └─rlang::abort(..., app = self, call = call)
Error (test-shinytest2.R:39:3): {shinytest2} recording: sample_app
Error in `app_find_node_id(self, private, input = input, output = output,
selector = selector)`: Cannot find HTML element with selector #main-sub-submit_user.shiny-bound-input
Backtrace:
▆
1. └─app$click("main-sub-submit_user") at test-shinytest2.R:39:3
2. └─shinytest2:::app_click(...)
3. └─shinytest2:::app_find_node_id(self, private, input = input, output = output, selector = selector)
4. └─shinytest2:::app_abort(...)
5. └─rlang::abort(..., app = self, call = call)
Here is the sample app used :
app.R
# === app.R ====
library(shiny)
library(bslib)
library(DT)
ui <- page_navbar(
title = "My TestApp",
bg = "#2D89C8",
inverse = TRUE,
nav_panel(
title = "Panel 1",
mod_main_ui("main")
)
)
server <- function(input, output, session) {
mod_main_server("main")
}
shinyApp(ui, server)
Modules:
# ==== Sub module ====
mod_sub_ui <- function(id) {
ns <- NS(id)
fluidPage(
fluidRow(
column(6,
actionButton(ns("add_user"), "Add User"),
actionButton(ns("del_user"), "Delete User"))),
hr(),
fluidRow(
DTOutput(ns("table_users"))
)
)
}
mod_sub_server <- function(id) {
moduleServer(
id,
function(input, output, session) {
ns <- session$ns
# Sample user list
user_df <- tibble::tribble(
~id, ~name,
"user1", "Andrew",
"user2", "Roshan",
"user3", "Kraig",
"user4", "Denny",
"user5", "John"
)
rVals <- reactiveValues(
user_data = NULL
)
observeEvent(input$add_user, {
showModal(
modalDialog(
titel = "ADD USER",
selectInput(ns("sel_user"), "Select User", choices = user_df$name),
selectInput(ns("sel_role"), "Select Role", choices = c("ADMIN", "User")),
footer = tagList(
actionButton(ns("submit_user"), "Submit"),
modalButton("Close")
)
))
})
observeEvent(input$del_user, {
showModal(
modalDialog(
titel = "DELETE USER",
selectInput(ns("sel_user_del"), "Select User to Delete", choices = user_df$name),
footer = tagList(
actionButton(ns("delete_user"), "DELETE"),
modalButton("Close")
)
))
})
observeEvent(input$submit_user, {
# browser()
Name <- input$sel_user
Role <- input$sel_role
new_user <- tibble::tibble(Name, Role)
rVals$user_data <- rbind(rVals$user_data, new_user)
removeModal()
})
observeEvent(input$delete_user, {
# browser()
del_row <- which(rVals$user_data$Name == input$sel_user_del)
rVals$user_data <- rVals$user_data[-del_row, ]
removeModal()
})
output$table_users <- renderDT(rVals$user_data)
}
)
}
# ==== Main module ====
mod_main_ui <- function(id) {
ns <- NS(id)
fluidPage(
fluidRow(
column(12, uiOutput(ns("tab_submodule")))
)
)
}
mod_main_server <- function(id, user_id, newIAM) {
ns <- NS(id)
mod_sub_server(ns("sub"))
moduleServer(
id,
function(input, output, session) {
ns <- session$ns
output$tab_submodule <- renderUI({
mod_sub_ui(ns("sub"))
})
}
)
}