fix: некорректная загрузка box-модуля

.Rprofile

@@ -1 +1,21 @@
 source("renv/activate.R")
+
+
+(function() {
+
+  paths <- c(
+    "FORM_AUTH_ENABLED",
+    "FORM_VERSION",
+    "FORM_TITLE"
+  )
+
+  lines <- paths[Sys.getenv(paths) == ""]
+
+  if (length(lines) > 0) {
+    cli::cli_h3("Настройка путей окружения")
+    cli::cli_code(paste0(lines, "="))
+    cli::cli_inform(c(
+      "i" = "Для нормальной работы скриптов добавьте в {.file .Renviron}:"
+    ))
+  }
+})()

app.R

@@ -11,8 +11,6 @@ suppressPackageStartupMessages({
 
 # КАК ЗАПРЯТЯАТЬ ID
 
-source("helpers/functions.R")
-
 # SOURCE FILES ============================
 box::purge_cache()
 box::use(
@@ -55,7 +53,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",
@@ -120,9 +118,9 @@ server <- function(input, output, session) {
     if (AUTH_ENABLED) {
       reactiveValuesToList(res_auth)
       if (res_auth$admin) {
-        print("admin")
+        # print("admin")
       } else {
-        print("not_admin")
+        # print("not_admin")
         showing_buttons <- FALSE
       }
     }
@@ -178,7 +176,7 @@ server <- function(input, output, session) {
     } else {
 
       # list of rendered panels
-      validator_main(data_validation$init_val(mhcs()$get_schema("main")))
+      validator_main(data_validation$init_val(mhcs()$get_scheme("main")))
       validator_main()$enable()
       mhcs()$get_main_form_ui
     }
@@ -206,8 +204,8 @@ server <- function(input, output, session) {
     if (missing(ns)) ns <- NULL
 
     # transform df to list
-    loaded_df_for_id <- as.list(df)
+    # loaded_df_for_id <- as.list(df)
-    loaded_df_for_id <- df[input_ids]
+    # loaded_df_for_id <- df[input_ids]
 
     # rewrite input forms
     purrr::walk2(
@@ -220,7 +218,7 @@ server <- function(input, output, session) {
           form_id = x_id,
           form_type = x_type,
           value = df[[x_id]],
-          scheme = mhcs()$get_schema(table_name),
+          scheme = mhcs()$get_scheme(table_name),
           ns = ns
         )
       }
@@ -236,8 +234,8 @@ server <- function(input, output, session) {
   ) {
 
     nested_key_id <- mhcs()$get_key_id(table_name)
-    input_types <- unname(id_and_types_list)
+    input_types   <- unname(id_and_types_list)
-    input_ids   <- names(id_and_types_list)
+    input_ids     <- names(id_and_types_list)
 
     if (missing(ns)) ns <- NULL
 
@@ -282,7 +280,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 +292,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
     )
@@ -337,11 +335,11 @@ server <- function(input, output, session) {
   ## функция отображения вложенной формы для выбранной таблицы --------
   show_modal_for_nested_form <- function(con) {
 
-    ns <- NS(values$nested_form_id)
+    ns     <- NS(values$nested_form_id)
     key_id <- mhcs()$get_key_id(values$nested_form_id)
 
     # загрузка схемы для данной вложенной формы
-    this_nested_form_scheme <-  mhcs()$get_schema(values$nested_form_id)
+    this_nested_form_scheme <- mhcs()$get_scheme(values$nested_form_id)
 
     # мини-схема для ключа
     this_nested_form_key_scheme <- subset(this_nested_form_scheme, form_id == key_id)
@@ -362,8 +360,8 @@ server <- function(input, output, session) {
     }
 
     # nested ui
-    if (!is.null(values$nested_key)) {
+    nested_form_panels <- if (!is.null(values$nested_key)) {
-      yay_its_fun <- purrr::map(
+      purrr::map(
         .x = unique(this_nested_form_scheme$subgroup),
         .f = \(subgroup) {
 
@@ -383,9 +381,8 @@ server <- function(input, output, session) {
         }
       )
     } else {
-      yay_its_fun <- list(bslib::nav_panel("", "empty"))
+      list(bslib::nav_panel("", div("Нет доступных записей.", br(), "Необходимо создать новую запись.")))
     }
-    # yay_its_fun <- !!!yay_its_fun
 
     # ui для всплывающего окна 
     ui_for_inline_table <- navset_card_underline(
@@ -393,19 +390,18 @@ server <- function(input, output, session) {
         width = 300,
         selectizeInput(
           inputId = "nested_key_selector",
-          label = this_nested_form_key_scheme$form_label, 
+          label = strong(this_nested_form_key_scheme$form_label),
           choices = kyes_for_this_table,
           selected = values$nested_key,
           # options = list(placeholder = "действие комиссии", create = FALSE, onInitialize = I('function() { this.setValue(""); }'))
         ),
-        actionButton("add_new_nested_key_button", "add"),
+        actionButton("add_new_nested_key_button", "Добавить новую запись", icon("plus", lib = "font-awesome")),
-        actionButton("nested_form_save_button", "save"),
+        actionButton("nested_form_save_button", "Сохранить данные", icon("floppy-disk", lib = "font-awesome")),
-        actionButton("nested_form_dt_button", "dt"),
+        actionButton("nested_form_dt_button", "DT", icon("table", lib = "font-awesome")),
         uiOutput("validation_nested"),
         open = list(mobile = "always-above")
       ),
-      # if (!is.null(values$nested_key)) {rlang::syms(!!!yay_its_fun)} else bslib::nav_panel("empty")
+      !!!nested_form_panels
-      !!!yay_its_fun
     )
 
     # проверка данных для внутренних таблиц
@@ -433,15 +429,17 @@ server <- function(input, output, session) {
       con = con
     )
 
-    col_types <- mhcs()$get_schema(values$nested_form_id) |>
+    col_types <- mhcs()$get_scheme_with_values_forms(values$nested_form_id) |>
       dplyr::distinct(form_id, form_type, form_label)
 
-    date_cols <- subset(col_types, form_type == "date", form_id, drop = TRUE)
+    date_cols <- which(col_types$form_type == "date")
+    str_cols  <- which(col_types$form_type != "date")
 
     values$data <- values$data |>
       select(-mhcs()$get_main_key_id) |>
       mutate(
-        dplyr::across(tidyselect::all_of({{date_cols}}), as.Date)
+        dplyr::across(tidyselect::all_of({{date_cols}}), as.Date),
+        dplyr::across(tidyselect::all_of({{str_cols}}), as.character),
       ) |>
       arrange({{key_id}})
 
@@ -450,7 +448,7 @@ server <- function(input, output, session) {
         values$data,
         caption = 'Table 1: This is a simple caption for the table.',
         rownames = FALSE,
-        # colnames = dplyr::pull(col_types, form_id, form_label),
+        colnames = col_types |> dplyr::pull(form_id, form_label),
         extensions = c('KeyTable', "FixedColumns"),
         editable = 'cell',
         selection = "none",
@@ -461,7 +459,8 @@ server <- function(input, output, session) {
           keys = TRUE
         )
       ) |>
-        DT::formatDate(date_cols, "toLocaleDateString", params = list('ru-RU'))
+        DT::formatDate(date_cols, "toLocaleDateString", params = list('ru-RU')) |>
+        DT::formatString(str_cols)
     )
 
     showModal(modalDialog(
@@ -599,7 +598,7 @@ server <- function(input, output, session) {
     removeModal()
 
     # та самая форма для ключа
-    scheme_for_key_input <- mhcs()$get_schema(values$nested_form_id) |>
+    scheme_for_key_input <- mhcs()$get_scheme(values$nested_form_id) |>
       dplyr::filter(form_id == mhcs()$get_key_id(values$nested_form_id))
 
     ui1 <- rlang::exec(
@@ -650,12 +649,16 @@ server <- function(input, output, session) {
 
   # STATUSES ===============================
   # вывести отображение что что-то не так
-  output$status_message <- renderText({
+  output$status_message <- renderUI({
-    scheme()
+
     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({
@@ -675,7 +678,7 @@ server <- function(input, output, session) {
   observeEvent(input$add_new_main_key_button, {
 
     # данные для главного ключа
-    scheme_for_key_input <- mhcs()$get_schema("main") |>
+    scheme_for_key_input <- mhcs()$get_scheme("main") |>
       dplyr::filter(form_id == mhcs()$get_main_key_id)
 
     # создать форму для выбора ключа
@@ -806,8 +809,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
       )
@@ -861,10 +864,11 @@ server <- function(input, output, session) {
             tibble::as_tibble()
 
           # handle with data
-          scheme <- mhcs()$get_schema(x)
+          scheme <- mhcs()$get_scheme(x)
 
           date_columns   <- subset(scheme, form_type == "date", form_id, drop = TRUE)
           number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
+          other_cols     <- which(colnames(df) %in% c(date_columns, number_columns))
 
           df <- df |>
             dplyr::mutate(
@@ -872,12 +876,24 @@ server <- function(input, output, session) {
               dplyr::across(tidyselect::all_of({{date_columns}}), as.Date),
               # числа - к единому формату десятичных значений
               dplyr::across(tidyselect::all_of({{number_columns}}), ~ gsub("\\.", "," , .x)),
-            )
+              dplyr::across(tidyselect::all_of({{other_cols}}), as.character)
+            ) |>
+            # очистка от пустых ключей
+            dplyr::filter(!is.na(mhcs()$get_main_key_id))
 
           df
         }
       )
 
+      # добавить мета информацию
+      list_of_df[["meta"]] <- dplyr::tribble(
+        ~`Параметр`      , ~`Значение`,
+        "Пользователь"   , ifelse(AUTH_ENABLED, res_auth$user, "anonymous"),
+        "Название базы"  , names(enabled_schemas)[enabled_schemas == scheme()],
+        "id базы"        , scheme(),
+        "Время выгрузки" , format(Sys.time(), "%d.%m.%Y %H:%M:%S"),
+      )
+
       # set date params
       options("openxlsx2.dateFormat" = "dd.mm.yyyy")
 
@@ -911,10 +927,11 @@ server <- function(input, output, session) {
         "---",
         "\n"
       )
+      box::use(modules/data_manipulations[is_this_empty_value])
 
       # iterate by scheme parts
       purrr::walk(
-        .x = unique(mhcs()$get_schema("main")$part),
+        .x = unique(mhcs()$get_scheme("main")$part),
         .f = \(x_iter1) {
           # write level 1 header
           HEADER_1 <- paste("#", x_iter1, "\n")
@@ -922,14 +939,14 @@ server <- function(input, output, session) {
 
           # iterate by level2 headers (subgroups)
           purrr::walk(
-            .x = dplyr::pull(unique(subset(mhcs()$get_schema("main"), part == x_iter1, "subgroup"))),
+            .x = dplyr::pull(unique(subset(mhcs()$get_scheme("main"), part == x_iter1, "subgroup"))),
             .f = \(x_iter2) {
               # get header 2 name
               HEADER_2 <- paste("##", x_iter2, "\n")
 
               # for some reason set litle scheme...
               litle_scheme <- subset(
-                x = mhcs()$get_schema("main"),
+                x = mhcs()$get_scheme("main"),
                 subset = part == x_iter1 & subgroup == x_iter2,
                 select = c("form_id", "form_label", "form_type")
               ) |>
@@ -950,7 +967,7 @@ server <- function(input, output, session) {
                     if (length(docx_value) > 1) docx_value <- paste(docx_value, collapse = ", ")
 
                     # if non empty data - add string
-                    if (!check_for_empty_data(docx_value)) paste0("**", docx_label, "**: ", docx_value, "\n") else NA
+                    if (!is_this_empty_value(docx_value)) paste0("**", docx_label, "**: ", docx_value, "\n") else NA
                   } else if (docx_type == "description") {
                     # treat description label as citation text
                     paste0(">", docx_label, "\n")
@@ -1005,8 +1022,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,24 +1051,23 @@ 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) |>
+      scheme <- mhcs()$get_scheme_with_values_forms(table_name) 
-        filter(!form_type %in% c("description", "nested_forms"))
 
       # столбцы в таблицы и схема
       df_to_schema_compare <- setdiff(colnames(df), unique(scheme$form_id))
+      df_to_schema_compare <- df_to_schema_compare[df_to_schema_compare != main_key_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}' не соответсвуют схеме")
-        cli::cli_warn(c(message, paste("- ", schema_to_df_compare)))
         showNotification(message, type = "error")
+        cli::cli_warn(c(message, paste("- ", schema_to_df_compare)))
 
         return()
       }
@@ -1061,11 +1077,11 @@ 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) |>
+      scheme <- mhcs()$get_scheme_with_values_forms(table_name)
-        filter(!form_type %in% c("description", "nested_forms"))
 
-      date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)
+      date_columns   <- subset(scheme, form_type == "date", form_id, drop = TRUE)
       number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
+      other_cols     <- which(colnames(df) %in% c(date_columns, number_columns))
 
       # функция для преобразование числовых значений и сохранения "NA"
       num_converter <- function(old_col) {
@@ -1083,25 +1099,37 @@ server <- function(input, output, session) {
       df <- df |>
         dplyr::mutate(
           # даты - к единому формату
-          dplyr::across(tidyselect::all_of({{date_columns}}), \(x) purrr::map_chr(x, db$excel_to_db_dates_converter)),
+          dplyr::across(tidyselect::all_of({{date_columns}}),   \(x) purrr::map_chr(x, db$excel_to_db_dates_converter)),
           dplyr::across(tidyselect::all_of({{number_columns}}), num_converter),
+          dplyr::across(tidyselect::all_of({{other_cols}}),     as.character)
         ) |>
         select(all_of(unique(c(main_key_id, scheme$form_id))))
 
       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(
+        DBI::dbRemoveTable(con, table_name)
-        .x = unique(df[[main_key_id]]),
-        .f = \(main_key) {
 
-          if (main_key %in% unique(df_original[[main_key_id]])) {
+      } else {
-            DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE {main_key_id} = '{main_key}'"))
+
+        # удаление данных в базе данных по ключам
+        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}'"))
+            }
           }
-        }
+        )
-      )
+     
+      }
+
+      # очистка от пустых ключей
+      df <- df |>
+        dplyr::filter(!is.na({{main_key_id}}))
 
       DBI::dbWriteTable(
         con,
@@ -1110,7 +1138,7 @@ server <- function(input, output, session) {
         append = TRUE
       )
 
-      message <- glue::glue("Данные таблицы '{table_name}' успешно обновлены")
+      message <- glue::glue("Данные таблицы '{table_name}' успешно обновлены (добавлено {nrow(df)} записей)")
       showNotification(
         message,
         type = "message"
@@ -1226,4 +1254,4 @@ server <- function(input, output, session) {
 
 app <- shinyApp(ui = ui, server = server)
 
-  runApp(app, launch.browser = TRUE)
+runApp(app, launch.browser = TRUE)

helpers/functions.R

@@ -1,27 +0,0 @@
-
-
-#' @description Function check if variable contains some sort of empty data
-#' (NULL, NA, "", other 0-length data) and return `TRUE` (`FALSE` if data is
-#' not 'empty').
-#'
-#' Needed for proper data validation.
-#' (ДУБЛИРУЕТ МОДУЛЬ `data_manipulation`)
-check_for_empty_data <- function(value_to_check) {
-
-  # for any 0-length
-  if (length(value_to_check) == 0) return(TRUE)
-
-  # for NA
-  if (is.logical(value_to_check) && is.na(value_to_check)) return(TRUE)
-
-  # for NULL
-  if (is.null(value_to_check)) return(TRUE)
-
-  # for non-empty Date (RETURN FALSE)
-  if (inherits(value_to_check, "Date") && length(value_to_check) != 0) return(FALSE)
-
-  # for empty strings (stands before checking non-empty data for avoid mistakes)
-  if (value_to_check == "") return(TRUE)
-
-  FALSE
-}

modules/data_manipulations.R

@@ -4,7 +4,8 @@
 #' not 'empty').
 #'
 #' Needed for proper data validation.
-check_for_empty_data = function(value_to_check) {
+#' @export
+is_this_empty_value = function(value_to_check) {
 
   # for any 0-length
   if (length(value_to_check) == 0) return(TRUE)
@@ -19,7 +20,14 @@ check_for_empty_data = function(value_to_check) {
   if (inherits(value_to_check, "Date") && length(value_to_check) != 0) return(FALSE)
 
   # for empty strings (stands before checking non-empty data for avoid mistakes)
-  if (value_to_check == "") return(TRUE)
+  if (is.character(value_to_check)) {
+    if (is.na(value_to_check)) return(TRUE)
+    if (value_to_check == "")   return(TRUE)
+  }
 
-  FALSE
+  if (is.double(value_to_check)) {
+    if (is.na(value_to_check)) return(TRUE)
+  }
+
+  return(FALSE)
 }

modules/data_validation.R

@@ -3,7 +3,7 @@
 init_val = function(scheme, ns) {
 
   options(box.path = here::here())
-  box::use(modules/data_manipulations[check_for_empty_data])
+  box::use(modules/data_manipulations[is_this_empty_value])
 
   iv <- shinyvalidate::InputValidator$new()
 
@@ -15,7 +15,7 @@ init_val = function(scheme, ns) {
 
   # формируем список id - тип
   inputs_simple_list <- scheme |>
-    dplyr::filter(!form_type %in% c("nested_forms","description", "description_header")) |>
+    dplyr::filter(!form_type %in% c("nested_forms", "description", "description_header")) |>
     dplyr::distinct(form_id, form_type) |>
     tibble::deframe()
 
@@ -39,7 +39,7 @@ init_val = function(scheme, ns) {
 
         iv$add_rule(x_input_id, function(x) {
           # exit if empty
-          if (check_for_empty_data(x)) {
+          if (is_this_empty_value(x)) {
             return(NULL)
           }
           # хак для пропуска значений
@@ -64,7 +64,7 @@ init_val = function(scheme, ns) {
               function(x) {
 
                 # exit if empty
-                if (check_for_empty_data(x)) {
+                if (is_this_empty_value(x)) {
                   return(NULL)
                 }
 
@@ -85,11 +85,11 @@ init_val = function(scheme, ns) {
         }
       }
 
-      if (form_type %in% c("select_multiple", "select_one")) {
+      if (form_type %in% c("select_multiple", "select_one", "radio", "checkbox")) {
         iv$add_rule(x_input_id, function(x) {
 
           if (length(x) == 1) {
-            if (check_for_empty_data(x)) return(NULL)
+            if (is_this_empty_value(x)) return(NULL)
           }
 
           # проверка на соответствие вариантов схеме ---------

modules/db.R

@@ -39,7 +39,7 @@ check_if_table_is_exist_and_init_if_not = function(
 
       if (table_name %in% DBI::dbListTables(con)) {
 
-        cli::cli_inform(c("*" = "таблица есть такая: '{table_name}'"))
+        cli::cli_inform(c("*" = "проверка таблицы в базе данных: '{table_name}'"))
 
         # если таблица существует, производим проверку структуры таблицы
         compare_existing_table_with_schema(
@@ -185,12 +185,13 @@ write_df_to_db = function(
   con
 ) {
 
-  scheme         <- schm$get_schema(table_name)
+  scheme         <- schm$get_scheme(table_name)
   main_key_id    <- schm$get_main_key_id
   nested_key_id  <- schm$get_key_id(table_name)
 
   date_columns   <- subset(scheme, form_type == "date", form_id, drop = TRUE)
   number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
+  other_cols     <- which(colnames(df) %in% c(date_columns, number_columns))
 
   df <- df |>
     dplyr::mutate(
@@ -198,7 +199,11 @@ write_df_to_db = function(
       dplyr::across(tidyselect::all_of({{date_columns}}), \(x) purrr::map_chr(x, excel_to_db_dates_converter)),
       # числа - к единому формату десятичных значений
       dplyr::across(tidyselect::all_of({{number_columns}}), ~ gsub("\\.", "," , .x)),
+      dplyr::across(tidyselect::all_of({{other_cols}}), as.character),
     )
+  
+  df |>
+    dplyr::glimpse()
 
   if (table_name == "main") {
     del_query <- glue::glue("DELETE FROM main WHERE {main_key_id} = '{main_key_value}'")

modules/global_options.R

@@ -5,7 +5,7 @@ set_global_options = function(
   APP.DEBUG = FALSE,
   # APP.FILE_DB = fs::path("data.sqlite"),
   shiny.host = "127.0.0.1",
-  shiny.port = 1337,
+  shiny.port = 1338,
   ...
 ) {
   options(
@@ -29,6 +29,11 @@ check_and_init_scheme = function() {
 
   cli::cli_inform(c("*" = "проверка схемы..."))
 
+  files_to_watch <- c(
+    "modules/scheme_generator.R",
+    "modules/utils.R"
+  )
+
   scheme_names <- enabled_schemas
   scheme_file <- paste0("configs/schemas/", scheme_names, ".xlsx")
   scheme_file <- stats::setNames(scheme_file, scheme_names)
@@ -40,7 +45,7 @@ check_and_init_scheme = function() {
   hash_file   <- "temp/schema_hash.rds"
 
   # 
-  exist_hash <- tools::md5sum(scheme_file)
+  exist_hash <- tools::md5sum(c(scheme_file, files_to_watch))
 
   # если первый запуск (нет файла с кешем) инициализация схемы
   if (!file.exists(hash_file) | !file.exists("scheme.rds") | !all(file.exists(db_files))) {
@@ -55,8 +60,9 @@ check_and_init_scheme = function() {
     # если данные были изменены проводим реинициализацию таблицы и схемы
     if (!all(exist_hash == saved_hash)) {
 
-      cli::cli_inform(c(">" = "Данные схемы были изменены..."))
+      cli::cli_inform(c(">" = "Данные схем были изменены..."))
       init_scheme(scheme_file)
+
     } else {
       cli::cli_alert_success("изменений нет")
     }

modules/scheme_generator.R

@@ -1,14 +1,14 @@
 
 #' @export
 scheme_R6 <- R6::R6Class(
-  "schemes_f",
+  "schemes_generator",
   public = list(
 
     initialize = function(scheme_file_path = NULL) {
 
       private$scheme_file_path <- scheme_file_path
 
-      # make list of schemas
+      # make list of schemes
       private$schemes_list <- list()
       private$schemes_list[["main"]] <- private$load_scheme_from_xlsx("main")
 
@@ -18,6 +18,10 @@ scheme_R6 <- R6::R6Class(
         dplyr::distinct(form_id) |>
         dplyr::pull(form_id)
 
+      # проверка на не пересечение с зарезервированными именами
+      check <- private$reserved_table_names %in% private$nested_forms_names
+      if (any(check)) cli::cli_abort(c("нельзя использовать данные имена вложенных таблиц:", paste("- ", private$reserved_table_names[check])))
+
       purrr::walk(
         .x = purrr::set_names(private$nested_forms_names),
         .f = \(nested_form_id) {
@@ -36,7 +40,7 @@ scheme_R6 <- R6::R6Class(
       private$main_key_id <- self$get_key_id("main")
 
       box::use(modules/utils)
-      private$testest <- bslib::navset_card_underline(
+      private$bslib_rendered_ui <- bslib::navset_card_underline(
         id = "main",
         !!!utils$make_list_of_pages(private$schemes_list[["main"]], private$main_key_id),
         header = NULL,
@@ -47,7 +51,7 @@ scheme_R6 <- R6::R6Class(
     get_all_ids = function(table_name) {
 
       private$schemes_list[[table_name]] |>
-        dplyr::filter(!form_type %in% private$exluded_types) |>
+        dplyr::filter(!form_type %in% private$excluded_types) |>
         dplyr::distinct(form_id) |>
         dplyr::pull(form_id)
 
@@ -65,32 +69,24 @@ scheme_R6 <- R6::R6Class(
 
     },
 
-    extract_forms_id_and_types_from_scheme2 = function(scheme) {
+    # возврат схемы ------------------------------------
-
+    ## полностью -------
-      form_id_and_types_list <- scheme |>
+    get_scheme = function(table_name) {
-        dplyr::filter(!form_type %in% private$exluded_types) |>
-        dplyr::distinct(form_id, form_type) |>
-        tibble::deframe()
-
-      list(
-        key = form_id_and_types_list[1],
-        form = form_id_and_types_list[-1]
-      )
-    },
-
-    # get_key_id = function(table_name) {
-    #   self$extract_forms_id_and_types_from_scheme2(private$schemes_list[[table_name]])
-    # },
-    get_schema = function(table_name) {
       private$schemes_list[[table_name]]
     },
+    ## с полями имеющие значение -------
+    get_scheme_with_values_forms = function(table_name) {
+      private$schemes_list[[table_name]] |>
+        dplyr::filter(!form_type %in% private$excluded_types)
+    },
+
     get_id_type_list = function(table_name) {
 
       # wo main key
       this_key_id <- self$get_key_id(table_name)
 
       private$schemes_list[[table_name]] |>
-        dplyr::filter(!form_type %in% private$exluded_types) |>
+        dplyr::filter(!form_type %in% private$excluded_types) |>
         dplyr::filter(form_id != {{this_key_id}}) |>
         dplyr::distinct(form_id, form_type) |>
         tibble::deframe()
@@ -107,7 +103,7 @@ scheme_R6 <- R6::R6Class(
       private$nested_forms_names
     },
     get_main_form_ui = function() {
-      private$testest
+      private$bslib_rendered_ui
     }
   ),
   private = list(
@@ -115,8 +111,9 @@ scheme_R6 <- R6::R6Class(
     schemes_list = NULL,
     main_key_id = NA,
     nested_forms_names = NA,
-    testest = NA,
+    bslib_rendered_ui = NA,
-    exluded_types = c("inline_table", "nested_forms","description", "description_header"),
+    excluded_types = c("nested_forms", "description", "description_header"),
+    reserved_table_names = c("meta", "log", "main"),
 
     load_scheme_from_xlsx = function(sheet_name) {
 
@@ -140,8 +137,15 @@ scheme_R6 <- R6::R6Class(
         dplyr::pull(form_id)
       
       if (length(duplicate_ids) > 0) {
-        cli::cli_abort(c("В схеме для формы '{sheet_name}' содержатся повторяющиеся id:", paste("-", duplicate_ids)))
+        cli::cli_abort(c("В схеме '{private$scheme_file_path}' для формы '{sheet_name}' содержатся повторяющиеся id:", paste("-", duplicate_ids)))
       }
+
+      # проверка на корректные id
+      input_names_with_dash <- unique(table$form_id)[grepl("-", unique(table$form_id))]
+      if (length(input_names_with_dash) > 0) {
+        cli::cli_abort(c("В схеме '{private$scheme_file_path}' в id форм содержатся `-`, может привести к некорректной последующей работой с базой данных", paste("-", input_names_with_dash)))
+      }
+
       table
     }
   )
@@ -152,7 +156,7 @@ scheme_R6 <- R6::R6Class(
 # schm$get_forms_ids("main")
 # schm$get_all_ids("main")
 
-# schm$get_schema("main")
+# schm$get_scheme("main")
 
 # schm$get_id_type_list("allergo_anamnesis")
 

modules/utils.R

@@ -1,6 +1,6 @@
 #' @export
 make_list_of_pages = function(main_schema, main_key_id) {
-  cli::cli_alert_success("AAAA")
+
   purrr::map(
     .x = unique(main_schema$part),
     .f = \(page_name) {
@@ -263,6 +263,15 @@ update_forms_with_data = function(
   local_delimeter = getOption("SYMBOL_DELIM"),
   ns
 ) {
+  
+  options(box.path = here::here())
+  box::use(modules/data_manipulations[is_this_empty_value])
+
+  # print("-----------------")
+  # cli::cli_inform("form_id: {form_id} | form_type: {form_type}")
+  # print(value)
+  # print(typeof(value))
+  # print(is_this_empty_value(value))
 
   filterd_line <- scheme |>
     dplyr::filter(form_id == {{form_id}})
@@ -294,50 +303,58 @@ update_forms_with_data = function(
     new_choices <- unique(c(old_choices, value))
     new_choices <- new_choices[!is.na(new_choices)]
 
-
     shiny::updateSelectizeInput(inputId = form_id, selected = value, choices = new_choices)
-    # shiny::updateSelectizeInput(inputId = form_id, selected = value)
   }
 
   # select_multiple
   # check if value is not NA and split by delimetr
-  if (form_type == "select_multiple" && !is.na(value)) {
+  if (form_type == "select_multiple") {
-    vars <- stringr::str_split_1(value, local_delimeter)
+    if (is_this_empty_value(value)) {
+      shiny::updateSelectizeInput(inputId = form_id, selected = as.character(0))
+    } else {
+      vars <- stringr::str_split_1(value, local_delimeter)
 
-    # update choices
+      # update choices
-    old_choices <- filterd_line$choices
+      old_choices <- filterd_line$choices
-    new_choices <- unique(c(old_choices, vars))
+      new_choices <- unique(c(old_choices, vars))
-    new_choices <- new_choices[!is.na(new_choices)]
+      new_choices <- new_choices[!is.na(new_choices)]
-
+      shiny::updateSelectizeInput(inputId = form_id, selected = vars, choices = new_choices)
-    shiny::updateSelectizeInput(inputId = form_id, selected = vars, choices = new_choices)
+    }
-    # shiny::updateSelectizeInput(inputId = form_id, selected = vars)
-  }
-
-  # in other case fill with `character(0)` to proper reseting form
-  if (form_type == "select_multiple" && is.na(value)) {
-    shiny::updateSelectizeInput(inputId = form_id, selected = character(0))
   }
 
   # radio buttons
-  if (form_type == "radio" && !is.na(value)) {
+  if (form_type == "radio") {
-    shiny::updateRadioButtons(inputId = form_id, selected = value)
+    if (is_this_empty_value(value)) {
-  }
+      shiny::updateRadioButtons(inputId = form_id, selected = character(0))
-  if (form_type == "radio" && is.na(value)) {
+    } else {
-    shiny::updateRadioButtons(inputId = form_id, selected = character(0))
+      # update choices
+      old_choices <- filterd_line$choices
+      new_choices <- unique(c(old_choices, value))
+      new_choices <- new_choices[!is.na(new_choices)]
+
+      shiny::updateRadioButtons(inputId = form_id, selected = value, choices = new_choices)
+    }
   }
 
   # checkboxes
-  if (form_type == "checkbox" && !is.na(value)) {
+  if (form_type == "checkbox") {
-    vars <- stringr::str_split_1(value, local_delimeter)
+
-    shiny::updateCheckboxGroupInput(inputId = form_id, selected = vars)
+    if (is_this_empty_value(value)) {
-  }
+      shiny::updateCheckboxGroupInput(inputId = form_id, selected = character(0))
-  if (form_type == "checkbox" && is.na(value)) {
+    } else {
-    shiny::updateCheckboxGroupInput(inputId = form_id, selected = character(0))
+
+      vars <- stringr::str_split_1(value, local_delimeter)
+  
+      # update choices
+      old_choices <- filterd_line$choices
+      new_choices <- unique(c(old_choices, vars))
+      new_choices <- new_choices[!is.na(new_choices)]
+  
+      shiny::updateCheckboxGroupInput(inputId = form_id, selected = vars, choices = new_choices)
+    }
+
   }
 
-  # if (type == "inline_table") {
-  #   message("EMPTY")
-  # }
 }
 
 #' @export
@@ -361,7 +378,7 @@ clean_forms = function(
         form_id   = x_id,
         form_type = x_type,
         value     = get_empty_data(x_type),
-        scheme = schm$get_schema(table_name),
+        scheme = schm$get_scheme(table_name),
         ns = ns
       )
     }

utils/init_login_db.r

@@ -3,7 +3,7 @@
 # SETUP AUTH =============================
 # Init DB using credentials data
 credentials <- data.frame(
-  user = c("admin", "user"),
+  user     = c("admin", "user"),
   password = c("admin", "user"),
   # password will automatically be hashed
   admin = c(TRUE, FALSE),