picks

R/module_teal.R

@@ -107,6 +107,7 @@ ui_teal <- function(id, modules) {
     include_teal_css_js(),
     shinyjs::useShinyjs(),
     shiny::includeScript(system.file("js/extendShinyJs.js", package = "teal")),
+    shiny::singleton(shiny::includeScript(system.file("js/input-validator.js", package = "teal"))),
     shiny_busy_message_panel,
     tags$div(id = ns("tabpanel_wrapper"), class = "teal-body", navbar),
     tags$hr(style = "margin: 1rem 0 0.5rem 0;")

R/validate_inputs.R

@@ -193,3 +193,45 @@ any_names <- function(x) {
     }
   )
 }
+
+#' Validate input
+#'
+#' @param inputId (`character`) Character of input ID(s) to validate
+#' @param condition (`logical(1)`, `function(x)`) Logical value or function returning logical value.
+#'  Condition should determine expected state, `FALSE` throws.
+#' @param message (`character(1)`) Character string of validation message to display
+#' @param session Shiny session object
+#'
+#' @return `NULL` or `shiny.silent.error` when condition is not met
+#'
+#' @keywords internal
+validate_input <- function(inputId, # nolint
+                           condition = function(x) TRUE,
+                           message = "",
+                           session = shiny::getDefaultReactiveDomain()) {
+  checkmate::assert_character(inputId, min.len = 1)
+  checkmate::assert(
+    checkmate::check_flag(condition),
+    checkmate::check_function(condition, nargs = length(inputId))
+  )
+  checkmate::assert_string(message)
+
+  # Evaluate condition if it's a function
+  condition_result <- if (is.function(condition)) {
+    input_value <- lapply(inputId, function(id) session$input[[id]])
+    checkmate::assert_flag(do.call(condition, input_value))
+  } else {
+    condition
+  }
+
+  # Send custom message to JavaScript handler
+  lapply(inputId, function(id) {
+    session$sendCustomMessage("validateInput", list(
+      inputId = session$ns(id),
+      isValid = condition_result,
+      message = message
+    ))
+  })
+
+  validate(need(condition_result, message))
+}

inst/css/validation.css

@@ -40,10 +40,10 @@
   padding: 0.5em 0 0.5em 0.5em;
 }
 
-.teal_primary_col > .teal_validated:has(.teal-output-warning),
-.teal_primary_col > .teal_validated:has(.shiny-output-error) {
+.teal_primary_col>.teal_validated:has(.teal-output-warning),
+.teal_primary_col>.teal_validated:has(.shiny-output-error) {
   width: 100%;
   background-color: rgba(223, 70, 97, 0.1);
   border: 1px solid red;
   padding: 1em;
-}
+}

inst/js/input-validator.js

@@ -0,0 +1,29 @@
+$(document).on('shiny:connected', function () {
+  Shiny.addCustomMessageHandler('validateInput', function (data) {
+    var inputId = data.inputId;
+    var isValid = data.isValid;
+    var message = data.message;
+
+    // Try both CSS selector patterns
+    var selector1 = '.shiny-input-container#' + inputId;
+    var selector2 = '.shiny-input-container:has(#' + inputId + ')';
+
+    var container = $(selector1);
+    if (container.length === 0) {
+      container = $(selector2);
+    }
+
+    if (container.length > 0) {
+      // Remove existing validation message
+      container.find('.shiny-output-error').remove();
+
+      // Add validation message if rule failed
+      if (!isValid && message && message.trim() !== '') {
+        var validationSpan = $('<span>').addClass('shiny-output-error').text(message);
+        container.append(validationSpan);
+      }
+    } else {
+      console.warn('Container not found for input: ' + inputId);
+    }
+  });
+});

tests/testthat/test-shinytest2-validate_input.R

@@ -0,0 +1,124 @@
+testthat::skip_if_not_installed("shinytest2")
+testthat::skip_if_not_installed("rvest")
+
+testthat::test_that("e2e: validate_input displays validation message when input is invalid, no message when valid", {
+  skip_if_too_deep(5)
+
+  validation_module <- function(label = "validation test") {
+    module(
+      label = label,
+      server = function(id, data) {
+        moduleServer(id, function(input, output, session) {
+          output$plot <- renderPlot({
+            teal:::validate_input(
+              inputId = "number",
+              condition = function(x) !is.null(x) && as.numeric(x) > 5,
+              message = "Please select a number greater than 5",
+              session = session
+            )
+            plot(1:10)
+          })
+        })
+      },
+      ui = function(id) {
+        ns <- NS(id)
+        tagList(
+          numericInput(ns("number"), "Enter a number:", value = 3, min = 1, max = 10),
+          plotOutput(ns("plot"))
+        )
+      }
+    )
+  }
+
+  app <- TealAppDriver$new(
+    init(
+      data = simple_teal_data(),
+      modules = validation_module(label = "Validation Test")
+    )
+  )
+
+  # Check that validation error is displayed in the output
+  error_text <- app$get_text(".shiny-output-error-validation")
+  testthat::expect_match(error_text, "Please select a number greater than 5")
+
+
+  # Update input to valid value
+  app$set_input(app$namespaces()$module("number"), 7)
+  app$wait_for_idle()
+
+  # Check that validation error is gone
+  testthat::expect_null(app$get_text(".shiny-output-error-validation"))
+
+  app$stop()
+})
+
+testthat::test_that("e2e: validate_input validates many inputs (and linked output) when they return invalid value", {
+  skip_if_too_deep(5)
+
+  multi_validation_module <- function(label = "multi validation") {
+    module(
+      label = label,
+      server = function(id, data) {
+        moduleServer(id, function(input, output, session) {
+          output$result <- renderText({
+            teal:::validate_input(
+              inputId = c("input1", "input2"),
+              condition = function(x, y) identical(x, y),
+              message = "x and y must be identical",
+              session = session
+            )
+            paste("Valid inputs:", input$input1, input$input2)
+          })
+        })
+      },
+      ui = function(id) {
+        ns <- NS(id)
+        tagList(
+          numericInput(ns("input1"), "Enter y:", value = 4, min = 0, max = 100),
+          numericInput(ns("input2"), "Enter y:", value = 5, min = 0, max = 100),
+          textOutput(ns("result"))
+        )
+      }
+    )
+  }
+
+  app <- TealAppDriver$new(
+    init(
+      data = simple_teal_data(),
+      modules = multi_validation_module(label = "Multi Validation")
+    )
+  )
+
+  # Initially input2 is invalid (value 5 < 10)
+  error_text <- app$get_text(".shiny-output-error-validation")
+  testthat::expect_match(error_text, "x and y must be identical")
+  testthat::expect_match(
+    app$get_text(app$namespaces(TRUE)$module("result")),
+    "x and y must be identical"
+  )
+
+  # Update input2 to valid value
+  app$set_input(app$namespaces()$module("input1"), 5)
+  app$set_input(app$namespaces()$module("input2"), 5)
+  app$wait_for_idle()
+
+  # Check that validation passes and result is shown
+  error_text <- app$get_text(".shiny-output-error-validation")
+  testthat::expect_null(error_text)
+
+  testthat::expect_match(
+    app$get_text(app$namespaces(TRUE)$module("result")),
+    "Valid inputs: 5 5"
+  )
+
+  app$stop()
+})
+
+testthat::test_that("e2e: validate_input validates sliderInput")
+testthat::test_that("e2e: validate_input validates selectInput")
+testthat::test_that("e2e: validate_input validates selectizeInput")
+testthat::test_that("e2e: validate_input validates radioButtons")
+testthat::test_that("e2e: validate_input validates checkboxGroupInput")
+testthat::test_that("e2e: validate_input validates checkboxInput")
+testthat::test_that("e2e: validate_input validates dateInput")
+testthat::test_that("e2e: validate_input validates dateRangeInput")