Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Error when recording tests in an app with sub-modules #390

Open
NanduKrishnan-H opened this issue Aug 29, 2024 · 0 comments
Open

Error when recording tests in an app with sub-modules #390

NanduKrishnan-H opened this issue Aug 29, 2024 · 0 comments

Comments

@NanduKrishnan-H
Copy link

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"))
      })
    }
  )
}

Does anyone have any ideas for resolving this issue?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant