Implement comprehensive three-tier validation system for Excel imports

DESCRIPTION

@@ -1,10 +1,11 @@
 Package: ESQapp
 Title: Shiny App to edit {esqLABSR} Edit Simulation Scenarios
-Version: 2.2.0.9002
+Version: 2.2.0.9003
 Authors@R: c(
     person("Felix", "Mil", email = "felix.mil@esqlabs.com", role = c('cre', 'aut')),
     person("Anastasiia", "Kostiv", email = "anastasiia.kostiv.ext@esqlabs.com", role = c("aut"),
-           comment = "https://github.com/AKostiv8")
+           comment = "https://github.com/AKostiv8"),
+    person("Sia", "Mirza", ,"siavash.mirzaee@esqlabs.com", role = c("aut"))
   )
 Description: Shiny App to edit {esqLABSR} Edit Simulation Scenarios.
 License: file LICENSE

NEWS.md

@@ -5,6 +5,7 @@
 #### **Main Changes:**
 - **Dropdown Validation with Visual Feedback:** Updated `esqlabs.handsontable` components to include dropdown validation across multiple table components (DataCombined, PlotConfiguration, ExportConfiguration, Demographics, IndividualBiometrics). Invalid dropdown values now display with red background and warning tooltips on hover. Resolved an issue in (#191).
 - **Column Description Tooltips:** Added informative tooltips to all table column headers across the application. Hovering over any column header now displays a description extracted from official esqlabsR documentation, helping users understand the purpose and expected values for each field. Resolved an issue in (#191).
+- **Validate Imported Excel file:** Use the R6 Validation Object from EsqlabsR and show the user where should be edited to resolve the critical error.
 
 #### **Bug Fixes**
 - **Numeric Column Export Fix:** Fixed export functionality to properly export numeric columns (weight, height, age, BMI, etc.) as numbers instead of text in Excel files. Added `NUMERIC_COLUMN_TYPE_LIST` configuration to automatically convert text-stored numeric values to proper numeric format during export across all sheets. Resolved an issue in (#191).

R/app_server.R

@@ -31,16 +31,17 @@ app_server <- function(input, output, session) {
 
   # Show export/import file status modal
   observeEvent(r$states$modal_message, {
+    req(r$states$modal_message)
+
+    msg <- isolate(r$states$modal_message)
 
     showModal(
       modalDialog(
-        title = r$states$modal_message$status,
-        p(
-          r$states$modal_message$message
-        ),
+        title = msg$status,
+        msg$message,
         easyClose = TRUE
       )
     )
     r$states$modal_message <- NULL
-  })
+  }, ignoreNULL = TRUE, ignoreInit = TRUE)
 }

R/data_structure.R

@@ -261,14 +261,25 @@ WarningHandler <- R6::R6Class(
     # Store warning messages
     warning_messages = NULL,
     invalid_sheets_name = NULL,
+    # Store validation results
+    validation_results = NULL,
+    critical_errors = NULL,
+    has_critical_errors = FALSE,
+    # Store esqlabsR validation results and summary
+    esqlabsR_results = NULL,
+    esqlabsR_summary = NULL,
 
 
     # Initialize
     initialize = function() {
       self$warning_messages <- reactiveValues()
+      self$validation_results <- reactiveValues()
+      self$critical_errors <- reactiveValues()
+      self$esqlabsR_results <- NULL
+      self$esqlabsR_summary <- NULL
     },
 
-    # Method to add a warning
+    # Method to add a warning (legacy support)
     add_warning = function(config_file, sheet_name, message, warning_code = NULL) {
       self$warning_messages$config_files <- c(self$warning_messages$config_files, config_file)
       warning_msg <- sprintf("Warning for sheet <b>'%s'</b>: %s", sheet_name, message)
@@ -278,6 +289,72 @@ WarningHandler <- R6::R6Class(
         self$invalid_sheets_name[[config_file]] <- c(self$invalid_sheets_name[[config_file]], sheet_name)
       }
 
+    },
+
+    # Method to add ValidationResult objects
+    add_validation_result = function(config_file, validation_result) {
+      self$validation_results[[config_file]] <- validation_result
+
+      # Process critical errors
+      if (validation_result$has_critical_errors) {
+        self$has_critical_errors <- TRUE
+        self$critical_errors[[config_file]] <- validation_result$get_formatted_messages("critical")
+      }
+
+      # Process warnings
+      if (validation_result$has_warnings) {
+        # Add to warning messages for display
+        warning_msgs <- validation_result$get_formatted_messages("warning")
+        self$warning_messages$config_files <- c(self$warning_messages$config_files, config_file)
+        self$warning_messages[[config_file]] <- c(self$warning_messages[[config_file]], warning_msgs)
+      }
+    },
+
+    # Add esqlabsR validation results
+    add_esqlabsR_validation = function(results, summary) {
+      self$esqlabsR_results <- results
+      self$esqlabsR_summary <- summary
+      self$has_critical_errors <- esqlabsR::isAnyCriticalErrors(results)
+
+      # Add summary to warning messages for display in modal
+      # summary can be a vector, so use length() and any() for proper check
+      if (!is.null(summary) && length(summary) > 0 && any(nzchar(summary))) {
+        self$warning_messages$config_files <- c(self$warning_messages$config_files, "esqlabsR_validation")
+        self$warning_messages[["esqlabsR_validation"]] <- summary
+      }
+    },
+
+    # Clear all validation results
+    clear_all = function() {
+      self$warning_messages <- reactiveValues()
+      self$validation_results <- reactiveValues()
+      self$critical_errors <- reactiveValues()
+      self$has_critical_errors <- FALSE
+      self$invalid_sheets_name <- NULL
+      self$esqlabsR_results <- NULL
+      self$esqlabsR_summary <- NULL
+    },
+
+    # Get summary of all validations
+    get_summary = function() {
+      total_critical <- 0
+      total_warnings <- 0
+
+      for (config_file in names(self$validation_results)) {
+        result <- self$validation_results[[config_file]]
+        if (!is.null(result)) {
+          summary <- result$get_summary()
+          total_critical <- total_critical + summary$critical_error_count
+          total_warnings <- total_warnings + summary$warning_count
+        }
+      }
+
+      list(
+        has_critical_errors = self$has_critical_errors,
+        total_critical_errors = total_critical,
+        total_warnings = total_warnings,
+        affected_files = names(self$validation_results)
+      )
     }
   )
 )

R/dropdown_utils.R

@@ -0,0 +1,197 @@
+#' Dropdown Population Utilities
+#'
+#' @description Configuration-driven system for populating dropdown menus
+#' from imported Excel data. Eliminates repetitive code and makes dropdown
+#' dependencies explicit.
+
+#' Populate Dropdowns from Configuration
+#'
+#' @description Populates dropdown options based on a configuration map.
+#' Automatically handles file existence checks, null checks, and data extraction.
+#'
+#' @param dropdowns The DROPDOWNS reactive values object to populate
+#' @param data The r$data object containing imported configuration data
+#' @param config A list defining dropdown mappings (see examples)
+#'
+#' @return NULL (modifies dropdowns in place)
+#'
+#' @examples
+#' \dontrun{
+#' config <- list(
+#'   scenarios = list(
+#'     individual_id = list(
+#'       file = "individuals",
+#'       sheet = "IndividualBiometrics",
+#'       column = "IndividualId"
+#'     )
+#'   )
+#' )
+#' populate_dropdowns(DROPDOWNS, r$data, config)
+#' }
+#'
+#' @export
+populate_dropdowns <- function(dropdowns, data, config) {
+  for (dropdown_group in names(config)) {
+    for (dropdown_name in names(config[[dropdown_group]])) {
+      dropdown_spec <- config[[dropdown_group]][[dropdown_name]]
+
+      # Extract specification
+      file_name <- dropdown_spec$file
+      sheet_name <- dropdown_spec$sheet
+      column_name <- dropdown_spec$column
+      extract_type <- dropdown_spec$extract  # e.g., "sheets", "unique"
+      transform <- dropdown_spec$transform   # Optional transformation function
+
+      # Check if file exists
+      file_path <- data[[file_name]]$file_path
+      if (is.null(file_path) || is.na(file_path) || !file.exists(file_path)) {
+        next
+      }
+
+      # Handle different extraction types
+      if (!is.null(extract_type)) {
+        if (extract_type == "sheets") {
+          # Extract sheet names
+          dropdowns[[dropdown_group]][[dropdown_name]] <- data[[file_name]]$sheets
+        }
+      } else if (!is.null(sheet_name) && !is.null(column_name)) {
+        # Extract column from sheet
+        sheet_data <- data[[file_name]][[sheet_name]]
+        if (is.null(sheet_data) || is.null(sheet_data$modified)) {
+          next
+        }
+
+        column_data <- sheet_data$modified[[column_name]]
+        if (is.null(column_data)) {
+          next
+        }
+
+        # Apply transformation if specified
+        if (!is.null(transform)) {
+          column_data <- transform(column_data)
+        } else {
+          # Default: get unique values
+          column_data <- unique(column_data)
+        }
+
+        dropdowns[[dropdown_group]][[dropdown_name]] <- column_data
+      }
+    }
+  }
+
+  invisible(NULL)
+}
+
+#' Create Named List Transformation
+#'
+#' @description Helper function to create a named list transformation for dropdowns
+#'
+#' @param names_col The column to use as names
+#' @param values_col The column to use as values
+#'
+#' @return A transformation function
+#'
+#' @export
+named_list_transform <- function(names_col, values_col) {
+  function(data) {
+    setNames(
+      as.list(as.character(data[[values_col]])),
+      data[[names_col]]
+    )
+  }
+}
+
+#' Get Default Dropdown Configuration
+#'
+#' @description Returns the default dropdown configuration for the application.
+#' This configuration defines which dropdowns pull data from which files/sheets/columns.
+#'
+#' @return A list defining dropdown mappings
+#'
+#' @export
+get_dropdown_config <- function() {
+  list(
+    scenarios = list(
+      individual_id = list(
+        file = "individuals",
+        sheet = "IndividualBiometrics",
+        column = "IndividualId"
+      ),
+      population_id = list(
+        file = "populations",
+        sheet = "Demographics",
+        column = "PopulationName"
+      ),
+      outputpath_id = list(
+        file = "scenarios",
+        sheet = "OutputPaths",
+        column = "OutputPathId"
+      ),
+      model_parameters = list(
+        file = "models",
+        extract = "sheets"
+      )
+    ),
+    plots = list(
+      path_options = list(
+        file = "scenarios",
+        sheet = "OutputPaths",
+        column = "OutputPath"
+      ),
+      scenario_options = list(
+        file = "scenarios",
+        sheet = "Scenarios",
+        column = "Scenario_name"
+      ),
+      datacombinedname_options = list(
+        file = "plots",
+        sheet = "DataCombined",
+        column = "DataCombinedName"
+      ),
+      plotgridnames_options = list(
+        file = "plots",
+        sheet = "plotGrids",
+        column = "name"
+      ),
+      plotids_options = list(
+        file = "plots",
+        sheet = "plotConfiguration",
+        column = "plotID"
+      )
+    ),
+    applications = list(
+      application_protocols = list(
+        file = "applications",
+        extract = "sheets"
+      )
+    )
+  )
+}
+
+#' Populate Special Dropdowns
+#'
+#' @description Handles special dropdown cases that don't fit the standard pattern
+#' (e.g., outputpath_id_alias which creates a named list)
+#'
+#' @param dropdowns The DROPDOWNS reactive values object to populate
+#' @param data The r$data object containing imported configuration data
+#'
+#' @return NULL (modifies dropdowns in place)
+#'
+#' @export
+populate_special_dropdowns <- function(dropdowns, data) {
+  # Handle outputpath_id_alias (named list mapping)
+  if (!is.null(data$scenarios$OutputPaths) &&
+      !is.null(data$scenarios$OutputPaths$modified)) {
+    output_paths <- data$scenarios$OutputPaths$modified
+
+    if (!is.null(output_paths$OutputPathId) && !is.null(output_paths$OutputPath)) {
+      dropdowns$scenarios$outputpath_id_alias <- setNames(
+        as.list(as.character(output_paths$OutputPath)),
+        output_paths$OutputPathId
+      )
+    }
+  }
+
+  invisible(NULL)
+}