diff --git a/DESCRIPTION b/DESCRIPTION index d5ffe51..144a436 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ 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"), diff --git a/R/app_server.R b/R/app_server.R index 2092743..e07aac9 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -21,7 +21,7 @@ app_server <- function(input, output, session) { DROPDOWNS <- dropdown_values() METADATA <- metadata_values() - mod_sidebar_server("sidebar_1", r, DROPDOWNS) + mod_sidebar_server("sidebar_1", r, DROPDOWNS, METADATA) mod_main_panel_server("main_panel_1", r, DROPDOWNS, METADATA) mod_warning_server("warning_modal", r) # Call warnings module mod_pc_block_server("pc_block_1", r) diff --git a/R/data_structure.R b/R/data_structure.R index 49bdd05..0a418b4 100644 --- a/R/data_structure.R +++ b/R/data_structure.R @@ -131,6 +131,21 @@ DataStructure <- R6::R6Class("DataStructure", self$applications <- reactiveValues(file_path = NA, sheets = NA) self$plots <- reactiveValues(file_path = NA, sheets = NA) }, + # Reset all data for new project upload + reset = function() { + for (config_file in self$get_config_files()) { + # Remove all sheet data + current_sheets <- self[[config_file]]$sheets + if (!is.null(current_sheets) && !all(is.na(current_sheets))) { + for (sheet in current_sheets) { + self[[config_file]][[sheet]] <- NULL + } + } + # Reset to initial state + self[[config_file]]$file_path <- NA + self[[config_file]]$sheets <- NA + } + }, get_config_files = function() { c("scenarios", "individuals", "populations", "models", "applications", "plots") }, @@ -262,10 +277,19 @@ WarningHandler <- R6::R6Class( warning_messages = NULL, invalid_sheets_name = NULL, - # Initialize initialize = function() { self$warning_messages <- reactiveValues() + self$invalid_sheets_name <- NULL + }, + + # Reset for new project + reset = function() { + # Clear values inside existing reactiveValues to preserve observer bindings + for (name in names(self$warning_messages)) { + self$warning_messages[[name]] <- NULL + } + self$invalid_sheets_name <- NULL }, # Method to add a warning diff --git a/R/mod_export.R b/R/mod_export.R index cf56fef..c9a0388 100644 --- a/R/mod_export.R +++ b/R/mod_export.R @@ -10,7 +10,15 @@ mod_export_ui <- function(id) { ns <- NS(id) tagList( - actionButton(ns("export"), "Export", class = "btn-dark", disabled = TRUE) + tags$div( + style = "display: flex; flex-direction: column; gap: 10px; width: 100%;", + save_dropdown_ui( + ns = ns, + esqapp_id = "downloadEsqapp", + zip_id = "downloadZip", + disabled = TRUE + ) + ) ) } @@ -21,90 +29,80 @@ mod_export_server <- function(id, r, configuration_path) { moduleServer(id, function(input, output, session) { ns <- session$ns - # Enable the export button when the configuration file is loaded first time + # Enable the export and download buttons when the configuration file is loaded first time observeEvent(configuration_path(), { - updateActionButton(session, inputId = "export", disabled = FALSE) + shinyjs::enable("downloadButton") }, once = TRUE ) - # Listen to the export button - observeEvent(input$export, { - message("exporting data") - - export_success <- TRUE # Track overall success - - for (config_file in r$data$get_config_files()) { - if (!golem::app_prod()) { - export_path <- paste0(fs::path_ext_remove(r$data[[config_file]]$file_path), "_copy.xlsx") + # Download handler for .esqapp file + output$downloadEsqapp <- downloadHandler( + filename = function() { + project_name <- if (!is.null(configuration_path()) && !is.null(configuration_path()$projectName)) { + gsub("[^A-Za-z0-9_-]", "_", configuration_path()$projectName) } else { - export_path <- r$data[[config_file]]$file_path + "project" } - - message("Exporting modified", config_file, " to ", export_path) - - sheet_list <- list() - - for (sheet in r$data[[config_file]]$sheets) { - df <- r$data[[config_file]][[sheet]]$modified - # Get columns for this sheet (if any dropdown) - dropdown_cols <- DROPDOWN_COLUMN_TYPE_LIST[[config_file]][[sheet]] - # replace "--NONE--" with NA if it exists - if (!is.null(dropdown_cols)) { - df[dropdown_cols] <- lapply(df[dropdown_cols], function(col) { - replace(col, col == "--NONE--", NA) - }) - } - # Convert numeric columns from text to numeric - numeric_cols <- NUMERIC_COLUMN_TYPE_LIST[[config_file]][[sheet]] - if (!is.null(numeric_cols)) { - # Only convert columns that exist in the dataframe - existing_numeric_cols <- intersect(numeric_cols, names(df)) - if (length(existing_numeric_cols) > 0) { - df[existing_numeric_cols] <- suppressWarnings( - lapply(df[existing_numeric_cols], function(col) { - as.numeric(as.character(col)) - }) - ) - } - } - # Save data to the `sheet_list` - sheet_list[[sheet]] <- df + paste0(project_name, "_", format(Sys.Date(), "%Y%m%d"), ".esqapp") + }, + content = function(file) { + # Get the project root directory + config_path <- configuration_path() + if (!is.null(config_path) && !is.null(config_path$projectConfigurationFilePath)) { + original_project_root <- dirname(config_path$projectConfigurationFilePath) + } else if (!is.null(r$config$project_root)) { + original_project_root <- r$config$project_root + } else { + showNotification("Cannot determine project root directory", type = "error") + return(NULL) } - # Try exporting and catch any errors - tryCatch( - { - rio::export( - x = sheet_list, - file = export_path - ) - message("Export successful: ", export_path) - }, - error = function(e) { - message("Error exporting ", config_file, ": File might be open or locked. Please close it and try again.") - r$states$modal_message <- list( - status = "Error: XLSX file might be open", - message = paste0( - "File might be open or locked. Please close ", fs::path_file(export_path), - " and try again." - ) - ) - export_success <<- FALSE # Mark failure - } + # Use the utility function to create the .esqapp file + create_esqapp_shiny( + original_project_root = original_project_root, + r = r, + output_file = file, + DROPDOWN_COLUMN_TYPE_LIST = DROPDOWN_COLUMN_TYPE_LIST, + NUMERIC_COLUMN_TYPE_LIST = NUMERIC_COLUMN_TYPE_LIST ) } + ) + + # Download handler for .zip file + output$downloadZip <- downloadHandler( + filename = function() { + project_name <- if (!is.null(configuration_path()) && !is.null(configuration_path()$projectName)) { + gsub("[^A-Za-z0-9_-]", "_", configuration_path()$projectName) + } else { + "project" + } + paste0(project_name, "_", format(Sys.Date(), "%Y%m%d"), ".zip") + }, + content = function(file) { + # Get the project root directory + config_path <- configuration_path() + if (!is.null(config_path) && !is.null(config_path$projectConfigurationFilePath)) { + original_project_root <- dirname(config_path$projectConfigurationFilePath) + } else if (!is.null(r$config$project_root)) { + original_project_root <- r$config$project_root + } else { + showNotification("Cannot determine project root directory", type = "error") + return(NULL) + } - # Set success message if no errors occurred - if (export_success) { - r$states$modal_message <- list( - status = "Success", - message = "Export completed successfully!" + # Use the utility function to create the .zip file (same as .esqapp, just different extension) + create_esqapp_shiny( + original_project_root = original_project_root, + r = r, + output_file = file, + DROPDOWN_COLUMN_TYPE_LIST = DROPDOWN_COLUMN_TYPE_LIST, + NUMERIC_COLUMN_TYPE_LIST = NUMERIC_COLUMN_TYPE_LIST ) } - }) + ) }) } diff --git a/R/mod_import.R b/R/mod_import.R index a1212c4..6a59048 100644 --- a/R/mod_import.R +++ b/R/mod_import.R @@ -10,11 +10,36 @@ mod_import_ui <- function(id) { ns <- NS(id) tagList( - shinyFiles::shinyFilesButton( - ns("projectConfigurationFile"), - "Select Project Configuration", - "Please select the projectConfiguration excel file", - multiple = FALSE + # Dropzone with hidden native fileInput inside + tags$div( + class = "dropzone", + id = ns("dropzone"), + `data-input-id` = ns("projectEsqapp"), + # Native Shiny fileInput (hidden via CSS) + fileInput( + ns("projectEsqapp"), + label = NULL, + accept = c(".esqapp", ".zip") + ), + # Visual elements + tags$div(class = "dropzone-icon", icon("cloud-arrow-up")), + tags$div( + class = "dropzone-text", + "Drag & drop your project here or ", + tags$strong("browse") + ), + tags$div(class = "dropzone-hint", "Accepts .esqapp or .zip files"), + # File info (shown after selection) + tags$div( + class = "dropzone-file-info", + tags$div(class = "dropzone-file-name"), + tags$div(class = "dropzone-file-size") + ) + ), + tags$script(src = "www/dropzone.js"), + # Hidden input to track if project is loaded + shinyjs::hidden( + textInput(ns("projectLoaded"), label = NULL, value = "false") ) ) } @@ -22,40 +47,161 @@ mod_import_ui <- function(id) { #' import Server Functions #' #' @noRd -mod_import_server <- function(id, r, DROPDOWNS) { +mod_import_server <- function(id, r, DROPDOWNS, METADATA) { moduleServer(id, function(input, output, session) { ns <- session$ns - volumes <- c( - "Current Project" = getwd(), - # "Test Project" = testthat::test_path("data"), - Home = Sys.getenv("R_USER"), - shinyFiles::getVolumes()() + # Track pending file and confirmed file separately + pending_file <- reactiveVal(NULL) + confirmed_file <- reactiveVal(NULL) + + # Check if a project is currently loaded + is_project_loaded <- reactive({ + !is.null(r$config$projectConfiguration) + }) + + # When file is selected, check if we need confirmation + observeEvent(input$projectEsqapp, { + req(input$projectEsqapp) + + if (is_project_loaded()) { + # Store pending file and show confirmation modal + pending_file(input$projectEsqapp) + showModal(modalDialog( + title = "Unsaved Changes", + size = "l", + tags$p("You have a project open. Loading a new project will discard any unsaved changes."), + tags$p("Would you like to save your current project first?"), + footer = tags$div( + style = "display: flex; flex-direction: column; gap: 8px; width: 100%;", + # Save dropdown button (reusable component) + save_dropdown_ui( + ns = ns, + esqapp_id = "save_and_continue_esqapp", + zip_id = "save_and_continue_zip", + button_label = " Save & Continue", + button_class = "btn btn-success dropdown-toggle", + button_style = "width: 100%;", + button_icon = icon("save") + ), + # Action buttons + tags$div( + style = "display: flex; gap: 8px; width: 100%;", + actionButton(ns("confirm_load"), "Continue without saving", class = "btn-warning", style = "flex: 1;"), + actionButton(ns("cancel_load"), "Cancel", style = "flex: 1;") + ) + ), + easyClose = FALSE + )) + } else { + # No project loaded, proceed directly + confirmed_file(input$projectEsqapp) + } + }) + + # User confirms loading new project + observeEvent(input$confirm_load, { + removeModal() + confirmed_file(pending_file()) + pending_file(NULL) + }) + + # User cancels loading + observeEvent(input$cancel_load, { + removeModal() + pending_file(NULL) + }) + + # Helper function to get project name + get_project_name <- function() { + if (!is.null(r$config$projectConfiguration) && + !is.null(r$config$projectConfiguration$projectName)) { + gsub("[^A-Za-z0-9_-]", "_", r$config$projectConfiguration$projectName) + } else { + "project" + } + } + + # Helper function to get project root + get_project_root <- function() { + config_path <- r$config$projectConfiguration + if (!is.null(config_path) && !is.null(config_path$projectConfigurationFilePath)) { + dirname(config_path$projectConfigurationFilePath) + } else if (!is.null(r$config$project_root)) { + r$config$project_root + } else { + NULL + } + } + + # Save as .esqapp & Continue + output$save_and_continue_esqapp <- downloadHandler( + filename = function() { + paste0(get_project_name(), ".esqapp") + }, + content = function(file) { + original_project_root <- get_project_root() + if (is.null(original_project_root)) { + showNotification("Cannot determine project root directory", type = "error") + return(NULL) + } + + create_esqapp_shiny( + original_project_root = original_project_root, + r = r, + output_file = file, + DROPDOWN_COLUMN_TYPE_LIST = DROPDOWN_COLUMN_TYPE_LIST, + NUMERIC_COLUMN_TYPE_LIST = NUMERIC_COLUMN_TYPE_LIST + ) + + removeModal() + confirmed_file(pending_file()) + pending_file(NULL) + } ) - shinyFiles::shinyFileChoose(input, - id = "projectConfigurationFile", - roots = volumes, - filetypes = c("xlsx"), - session = session + # Save as .zip & Continue + output$save_and_continue_zip <- downloadHandler( + filename = function() { + paste0(get_project_name(), ".zip") + }, + content = function(file) { + original_project_root <- get_project_root() + if (is.null(original_project_root)) { + showNotification("Cannot determine project root directory", type = "error") + return(NULL) + } + + create_esqapp_shiny( + original_project_root = original_project_root, + r = r, + output_file = file, + DROPDOWN_COLUMN_TYPE_LIST = DROPDOWN_COLUMN_TYPE_LIST, + NUMERIC_COLUMN_TYPE_LIST = NUMERIC_COLUMN_TYPE_LIST + ) + + removeModal() + confirmed_file(pending_file()) + pending_file(NULL) + } ) + # Reactive for project configuration (only triggers when confirmed_file changes) projectConfiguration <- reactive({ - req(input$projectConfigurationFile) - projectConfigurationFilePath <- shinyFiles::parseFilePaths( - volumes, - input$projectConfigurationFile - ) - req(projectConfigurationFilePath$datapath) - esqlabsR::createDefaultProjectConfiguration( - path = projectConfigurationFilePath$datapath - ) + req(confirmed_file()) + load_esqapp_shiny(confirmed_file()$datapath, confirmed_file()$name, r) }) - # Unchanged config + dropdown logic + # Load config + dropdown logic runAfterConfig <- function() { tryCatch( { + # Reset all reactive values before loading new project + r$data$reset() + r$warnings$reset() + r$observed_store <- reactiveValues(available = character(0), loaded = character(0)) + METADATA$plots$loaddata_metadata <- list() + config_map <- list( "scenarios" = projectConfiguration()$scenariosFile, "individuals" = projectConfiguration()$individualsFile, @@ -65,11 +211,10 @@ mod_import_server <- function(id, r, DROPDOWNS) { "plots" = projectConfiguration()$plotsFile ) + # Load all sheets first 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 @@ -77,29 +222,31 @@ mod_import_server <- function(id, r, DROPDOWNS) { 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 - ) - 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) - DROPDOWNS$applications$application_protocols <- unique(r$data$applications$sheets) } + + # Populate dropdowns with new data + 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 + ) + 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) + DROPDOWNS$plots$datasets_options <- c() + DROPDOWNS$applications$application_protocols <- unique(r$data$applications$sheets) }, error = function(e) { message("Error in reading the project configuration file: ", conditionMessage(e)) - r$states$modal_message <- list( - status = "Error in reading the project configuration file", - message = "File might be missing or not in the correct format. Please check the file and try again." + showNotification( + "Error reading configuration file. File might be missing or not in the correct format.", + type = "error", + duration = 10 ) return(NULL) } diff --git a/R/mod_sidebar.R b/R/mod_sidebar.R index 3b66b06..cd8cf48 100644 --- a/R/mod_sidebar.R +++ b/R/mod_sidebar.R @@ -11,9 +11,9 @@ mod_sidebar_ui <- function(id) { ns <- NS(id) bslib::sidebar( mod_import_ui(ns("import_project_configuration_1")), - hr(), + hr(class = "hr-dvivder-esqapp"), mod_visulizer_app_ui(ns("visulizer_app")), - hr(), + hr(class = "hr-dvivder-esqapp"), mod_export_ui(ns("export_1")), tags$footer( style = " @@ -44,11 +44,11 @@ mod_sidebar_ui <- function(id) { #' sidebar Server Functions #' #' @noRd -mod_sidebar_server <- function(id, r, DROPDOWNS) { +mod_sidebar_server <- function(id, r, DROPDOWNS, METADATA) { moduleServer(id, function(input, output, session) { ns <- session$ns - configuration_path <- mod_import_server("import_project_configuration_1", r, DROPDOWNS) + configuration_path <- mod_import_server("import_project_configuration_1", r, DROPDOWNS, METADATA) mod_visulizer_app_server("visulizer_app") mod_export_server("export_1", r, configuration_path = configuration_path) diff --git a/R/ui_components.R b/R/ui_components.R index 7f03971..47369c5 100644 --- a/R/ui_components.R +++ b/R/ui_components.R @@ -31,3 +31,83 @@ cross_btn <- function(sheet, ns) { ) ) } + +#' Create Save Project Dropdown Button +#' +#' @description Creates a Bootstrap dropdown button with options to save project +#' as .esqapp or .zip format. Used in both export module and import confirmation modal. +#' +#' @param ns Namespace function from the Shiny module +#' @param esqapp_id ID for the .esqapp download button +#' @param zip_id ID for the .zip download button +#' @param button_id ID for the main dropdown button (default: "downloadButton") +#' @param button_label Label for the main dropdown button (default: " Save Project ") +#' @param button_class CSS class for the button (default: "btn btn-dark dropdown-toggle") +#' @param button_style Additional inline styles for the button +#' @param button_icon Icon for the button (default: download icon) +#' @param disabled Whether the button should be initially disabled (default: FALSE) +#' +#' @return A tagList containing the dropdown button UI +#' +#' @noRd +save_dropdown_ui <- function(ns, + esqapp_id, + zip_id, + button_id = "downloadButton", + button_label = " Save Project ", + button_class = "btn btn-dark dropdown-toggle", + button_style = "width: 100%; padding: 10px 10px;", + button_icon = shiny::icon("download"), + disabled = FALSE) { + # Build button with conditional disabled attribute + btn_args <- list( + id = ns(button_id), + type = "button", + class = button_class, + style = button_style, + `data-bs-toggle` = "dropdown", + `aria-expanded` = "false", + button_icon, + button_label, + shiny::tags$span(class = "caret") + ) + if (disabled) { + btn_args$disabled <- NA + } + + shiny::tags$div( + class = "btn-group", + style = "width: 100%;", + role = "group", + do.call(shiny::tags$button, btn_args), + shiny::tags$ul( + class = "dropdown-menu", + style = "width: 100%;", + shiny::tags$li( + shiny::downloadButton( + ns(esqapp_id), + label = shiny::tagList( + shiny::icon("file-archive"), + " Save as ", + shiny::tags$em(style = "color: #404040; font-weight: 100;", ".esqapp") + ), + class = "btn-link", + style = "width: 100%; text-align: left; border: none; padding: 8px 10px;" + ) + ), + shiny::tags$li(shiny::tags$hr(class = "dropdown-divider", style = "margin: 5px 0;")), + shiny::tags$li( + shiny::downloadButton( + ns(zip_id), + label = shiny::tagList( + shiny::icon("file-zipper"), + " Save as ", + shiny::tags$em(style = "color: #404040; font-weight: 100;", ".zip") + ), + class = "btn-link", + style = "width: 100%; text-align: left; border: none; padding: 8px 10px;" + ) + ) + ) + ) +} diff --git a/R/utils_esqapp_shiny.R b/R/utils_esqapp_shiny.R new file mode 100644 index 0000000..cc39e91 --- /dev/null +++ b/R/utils_esqapp_shiny.R @@ -0,0 +1,267 @@ +#' Load .esqapp file in Shiny application +#' +#' @param zip_path Path to the uploaded .esqapp file +#' @param file_name Original filename +#' @param r Reactive values object to store project root and temp directory +#' +#' @return Project configuration object or NULL on error +#' @noRd +load_esqapp_shiny <- function(zip_path, file_name, r) { + file_ext <- tools::file_ext(file_name) + if (!file_ext %in% c("esqapp", "zip")) { + shiny::showNotification("Please upload a valid .esqapp or .zip file", type = "error", duration = 8) + return(NULL) + } + + pc <- shiny::withProgress(message = 'Loading project...', value = 0, { + shiny::incProgress(0.2, detail = "Validating file...") + + validation_result <- tryCatch({ + file_list <- unzip(zip_path, list = TRUE) + has_config <- any(grepl("ProjectConfiguration\\.xlsx$", file_list$Name, ignore.case = TRUE)) + + if (!has_config) { + shiny::showNotification("Invalid .esqapp: ProjectConfiguration.xlsx file not found", type = "error", duration = 8) + return(NULL) + } + TRUE + }, error = function(e) { + shiny::showNotification(paste0("Invalid .esqapp file: ", e$message), type = "error", duration = 8) + return(NULL) + }) + + if (is.null(validation_result)) { + return(NULL) + } + + shiny::incProgress(0.4, detail = "Extracting files...") + + temp_dir <- file.path(tempdir(), paste0("esqapp_", format(Sys.time(), "%Y%m%d_%H%M%S"))) + dir.create(temp_dir, showWarnings = FALSE, recursive = TRUE) + + extract_result <- tryCatch({ + unzip(zip_path, exdir = temp_dir) + TRUE + }, error = function(e) { + shiny::showNotification(paste0("Failed to extract .esqapp: ", e$message), type = "error", duration = 8) + return(NULL) + }) + + if (is.null(extract_result)) { + return(NULL) + } + + shiny::incProgress(0.6, detail = "Finding configuration...") + + config_file <- list.files(temp_dir, + pattern = "ProjectConfiguration\\.xlsx$", + recursive = TRUE, + full.names = TRUE, + ignore.case = TRUE + )[1] + + if (is.na(config_file)) { + shiny::showNotification("ProjectConfiguration.xlsx file not found after extraction", type = "error", duration = 8) + return(NULL) + } + + shiny::incProgress(0.8, detail = "Loading configuration...") + + project_root <- dirname(config_file) + + old_wd <- getwd() + setwd(project_root) + + pc <- tryCatch({ + esqlabsR::createDefaultProjectConfiguration(path = basename(config_file)) + }, error = function(e) { + setwd(old_wd) + shiny::showNotification(paste0("Failed to load configuration: ", e$message), type = "error", duration = 10) + return(NULL) + }) + + setwd(old_wd) + + if (is.null(pc)) { + return(NULL) + } + + r$config$project_root <- project_root + r$config$temp_dir <- temp_dir + + shiny::incProgress(1, detail = "Complete!") + + return(pc) + }) + + if (!is.null(pc)) { + shiny::showNotification("Project loaded successfully!", type = "message", duration = 5) + } + + return(pc) +} + + +#' Create .esqapp file for download +#' +#' @param original_project_root Path to the original project root directory +#' @param r Reactive values object containing data +#' @param output_file Path where to save the .esqapp file +#' @param DROPDOWN_COLUMN_TYPE_LIST List of dropdown column types +#' @param NUMERIC_COLUMN_TYPE_LIST List of numeric column types +#' +#' @return TRUE on success, FALSE on failure +#' @noRd +create_esqapp_shiny <- function(original_project_root, r, output_file, + DROPDOWN_COLUMN_TYPE_LIST, NUMERIC_COLUMN_TYPE_LIST) { + + # Determine file extension for notifications + file_ext <- tools::file_ext(output_file) + if (file_ext == "") file_ext <- "esqapp" + + shiny::withProgress(message = paste0('Creating .', file_ext, ' file...'), value = 0, { + shiny::incProgress(0.2, detail = "Preparing files...") + + temp_export_dir <- file.path(tempdir(), paste0("esqapp_export_", format(Sys.time(), "%Y%m%d_%H%M%S"))) + dir.create(temp_export_dir, showWarnings = FALSE, recursive = TRUE) + + export_success <- TRUE + + shiny::incProgress(0.3, detail = "Recreating directory structure...") + + tryCatch({ + all_dirs <- list.dirs(original_project_root, full.names = FALSE, recursive = TRUE) + all_dirs <- all_dirs[all_dirs != ""] + + for (dir_path in all_dirs) { + dest_dir <- file.path(temp_export_dir, dir_path) + if (!dir.exists(dest_dir)) { + dir.create(dest_dir, recursive = TRUE, showWarnings = FALSE) + } + } + }, error = function(e) { + message("Error creating directory structure: ", e$message) + }) + + shiny::incProgress(0.4, detail = "Copying project files...") + + tryCatch({ + config_files_to_export <- sapply(r$data$get_config_files(), function(cf) { + r$data[[cf]]$file_path + }) + + config_files_normalized <- gsub("\\\\", "/", config_files_to_export) + + all_files <- list.files(original_project_root, + full.names = FALSE, + recursive = TRUE, + all.files = FALSE) + + for (rel_path in all_files) { + src_file <- file.path(original_project_root, rel_path) + dest_file <- file.path(temp_export_dir, rel_path) + + src_file_normalized <- gsub("\\\\", "/", src_file) + + if (src_file_normalized %in% config_files_normalized) { + next + } + + dest_dir <- dirname(dest_file) + if (!dir.exists(dest_dir)) { + dir.create(dest_dir, recursive = TRUE, showWarnings = FALSE) + } + + if (file.exists(src_file) && !file.info(src_file)$isdir) { + file.copy(src_file, dest_file, overwrite = TRUE) + } + } + }, error = function(e) { + message("Error copying project files: ", e$message) + }) + + shiny::incProgress(0.6, detail = "Exporting modified data...") + + for (config_file in r$data$get_config_files()) { + original_file_path <- r$data[[config_file]]$file_path + + rel_path <- if (startsWith(original_file_path, original_project_root)) { + norm_root <- gsub("\\\\", "/", original_project_root) + norm_path <- gsub("\\\\", "/", original_file_path) + sub(paste0("^", norm_root, "/?"), "", norm_path) + } else { + basename(original_file_path) + } + + export_path <- file.path(temp_export_dir, rel_path) + + sheet_list <- list() + + for (sheet in r$data[[config_file]]$sheets) { + df <- r$data[[config_file]][[sheet]]$modified + dropdown_cols <- DROPDOWN_COLUMN_TYPE_LIST[[config_file]][[sheet]] + if (!is.null(dropdown_cols)) { + df[dropdown_cols] <- lapply(df[dropdown_cols], function(col) { + replace(col, col == "--NONE--", NA) + }) + } + numeric_cols <- NUMERIC_COLUMN_TYPE_LIST[[config_file]][[sheet]] + if (!is.null(numeric_cols)) { + existing_numeric_cols <- intersect(numeric_cols, names(df)) + if (length(existing_numeric_cols) > 0) { + df[existing_numeric_cols] <- suppressWarnings( + lapply(df[existing_numeric_cols], function(col) { + as.numeric(as.character(col)) + }) + ) + } + } + sheet_list[[sheet]] <- df + } + + tryCatch({ + rio::export(x = sheet_list, file = export_path) + }, error = function(e) { + message("Error exporting ", config_file, ": ", e$message) + export_success <<- FALSE + }) + } + + if (!export_success) { + shiny::showNotification("Failed to export some files", type = "error", duration = 8) + return(FALSE) + } + + shiny::incProgress(0.7, detail = "Creating archive...") + + tryCatch({ + old_wd_zip <- getwd() + setwd(temp_export_dir) + + files_to_zip <- list.files(".", recursive = TRUE, all.files = FALSE, include.dirs = FALSE) + + if (length(files_to_zip) == 0) { + setwd(old_wd_zip) + shiny::showNotification("No files to export", type = "error", duration = 8) + return(FALSE) + } + + utils::zip(zipfile = output_file, files = files_to_zip, flags = "-r9Xq") + + setwd(old_wd_zip) + + shiny::incProgress(0.9, detail = "Cleaning up...") + + unlink(temp_export_dir, recursive = TRUE) + + shiny::incProgress(1, detail = "Complete!") + }, error = function(e) { + tryCatch(setwd(old_wd_zip), error = function(e2) {}) + shiny::showNotification(paste0("Failed to create .", file_ext, ": ", e$message), type = "error", duration = 10) + return(FALSE) + }) + }) + + shiny::showNotification(paste0(".", file_ext, " file created successfully!"), type = "message", duration = 5) + return(TRUE) +} \ No newline at end of file diff --git a/inst/app/www/dropzone.js b/inst/app/www/dropzone.js new file mode 100644 index 0000000..6a2360d --- /dev/null +++ b/inst/app/www/dropzone.js @@ -0,0 +1,121 @@ +// Drag and Drop enhancement for Shiny fileInput +$(function() { + function initDropzones() { + $(".dropzone").each(function() { + var $dropzone = $(this); + if ($dropzone.data("dropzone-init")) return; + $dropzone.data("dropzone-init", true); + + // Find the native Shiny fileInput inside + var $fileInput = $dropzone.find("input[type='file']"); + if (!$fileInput.length) return; + + var $fileInfo = $dropzone.find(".dropzone-file-info"); + var $fileName = $dropzone.find(".dropzone-file-name"); + var $fileSize = $dropzone.find(".dropzone-file-size"); + + var suppressClick = false; + + // Click on dropzone triggers the native file input + $dropzone.on("click", function(e) { + if (suppressClick) return; + $fileInput.trigger("click"); + }); + + // Prevent file input click from bubbling back to dropzone + $fileInput.on("click", function(e) { + e.stopPropagation(); + }); + + // Drag highlight + $dropzone.on("dragover dragenter", function(e) { + e.preventDefault(); + e.stopPropagation(); + $dropzone.addClass("dragover"); + }); + + $dropzone.on("dragleave dragend", function(e) { + e.preventDefault(); + e.stopPropagation(); + $dropzone.removeClass("dragover"); + }); + + // Drop handler - set files on the native Shiny input + $dropzone.on("drop", function(e) { + e.preventDefault(); + e.stopPropagation(); + $dropzone.removeClass("dragover"); + + var dt = e.originalEvent && e.originalEvent.dataTransfer; + if (!dt || !dt.files || !dt.files.length) return; + + var file = dt.files[0]; + var ext = (file.name.split(".").pop() || "").toLowerCase(); + + if (["esqapp", "zip"].indexOf(ext) === -1) { + Shiny.notifications.show({ + html: "Please upload a .esqapp or .zip file", + type: "error", + duration: 5000 + }); + return; + } + + // Set file on the native Shiny fileInput + try { + var list = new DataTransfer(); + list.items.add(file); + $fileInput[0].files = list.files; + // Trigger change to notify Shiny + $fileInput.trigger("change"); + showFileInfo(file); + } catch (err) { + Shiny.notifications.show({ + html: "Drag-drop not supported in this browser", + type: "error", + duration: 5000 + }); + } + + // Prevent ghost click + suppressClick = true; + setTimeout(function() { suppressClick = false; }, 300); + }); + + // When file is selected via native input, show info + $fileInput.on("change", function() { + var files = this.files; + if (files && files.length > 0) { + showFileInfo(files[0]); + } else { + $fileInfo.removeClass("show"); + } + }); + + function showFileInfo(file) { + var ext = (file.name.split(".").pop() || "").toLowerCase(); + if (["esqapp", "zip"].indexOf(ext) !== -1) { + $fileName.text(file.name); + $fileSize.text(formatFileSize(file.size)); + $fileInfo.addClass("show"); + } + } + }); + } + + function formatFileSize(bytes) { + if (bytes === 0) return "0 Bytes"; + var k = 1024; + var sizes = ["Bytes", "KB", "MB", "GB"]; + var i = Math.floor(Math.log(bytes) / Math.log(k)); + return parseFloat((bytes / Math.pow(k, i)).toFixed(2)) + " " + sizes[i]; + } + + // Init on page load + initDropzones(); + + // Re-init when Shiny updates UI + $(document).on("shiny:value", function() { + setTimeout(initDropzones, 100); + }); +}); diff --git a/inst/app/www/style.css b/inst/app/www/style.css index 3ce0a8b..44fdc3e 100644 --- a/inst/app/www/style.css +++ b/inst/app/www/style.css @@ -12,3 +12,101 @@ /* .tab-content>.active.html-fill-container { width: calc(100% + 15%) !important; } */ + +/* Drag and Drop File Upload */ +.dropzone { + position: relative; + border: 2px dashed #ccc; + border-radius: 8px; + padding: 30px 20px; + text-align: center; + cursor: pointer; + transition: all 0.2s ease; + background: #fafafa; +} + +/* Make child elements pass clicks through to dropzone */ +.dropzone-icon, +.dropzone-text, +.dropzone-hint { + pointer-events: none; +} + +.dropzone:hover { + border-color: #61c0ca; + background: #f0f9fa; +} + +.dropzone.dragover { + border-color: #61c0ca; + background: #e8f6f8; + border-style: solid; +} + +.dropzone-icon { + font-size: 2.5rem; + color: #999; + margin-bottom: 10px; + transition: color 0.2s ease; +} + +.dropzone:hover .dropzone-icon, +.dropzone.dragover .dropzone-icon { + color: #61c0ca; +} + +.dropzone-text { + color: #666; + margin-bottom: 5px; + font-size: 0.95rem; +} + +.dropzone-text strong { + color: #61c0ca; +} + +.dropzone-hint { + color: #999; + font-size: 0.8rem; +} + +.dropzone-file-info { + display: none; + margin-top: 10px; + padding: 4px 10px; + background: #e8f6f8; + border-radius: 4px; + font-size: 0.8rem; + text-align: center; +} + +.dropzone-file-info.show { + display: block; +} + +.dropzone-file-name { + font-weight: 500; + color: #333; +} + +.dropzone-file-size { + color: #888; + font-size: 0.75rem; +} + +/* Hide the native Shiny fileInput inside dropzone */ +.dropzone > .form-group { + position: absolute; + width: 1px; + height: 1px; + padding: 0; + margin: -1px; + overflow: hidden; + clip: rect(0, 0, 0, 0); + border: 0; +} + + +.hr-dvivder-esqapp { + margin: 0.25rem 0 !important; +} diff --git a/tests/testthat/data/TestProject.esqapp b/tests/testthat/data/TestProject.esqapp new file mode 100644 index 0000000..280bc4c Binary files /dev/null and b/tests/testthat/data/TestProject.esqapp differ