Implement comprehensive three-tier validation system for Excel imports

R/data_structure.R

@@ -241,14 +241,20 @@ 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,
 
 
     # Initialize
     initialize = function() {
       self$warning_messages <- reactiveValues()
+      self$validation_results <- reactiveValues()
+      self$critical_errors <- reactiveValues()
     },
 
-    # 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)
@@ -258,6 +264,56 @@ 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)
+      }
+    },
+
+    # 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
+    },
+
+    # 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/mod_import.R

@@ -47,12 +47,38 @@ mod_import_server <- function(id, r, DROPDOWNS) {
         input$projectConfigurationFile
       )
       req(projectConfigurationFilePath$datapath)
-      esqlabsR::createDefaultProjectConfiguration(
-        path = projectConfigurationFilePath$datapath
-      )
+
+      # Clear previous validation results
+      r$warnings$clear_all()
+
+      # Validate project configuration first
+      pc_validation <- validate_project_configuration(projectConfigurationFilePath$datapath)
+      r$warnings$add_validation_result("project_configuration", pc_validation)
+
+      if (pc_validation$has_critical_errors) {
+        # Show critical error modal
+        showModal(
+          modalDialog(
+            title = "Critical Validation Errors",
+            HTML(paste0(
+              "<h4>Cannot import project configuration due to critical errors:</h4>",
+              "<ul>",
+              paste0("<li>", pc_validation$get_formatted_messages("critical"), "</li>", collapse = ""),
+              "</ul>",
+              "<p>Please fix these errors and try again.</p>"
+            )),
+            easyClose = TRUE,
+            footer = modalButton("Close")
+          )
+        )
+        return(NULL)
+      }
+
+      # Return the valid project configuration
+      pc_validation$data
     })
 
-    # Unchanged config + dropdown logic
+    # Enhanced config + dropdown logic with validation
     runAfterConfig <- function() {
       tryCatch(
         {
@@ -65,33 +91,103 @@ mod_import_server <- function(id, r, DROPDOWNS) {
             "plots"        = projectConfiguration()$plotsFile
           )
 
+          # Track overall validation status
+          has_any_critical_errors <- FALSE
+
+          # Validate and import each configuration file
           for (config_file in r$data$get_config_files()) {
             r$data[[config_file]]$file_path <- config_map[[config_file]]
 
-
             # Check if the file path is valid
             if (!is.na(r$data[[config_file]]$file_path) && file.exists(r$data[[config_file]]$file_path)) {
-              sheet_names <- readxl::excel_sheets(r$data[[config_file]]$file_path)
-              r$data[[config_file]]$sheets <- sheet_names
-              for (sheet in sheet_names) {
-                r$data$add_sheet(config_file, sheet, r$warnings)
+              # Run appropriate validation based on file type
+              validation_result <- NULL
+
+              if (config_file == "scenarios") {
+                validation_result <- validate_scenarios_file(r$data[[config_file]]$file_path, projectConfiguration())
+                r$warnings$add_validation_result(config_file, validation_result)
+              } else if (config_file == "plots") {
+                # Get scenarios data for reference validation
+                scenarios_data <- NULL
+                if (!is.null(r$warnings$validation_results[["scenarios"]])) {
+                  scenarios_data <- r$warnings$validation_results[["scenarios"]]$data
+                }
+                validation_result <- validate_plots_file(r$data[[config_file]]$file_path, scenarios_data, NULL)
+                r$warnings$add_validation_result(config_file, validation_result)
+              }
+              # Add more validations for other file types as needed...
+
+              # Check for critical errors
+              if (!is.null(validation_result) && validation_result$has_critical_errors) {
+                has_any_critical_errors <- TRUE
+                # Skip importing this file due to critical errors
+                message(sprintf("Skipping %s due to critical validation errors", config_file))
+              } else {
+                # Import sheets if no critical errors
+                sheet_names <- readxl::excel_sheets(r$data[[config_file]]$file_path)
+                r$data[[config_file]]$sheets <- sheet_names
+                for (sheet in sheet_names) {
+                  r$data$add_sheet(config_file, sheet, r$warnings)
+                }
               }
             }
+          }
 
-            # Populate dropdowns
-            DROPDOWNS$scenarios$individual_id       <- r$data$individuals$IndividualBiometrics$modified$IndividualId
-            DROPDOWNS$scenarios$population_id       <- r$data$populations$Demographics$modified$PopulationName
-            DROPDOWNS$scenarios$outputpath_id       <- r$data$scenarios$OutputPaths$modified$OutputPathId
-            DROPDOWNS$scenarios$outputpath_id_alias <- setNames(
-              as.list(as.character(r$data$scenarios$OutputPaths$modified$OutputPath)),
-              r$data$scenarios$OutputPaths$modified$OutputPathId
+          # Show critical errors modal if any exist
+          if (has_any_critical_errors) {
+            summary <- r$warnings$get_summary()
+            showModal(
+              modalDialog(
+                title = "Validation Results - Critical Errors Found",
+                HTML(paste0(
+                  "<h4>Some files have critical errors and were not imported:</h4>",
+                  "<p>Total critical errors: ", summary$total_critical_errors, "</p>",
+                  "<p>Total warnings: ", summary$total_warnings, "</p>",
+                  "<p>Affected files: ", paste(summary$affected_files, collapse = ", "), "</p>",
+                  "<br>",
+                  "<p>Click the warning icon in the navigation bar for details.</p>"
+                )),
+                easyClose = TRUE,
+                footer = modalButton("Close")
+              )
             )
-            DROPDOWNS$scenarios$model_parameters     <- unique(r$data$models$sheets)
-            DROPDOWNS$plots$scenario_options        <- unique(r$data$scenarios$Scenarios$modified$Scenario_name)
-            DROPDOWNS$plots$path_options            <- unique(r$data$scenarios$OutputPaths$modified$OutputPath)
-            DROPDOWNS$plots$datacombinedname_options<- unique(r$data$plots$DataCombined$modified$DataCombinedName)
-            DROPDOWNS$plots$plotgridnames_options   <- unique(r$data$plots$plotGrids$modified$name)
-            DROPDOWNS$plots$plotids_options         <- unique(r$data$plots$plotConfiguration$modified$plotID)
+          }
+
+          # Only populate dropdowns if data was successfully imported
+          if (file.exists(r$data$individuals$file_path) && !is.null(r$data$individuals$IndividualBiometrics)) {
+            DROPDOWNS$scenarios$individual_id <- r$data$individuals$IndividualBiometrics$modified$IndividualId
+          }
+          if (file.exists(r$data$populations$file_path) && !is.null(r$data$populations$Demographics)) {
+            DROPDOWNS$scenarios$population_id <- r$data$populations$Demographics$modified$PopulationName
+          }
+          if (file.exists(r$data$scenarios$file_path)) {
+            if (!is.null(r$data$scenarios$OutputPaths)) {
+              DROPDOWNS$scenarios$outputpath_id <- r$data$scenarios$OutputPaths$modified$OutputPathId
+              DROPDOWNS$scenarios$outputpath_id_alias <- setNames(
+                as.list(as.character(r$data$scenarios$OutputPaths$modified$OutputPath)),
+                r$data$scenarios$OutputPaths$modified$OutputPathId
+              )
+              DROPDOWNS$plots$path_options <- unique(r$data$scenarios$OutputPaths$modified$OutputPath)
+            }
+            if (!is.null(r$data$scenarios$Scenarios)) {
+              DROPDOWNS$plots$scenario_options <- unique(r$data$scenarios$Scenarios$modified$Scenario_name)
+            }
+          }
+          if (file.exists(r$data$models$file_path)) {
+            DROPDOWNS$scenarios$model_parameters <- unique(r$data$models$sheets)
+          }
+          if (file.exists(r$data$plots$file_path)) {
+            if (!is.null(r$data$plots$DataCombined)) {
+              DROPDOWNS$plots$datacombinedname_options <- unique(r$data$plots$DataCombined$modified$DataCombinedName)
+            }
+            if (!is.null(r$data$plots$plotGrids)) {
+              DROPDOWNS$plots$plotgridnames_options <- unique(r$data$plots$plotGrids$modified$name)
+            }
+            if (!is.null(r$data$plots$plotConfiguration)) {
+              DROPDOWNS$plots$plotids_options <- unique(r$data$plots$plotConfiguration$modified$plotID)
+            }
+          }
+          if (file.exists(r$data$applications$file_path)) {
             DROPDOWNS$applications$application_protocols <- unique(r$data$applications$sheets)
           }
         },