feat: возможность полного обновления базы данных из эксель-таблицы

app.R

@@ -55,7 +55,7 @@ ui <- page_sidebar(
     actionButton("clean_data_button", "Главная страница", icon("house", lib = "font-awesome")),
     actionButton("load_data_button", "Загрузить данные", icon("pencil", lib = "font-awesome")),
     downloadButton("downloadDocx", "get .docx (test only)"),
-    textOutput("status_message"),
+    uiOutput("status_message"),
     textOutput("status_message2"),
     uiOutput("display_log"),
     position = "left",
@@ -282,7 +282,7 @@ server <- function(input, output, session) {
       exported_df <- exported_df |>
         mutate(
           !!dplyr::sym(mhcs()$get_main_key_id) := values$main_key,
-          !!dplyr::sym(nested_key_id) := values$nested_key,
+          !!dplyr::sym(nested_key_id)          := values$nested_key,
           .before = 1
         )
     }
@@ -294,7 +294,7 @@ server <- function(input, output, session) {
       df = exported_df,
       table_name = table_name,
       schm = mhcs(),
-      main_key_value = values$main_key,
+      main_key_value   = values$main_key,
       nested_key_value = values$nested_key,
       con = con
     )
@@ -650,12 +650,16 @@ server <- function(input, output, session) {
 
   # STATUSES ===============================
   # вывести отображение что что-то не так
-  output$status_message <- renderText({
-    scheme()
+  output$status_message <- renderUI({
+
     shiny::validate(
       need(values$main_key, "⚠️ Необходимо указать id пациента!")
     )
-    paste0("ID: ", values$main_key)
+    span(
+      strong("Таблица: "), names(enabled_schemas)[enabled_schemas == scheme()],
+      br(),
+      strong("ID: "), values$main_key
+    )
   })
 
   output$status_message2 <- renderText({
@@ -806,8 +810,8 @@ server <- function(input, output, session) {
         ui_load_menu,
         title = "Загрузить имеющиеся данные",
         footer = tagList(
-          actionButton("close_modal_button", "Отмена", class = "btn btn-danger"),
           actionButton("load_data", "Загрузить данные"),
+          actionButton("close_modal_button", "Отмена", class = "btn-danger"),
         ),
         easyClose = TRUE
       )
@@ -1005,8 +1009,8 @@ server <- function(input, output, session) {
       ),
       checkboxInput("upload_data_from_xlsx_owerwrite_all_data", "перезаписать все данные", width = 450),
       footer = tagList(
-        modalButton("Отмена"),
-        actionButton("button_upload_data_from_xlsx_confirm", "Добавить")
+        actionButton("button_upload_data_from_xlsx_confirm", "Добавить"),
+        actionButton("close_modal_button", "Отмена", class = "btn-danger")
       ),
       easyClose = FALSE
     ))
@@ -1034,19 +1038,17 @@ server <- function(input, output, session) {
     for (table_name in mhcs()$all_tables_names) {
 
       df     <- openxlsx2::read_xlsx(wb, table_name) 
-      scheme <- mhcs()$get_schema(table_name) |>
-        filter(!form_type %in% c("description", "nested_forms"))
+      scheme <- mhcs()$get_schema_with_values_forms(table_name) 
 
       # столбцы в таблицы и схема
       df_to_schema_compare <- setdiff(colnames(df), unique(scheme$form_id))
       schema_to_df_compare <- setdiff(unique(scheme$form_id), colnames(df))
 
-      if (length(schema_to_df_compare) > 0 ) {
+      if (length(df_to_schema_compare) > 0 ) {
         cli::cli_warn(c("в схеме для '{table_name}' нет следующих столбцов:", paste("- ", df_to_schema_compare)))
       }
 
       # схема и столбцы в таблице
-      schema_to_df_compare <- setdiff(unique(scheme$form_id), colnames(df))
       if (length(schema_to_df_compare) > 0 ) {
 
         message <- glue::glue("столбцы в таблице '{table_name}' не соответсвуют схеме")
@@ -1061,8 +1063,7 @@ server <- function(input, output, session) {
     for (table_name in mhcs()$all_tables_names) {
 
       df     <- openxlsx2::read_xlsx(wb, table_name) 
-      scheme <- mhcs()$get_schema(table_name) |>
-        filter(!form_type %in% c("description", "nested_forms"))
+      scheme <- mhcs()$get_schema_with_values_forms(table_name)
 
       date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)
       number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
@@ -1091,17 +1092,24 @@ server <- function(input, output, session) {
       df_original <- DBI::dbReadTable(con, table_name) |>
         as_tibble()
 
-      if (input$upload_data_from_xlsx_owerwrite_all_data == TRUE) cli::cli_abort("not implemented yet")
+      if (input$upload_data_from_xlsx_owerwrite_all_data == TRUE) {
 
-      walk(
-        .x = unique(df[[main_key_id]]),
-        .f = \(main_key) {
+        DBI::dbRemoveTable(con, table_name)
 
-          if (main_key %in% unique(df_original[[main_key_id]])) {
-            DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE {main_key_id} = '{main_key}'"))
+      } else {
+
+        # удаление данных в базе данных по ключам
+        walk(
+          .x = unique(df[[main_key_id]]),
+          .f = \(main_key) {
+
+            if (main_key %in% unique(df_original[[main_key_id]])) {
+              DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE {main_key_id} = '{main_key}'"))
+            }
           }
-        }
-      )
+        )
+     
+      }
 
       DBI::dbWriteTable(
         con,
@@ -1116,7 +1124,7 @@ server <- function(input, output, session) {
         type = "message"
       )
       cli::cli_alert_success(message)
-    }
+      }
     log_action_to_db("importing data from xlsx", con = con)
     removeModal()
   })