insightsengineering / teal

Exploratory Web Apps for Analyzing Clinical Trial Data
https://insightsengineering.github.io/teal/
Other
164 stars 29 forks source link

[Feature Request]: Extend the `TealAppDriver` class to handle options and warnings. #1183

Open vedhav opened 2 months ago

vedhav commented 2 months ago

Feature description

Three things to extend:

  1. Warnings coming from the app code does not invoke a warning in the test
  2. Options are not passed by default
  3. Make errors more strict (catch also the validation errors) + handle additional way of validation (InputValidator$new())

Warnings coming from the app code does not invoke a warning in the test

r$> devtools::test(filter = "examples")
ℹ Testing teal.modules.clinical
✔ | F W  S  OK | Context
⠏ |          0 | examples                                                                                                 
r$> ### Name: testtesttest
r$> ### Title: testtesttest
r$> ### Aliases: testtesttest
r$> ### Keywords: datasets
r$> 
r$> ### ** Examples
r$> 
r$> library(shiny)

r$> library(shinyvalidate)

r$> app <- shinyApp(
+     ui = fluidPage(
+         numericInput("n", "n", 1),
+         plotOutput("plot")
+     ),
+     server = function(input, output) {
+        print("hello from server")
+          x <- list(aaaaaaaaa = 1)
+          x$aaa
+        print(options("warnPartialMatchAttr"))
+        iv <- InputValidator$new()
+        #iv$add_rule("n", sv_email())
+        iv$enable()
+        output$plot <- renderPlot({
+          plot(head(cars, input$n))
+        })
+     }
+ )

r$> if (interactive()) {
+   app
+ }
[1] "hello from runApp"
{shinytest2} R  info   17:15:42.55 Start AppDriver initialization
{shinytest2} R  info   17:15:42.56 Starting Shiny app
{shinytest2} R  info   17:15:44.04 Creating new ChromoteSession
{shinytest2} R  info   17:15:44.08 Navigating to Shiny app
{shinytest2} R  info   17:15:44.13 Injecting shiny-tracer.js
{chromote}   JS info   17:15:44.13 shinytest2; jQuery not found
{chromote}   JS info   17:15:44.13 shinytest2; Loaded
{shinytest2} R  info   17:15:44.13 Waiting for Shiny to become ready
{chromote}   JS info   17:15:44.18 shinytest2; jQuery found
{chromote}   JS info   17:15:44.18 shinytest2; Waiting for shiny session to connect
{chromote}   JS info   17:15:44.19 shinytest2; Connected
{chromote}   JS info   17:15:44.22 shinytest2; shiny:busy
{shinytest2} R  info   17:15:44.24 Waiting for Shiny to become idle for 200ms within 15000ms
{chromote}   JS info   17:15:44.24 shinytest2; Waiting for Shiny to be stable
{chromote}   JS info   17:15:44.33 shinytest2; shiny:idle
{chromote}   JS info   17:15:44.33 shinytest2; shiny:value plot
{chromote}   JS info   17:15:44.54 shinytest2; Shiny has been idle for 200ms
{shinytest2} R  info   17:15:44.54 Shiny app started
{shiny}      R  stderr ----------- Registered S3 method overwritten by 'teal':
{shiny}      R  stderr -----------   method        from      
{shiny}      R  stderr -----------   c.teal_slices teal.slice
{shiny}      R  stderr ----------- Registered S3 method overwritten by 'tern':
{shiny}      R  stderr -----------   method   from 
{shiny}      R  stderr -----------   tidy.glm broom
{shiny}      R  stderr ----------- mmrm() registered as emmeans extension
{shiny}      R  stderr ----------- Loading required package: shiny
{shiny}      R  stderr ----------- Running application in test mode.
{shiny}      R  stderr ----------- 
{shiny}      R  stderr ----------- Listening on http://127.0.0.1:5879/
{shiny}      R  stderr ----------- Warning in x$aaa : partial match of 'aaa' to 'aaaaaaaaa'                # <- HERE!!!!!!!!!!!!!
{shiny}      R  stdout ----------- [1] "hello from server"
{shiny}      R  stdout ----------- $warnPartialMatchAttr
{shiny}      R  stdout ----------- [1] TRUE
✔ |          1 | examples [2.5s]                                                                                          

══ Results ═══════════════════════════════════════════════════════════════════════════════════════════════════════════════
Duration: 2.5 s

[ FAIL 0 | WARN 0 | SKIP 0 | PASS 1 ]

Options are not passed by default

library(shiny)

withr::with_options(
    list(test_option = 1),
    {
        print("outside:")
        print(getOption("test_option"))
        app <- shinyApp(
            ui = fluidPage({
                print("inside ui")
                print(getOption("test_option"))
                tags$p("hello")
            }),
            server = function(input, output) {
                print("inside srv")
                print(getOption("test_option"))
            }
        )
        app_driver <- shinytest2::AppDriver$new(app)
        app_logs <- app_driver$get_logs()
        print(app_logs)
        app_driver$stop()
    }
)

Example app to handle additional way of validation

library(shiny)
library(shinyvalidate)
shinyApp(
    ui = fluidPage(
        numericInput("n", "n", 1),
        plotOutput("plot")
    ),
    server = function(input, output) {
        iv <- InputValidator$new()
        iv$add_rule("n", sv_email())
        iv$enable()
        output$plot <- renderPlot({
            plot(head(cars, input$n))
        })
    }
)

Code of Conduct

Contribution Guidelines

Security Policy

vedhav commented 2 months ago

These enhancements were observed by @pawelru when working on https://github.com/insightsengineering/teal.modules.clinical/pull/983

vedhav commented 2 months ago

Issue related to warnings is raised in shinytest2