From 1b7220e6472178b271e3c3731bf0736db943f74a Mon Sep 17 00:00:00 2001 From: madeliri Date: Mon, 13 Apr 2026 12:43:47 +0300 Subject: [PATCH] =?UTF-8?q?feat:=20=D1=80=D0=B0=D0=B1=D0=BE=D1=82=D0=B0=20?= =?UTF-8?q?=D1=81=20=D0=BD=D0=B5=D1=81=D0=BA=D0=BE=D0=BB=D1=8C=D0=BA=D0=B8?= =?UTF-8?q?=D0=BC=D0=B8=20=D1=81=D1=85=D0=B5=D0=BC=D0=B0=D0=BC=D0=B8=20?= =?UTF-8?q?=D0=B2=20=D0=BF=D1=80=D0=B5=D0=B4=D0=B5=D0=BB=D0=B0=D1=85=20?= =?UTF-8?q?=D0=BE=D0=B4=D0=BD=D0=BE=D0=B3=D0=BE=20=D0=BF=D1=80=D0=B8=D0=BB?= =?UTF-8?q?=D0=BE=D0=B6=D0=B5=D0=BD=D0=B8=D1=8F?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .gitignore | 1 + app.R | 211 ++++++++++++++++++++----------------- modules/db.R | 4 +- modules/global_options.R | 57 +++++++--- modules/scheme_generator.R | 14 ++- renv.lock | 6 +- 6 files changed, 177 insertions(+), 116 deletions(-) diff --git a/.gitignore b/.gitignore index 7c9890a..5f8975e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ /renv +/temp .Renviron .DS_Store diff --git a/app.R b/app.R index e3b4a52..a191f37 100644 --- a/app.R +++ b/app.R @@ -22,9 +22,9 @@ box::use( ) # SETTINGS ================================ -FILE_SCHEME <- fs::path("configs/schemas", "schema.xlsx") +FILE_SCHEME <- fs::path("configs/schemas", "schema.xlsx") AUTH_ENABLED <- Sys.getenv("FORM_AUTH_ENABLED", FALSE) -HEADER_TEXT <- sprintf("%s (%s)", Sys.getenv("FORM_TITLE", "NA"), Sys.getenv("FORM_VERSION", "NA")) +HEADER_TEXT <- sprintf("%s (%s)", Sys.getenv("FORM_TITLE", "NA"), Sys.getenv("FORM_VERSION", "NA")) global_options$set_global_options( shiny.host = "0.0.0.0" @@ -39,19 +39,7 @@ rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/") if (!rmarkdown::pandoc_available()) warning("Can't find pandoc!") # SCHEME_MAIN UNPACK ========================== -schm <- readRDS("scheme.rds") - -# two_obj <- purrr::map( -# c(one = "configs/schemas/schema.xlsx", two = "configs/schemas/schema_example.xlsx"), -# scheme_R6$new -# ) -# two_obj[["a"]]$get_schema("main") -# object.size(two_obj) -# saveRDS(schm, "test.rds") -# readRDS("test.rds") - -# check tables - +schms <- readRDS("scheme.rds") # UI ======================= ui <- page_sidebar( @@ -78,7 +66,7 @@ ui <- page_sidebar( # init auth ======================= if (AUTH_ENABLED) { - # shinymanager::set_labels("en", "Please authenticate" = "aboba") + # shinymanager::set_labels("en", "Please authenticate" = "scheme()") ui <- ui |> shinymanager::secure_app( status = "primary", @@ -153,6 +141,10 @@ server <- function(input, output, session) { nested_key = NULL, nested_form_id = NULL ) + scheme <- reactiveVal("schema_example") # наименование выбранной схемы + mhcs <- reactiveVal(schms[["schema_example"]]) # объект для выбранной схемы + observers_started <- reactiveVal(NULL) + main_form_is_empty <- reactiveVal(TRUE) validator_main <- reactiveVal(NULL) validator_nested <- reactiveVal(NULL) @@ -162,16 +154,31 @@ server <- function(input, output, session) { if (main_form_is_empty()) { validator_main(NULL) - "Для начала работы нужно создать новую запись или загрузить существующую!" + + div( + "Для начала работы нужно создать новую запись или загрузить существующую!", + paste(getOption("enabled_schemas"), collapse = ", "), + shiny::radioButtons( + "schmes_selector", + label = "Выбрать базу данных для работы", + choices = getOption("enabled_schemas"), + selected = scheme() + ) + ) } else { # list of rendered panels - validator_main(data_validation$init_val(schm$get_schema("main"))) + validator_main(data_validation$init_val(mhcs()$get_schema("main"))) validator_main()$enable() - schm$get_main_form_ui + mhcs()$get_main_form_ui } }) + observeEvent(input$schmes_selector, { + scheme(input$schmes_selector) + mhcs(schms[[input$schmes_selector]]) + }) + # ========================================== # ОБЩИЕ ФУНКЦИИ ============================ # ========================================== @@ -184,8 +191,8 @@ server <- function(input, output, session) { ns ) { - input_types <- unname(schm$get_id_type_list(table_name)) - input_ids <- names(schm$get_id_type_list(table_name)) + input_types <- unname(mhcs()$get_id_type_list(table_name)) + input_ids <- names(mhcs()$get_id_type_list(table_name)) if (missing(ns)) ns <- NULL # transform df to list @@ -203,7 +210,7 @@ server <- function(input, output, session) { form_id = x_id, form_type = x_type, value = df[[x_id]], - scheme = schm$get_schema(table_name), + scheme = mhcs()$get_schema(table_name), ns = ns ) } @@ -218,7 +225,7 @@ server <- function(input, output, session) { con ) { - nested_key_id <- schm$get_key_id(table_name) + nested_key_id <- mhcs()$get_key_id(table_name) input_types <- unname(id_and_types_list) input_ids <- names(id_and_types_list) @@ -255,7 +262,7 @@ server <- function(input, output, session) { if (table_name == "main") { exported_df <- exported_df |> mutate( - !!dplyr::sym(schm$get_main_key_id) := values$main_key, + !!dplyr::sym(mhcs()$get_main_key_id) := values$main_key, .before = 1 ) } @@ -264,7 +271,7 @@ server <- function(input, output, session) { if (table_name != "main") { exported_df <- exported_df |> mutate( - !!dplyr::sym(schm$get_main_key_id) := values$main_key, + !!dplyr::sym(mhcs()$get_main_key_id) := values$main_key, !!dplyr::sym(nested_key_id) := values$nested_key, .before = 1 ) @@ -276,7 +283,7 @@ server <- function(input, output, session) { db$write_df_to_db( df = exported_df, table_name = table_name, - schm = schm, + schm = mhcs(), main_key_value = values$main_key, nested_key_value = values$nested_key, con = con @@ -287,39 +294,51 @@ server <- function(input, output, session) { # NESTED FORMS ======================= # ==================================== ## кнопки для каждой вложенной таблицы ------------------------------- - purrr::walk( - .x = schm$nested_tables_names, - .f = \(nested_form_id) { + observe({ - observeEvent(input[[nested_form_id]], { - req(values$main_key) + # проверка инициализированы ли для этой схемы наблюдатели для кнопок вложенных таблиц + is_observer_is_started <- (isolate(scheme()) %in% isolate(observers_started())) - con <- db$make_db_connection("nested_tables") - on.exit(db$close_db_connection(con, "nested_tables"), add = TRUE) + if (is_observer_is_started) return() + purrr::walk( + .x = mhcs()$nested_tables_names, + .f = \(nested_form_id) { + + observeEvent(input[[nested_form_id]], { + req(values$main_key) + + con <- db$make_db_connection(scheme(),"nested_tables") + on.exit(db$close_db_connection(con, "nested_tables"), add = TRUE) + + values$nested_form_id <- nested_form_id + values$nested_key <- NULL # для нормальной работы реактивных значений + show_modal_for_nested_form(con) + + }) + } + ) - values$nested_form_id <- nested_form_id - values$nested_key <- NULL # для нормальной работы реактивных значений - show_modal_for_nested_form(con) - - }) - } - ) + # добавить идентификатор текущей схемы в список иницииализированных валидаторов + observers_started(c( + isolate(observers_started()), isolate(scheme()) + )) + }) ## функция отображения вложенной формы для выбранной таблицы -------- show_modal_for_nested_form <- function(con) { ns <- NS(values$nested_form_id) - key_id <- schm$get_key_id(values$nested_form_id) + key_id <- mhcs()$get_key_id(values$nested_form_id) # загрузка схемы для данной вложенной формы - this_nested_form_scheme <- schm$get_schema(values$nested_form_id) + this_nested_form_scheme <- mhcs()$get_schema(values$nested_form_id) # мини-схема для ключа this_nested_form_key_scheme <- subset(this_nested_form_scheme, form_id == key_id) if (nrow(this_nested_form_key_scheme) > 1) cli::cli_abort("количество строк не может быть больше одного для ключа") # выбираем все ключи из баз данных - kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, schm, values$main_key, con) + kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, mhcs(), values$main_key, con) kyes_for_this_table <- unique(c(values$nested_key, kyes_for_this_table)) kyes_for_this_table <- sort(kyes_for_this_table) values$nested_key <- if (length(kyes_for_this_table) == 0) NULL else kyes_for_this_table[[1]] @@ -394,23 +413,23 @@ server <- function(input, output, session) { ### функция для отображения DT-таблицы для выбранной вложенной формы -------- show_modal_for_nested_form_dt <- function(con) { - key_id <- schm$get_key_id(values$nested_form_id) + key_id <- mhcs()$get_key_id(values$nested_form_id) # получение дата-фрейма values$data <- db$read_df_from_db_by_id( table_name = values$nested_form_id, - schm, + mhcs(), main_key_value = values$main_key, con = con ) - col_types <- schm$get_schema(values$nested_form_id) |> + col_types <- mhcs()$get_schema(values$nested_form_id) |> dplyr::distinct(form_id, form_type, form_label) date_cols <- subset(col_types, form_type == "date", form_id, drop = TRUE) values$data <- values$data |> - select(-schm$get_main_key_id) |> + select(-mhcs()$get_main_key_id) |> mutate( dplyr::across(tidyselect::all_of({{date_cols}}), as.Date) ) |> @@ -453,7 +472,7 @@ server <- function(input, output, session) { ### кнопка: отображение DT ----------------------------- observeEvent(input$nested_form_dt_button, { - con <- db$make_db_connection("nested_form_save_button") + con <- db$make_db_connection(scheme(),"nested_form_save_button") on.exit(db$close_db_connection(con, "nested_form_save_button"), add = TRUE) removeModal() @@ -463,17 +482,17 @@ server <- function(input, output, session) { ### кнопка: сохранить изменения DT -------------------- observeEvent(input$nested_form_dt_save, { - con <- db$make_db_connection("nested_form_dt_save") + con <- db$make_db_connection(scheme(),"nested_form_dt_save") on.exit(db$close_db_connection(con, "nested_form_dt_save"), add = TRUE) export_df <- values$data |> dplyr::distinct() |> - dplyr::mutate(!!dplyr::sym(schm$get_main_key_id) := values$main_key, .before = 1) + dplyr::mutate(!!dplyr::sym(mhcs()$get_main_key_id) := values$main_key, .before = 1) db$write_df_to_db( df = export_df, table_name = values$nested_form_id, - schm, + mhcs(), main_key_value = values$main_key, nested_key_value = NULL, con = con @@ -487,20 +506,20 @@ server <- function(input, output, session) { observeEvent(input$nested_form_save_button, { req(values$nested_form_id) - con <- db$make_db_connection("nested_form_save_button") + con <- db$make_db_connection(scheme(),"nested_form_save_button") on.exit(db$close_db_connection(con, "nested_form_save_button"), add = TRUE) # сохраняем данные основной формы!!! save_inputs_to_db( table_name = "main", - id_and_types_list = schm$get_id_type_list("main"), + id_and_types_list = mhcs()$get_id_type_list("main"), con = con ) # сохраняем данные текущей вложенной таблицы save_inputs_to_db( table_name = values$nested_form_id, - id_and_types_list = schm$get_id_type_list(values$nested_form_id), + id_and_types_list = mhcs()$get_id_type_list(values$nested_form_id), ns = NS(values$nested_form_id), con = con ) @@ -536,17 +555,17 @@ server <- function(input, output, session) { observeEvent(values$nested_key, { - con <- db$make_db_connection("nested_tables") + con <- db$make_db_connection(scheme(),"nested_tables") on.exit(db$close_db_connection(con, "nested_tables"), add = TRUE) - kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, schm, values$main_key, con) + kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, mhcs(), values$main_key, con) if (values$nested_key %in% kyes_for_this_table) { # выгрузка датафрейма по общим и вложенным ключам df <- db$read_df_from_db_by_id( table_name = values$nested_form_id, - schm, + mhcs(), main_key_value = values$main_key, nested_key_value = values$nested_key, con = con @@ -556,7 +575,7 @@ server <- function(input, output, session) { load_data_to_form( df = df, table_name = values$nested_form_id, - schm, + mhcs(), ns = NS(values$nested_form_id) ) } @@ -568,8 +587,8 @@ server <- function(input, output, session) { removeModal() # та самая форма для ключа - scheme_for_key_input <- schm$get_schema(values$nested_form_id) |> - dplyr::filter(form_id == schm$get_key_id(values$nested_form_id)) + scheme_for_key_input <- mhcs()$get_schema(values$nested_form_id) |> + dplyr::filter(form_id == mhcs()$get_key_id(values$nested_form_id)) ui1 <- rlang::exec( .fn = utils$render_forms, @@ -590,19 +609,19 @@ server <- function(input, output, session) { # действие при подтверждении создания новой записи observeEvent(input$confirm_create_new_nested_key, { - req(input[[schm$get_key_id(values$nested_form_id)]]) + req(input[[mhcs()$get_key_id(values$nested_form_id)]]) - con <- db$make_db_connection("confirm_create_new_key") + con <- db$make_db_connection(scheme(),"confirm_create_new_key") on.exit(db$close_db_connection(con, "confirm_create_new_key"), add = TRUE) existed_key <- db$get_nested_keys_from_table( table_name = values$nested_form_id, - schm, + mhcs(), main_key_value = values$main_key, con ) - if (input[[schm$get_key_id(values$nested_form_id)]] %in% existed_key) { + if (input[[mhcs()$get_key_id(values$nested_form_id)]] %in% existed_key) { showNotification( sprintf("В базе уже запись с данным ключем."), type = "error" @@ -610,8 +629,8 @@ server <- function(input, output, session) { return() } - values$nested_key <- input[[schm$get_key_id(values$nested_form_id)]] - utils$clean_forms(values$nested_form_id, schm, NS(values$nested_form_id)) + values$nested_key <- input[[mhcs()$get_key_id(values$nested_form_id)]] + utils$clean_forms(values$nested_form_id, mhcs(), NS(values$nested_form_id)) removeModal() show_modal_for_nested_form(con) @@ -643,8 +662,8 @@ server <- function(input, output, session) { observeEvent(input$add_new_main_key_button, { # данные для главного ключа - scheme_for_key_input <- schm$get_schema("main") |> - dplyr::filter(form_id == schm$get_main_key_id) + scheme_for_key_input <- mhcs()$get_schema("main") |> + dplyr::filter(form_id == mhcs()$get_main_key_id) # создать форму для выбора ключа ui1 <- rlang::exec( @@ -667,14 +686,14 @@ server <- function(input, output, session) { ## действие при подтверждении (проверка нового создаваемого ключа) ------- observeEvent(input$confirm_create_new_main_key, { - req(input[[schm$get_main_key_id]]) + req(input[[mhcs()$get_main_key_id]]) - con <- db$make_db_connection("confirm_create_new_main_key") + con <- db$make_db_connection(scheme(),"confirm_create_new_main_key") on.exit(db$close_db_connection(con, "confirm_create_new_key"), add = TRUE) - new_main_key <- trimws(input[[schm$get_main_key_id]]) + new_main_key <- trimws(input[[mhcs()$get_main_key_id]]) - existed_key <- db$get_keys_from_table("main", schm, con) + existed_key <- db$get_keys_from_table("main", mhcs(), con) # если введенный ключ уже есть в базе if (new_main_key %in% existed_key) { @@ -688,7 +707,7 @@ server <- function(input, output, session) { values$main_key <- new_main_key main_form_is_empty(FALSE) log_action_to_db("creating new key", values$main_key, con) - utils$clean_forms("main", schm) + utils$clean_forms("main", mhcs()) removeModal() }) @@ -712,7 +731,7 @@ server <- function(input, output, session) { # rewrite all inputs with empty data values$main_key <- NULL - utils$clean_forms("main", schm) + utils$clean_forms("main", mhcs()) main_form_is_empty(TRUE) removeModal() @@ -723,12 +742,12 @@ server <- function(input, output, session) { observeEvent(input$save_data_button, { req(values$main_key) - con <- db$make_db_connection("save_data_button") + con <- db$make_db_connection(scheme(),"save_data_button") on.exit(db$close_db_connection(con, "save_data_button"), add = TRUE) save_inputs_to_db( table_name = "main", - id_and_types_list = schm$get_id_type_list("main"), + id_and_types_list = mhcs()$get_id_type_list("main"), con = con ) @@ -742,13 +761,13 @@ server <- function(input, output, session) { ## список ключей для загрузки данных ------------------- observeEvent(input$load_data_button, { - con <- db$make_db_connection("load_data_button") + con <- db$make_db_connection(scheme(),"load_data_button") on.exit(db$close_db_connection(con, "load_data_button")) if (length(dbListTables(con)) != 0 && "main" %in% DBI::dbListTables(con)) { # GET DATA files - ids <- db$get_keys_from_table("main", schm, con) + ids <- db$get_keys_from_table("main", mhcs(), con) ui_load_menu <- renderUI({ selectizeInput( @@ -786,12 +805,12 @@ server <- function(input, output, session) { observeEvent(input$load_data, { req(input$load_data_key_selector) - con <- db$make_db_connection("load_data") + con <- db$make_db_connection(scheme(),"load_data") on.exit(db$close_db_connection(con, "load_data"), add = TRUE) df <- db$read_df_from_db_by_id( table_name = "main", - schm = schm, + schm = mhcs(), main_key_value = input$load_data_key_selector, con = con ) @@ -799,7 +818,7 @@ server <- function(input, output, session) { load_data_to_form( df = df, table_name = "main", - schm + mhcs() ) values$main_key <- input$load_data_key_selector @@ -812,21 +831,21 @@ server <- function(input, output, session) { ## export to .xlsx ==== output$downloadData <- downloadHandler( - filename = paste0("test_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".xlsx"), + filename = paste0(isolate(scheme()), "_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".xlsx"), content = function(file) { - con <- db$make_db_connection("downloadData") + con <- db$make_db_connection(scheme(),"downloadData") on.exit(db$close_db_connection(con, "downloadData"), add = TRUE) # get all data list_of_df <- purrr::map( - .x = purrr::set_names(schm$all_tables_names), + .x = purrr::set_names(mhcs()$all_tables_names), .f = \(x) { df <- read_df_from_db_all(x, con) |> tibble::as_tibble() # handle with data - scheme <- schm$get_schema(x) + scheme <- mhcs()$get_schema(x) date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE) number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE) @@ -879,7 +898,7 @@ server <- function(input, output, session) { # iterate by scheme parts purrr::walk( - .x = unique(schm$get_schema("main")$part), + .x = unique(mhcs()$get_schema("main")$part), .f = \(x_iter1) { # write level 1 header HEADER_1 <- paste("#", x_iter1, "\n") @@ -887,14 +906,14 @@ server <- function(input, output, session) { # iterate by level2 headers (subgroups) purrr::walk( - .x = dplyr::pull(unique(subset(schm$get_schema("main"), part == x_iter1, "subgroup"))), + .x = dplyr::pull(unique(subset(mhcs()$get_schema("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 = schm$get_schema("main"), + x = mhcs()$get_schema("main"), subset = part == x_iter1 & subgroup == x_iter2, select = c("form_id", "form_label", "form_type") ) |> @@ -981,25 +1000,25 @@ server <- function(input, output, session) { observeEvent(input$button_upload_data_from_xlsx_confirm, { req(input$upload_xlsx) - con <- db$make_db_connection("button_upload_data_from_xlsx_confirm") + con <- db$make_db_connection(scheme(),"button_upload_data_from_xlsx_confirm") on.exit(db$close_db_connection(con, "button_upload_data_from_xlsx_confirm"), add = TRUE) file <- input$upload_xlsx$datapath wb <- openxlsx2::wb_load(file) - main_key_id <- schm$get_main_key_id + main_key_id <- mhcs()$get_main_key_id # проверка на наличие всех листов в файле - if (!all(schm$all_tables_names %in% openxlsx2::wb_get_sheet_names(wb))) { + if (!all(mhcs()$all_tables_names %in% openxlsx2::wb_get_sheet_names(wb))) { cli::cli_alert_warning("данные в файле '{file} не соответствуют схеме'") return() } # проверка схемы -------------- - for (table_name in schm$all_tables_names) { + for (table_name in mhcs()$all_tables_names) { df <- openxlsx2::read_xlsx(wb, table_name) - scheme <- schm$get_schema(table_name) |> + scheme <- mhcs()$get_schema(table_name) |> filter(!form_type %in% c("description", "nested_forms")) # столбцы в таблицы и схема @@ -1023,10 +1042,10 @@ server <- function(input, output, session) { } # обновление данных - for (table_name in schm$all_tables_names) { + for (table_name in mhcs()$all_tables_names) { df <- openxlsx2::read_xlsx(wb, table_name) - scheme <- schm$get_schema(table_name) |> + scheme <- mhcs()$get_schema(table_name) |> filter(!form_type %in% c("description", "nested_forms")) date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE) @@ -1139,7 +1158,7 @@ server <- function(input, output, session) { # output$display_log <- renderUI({ - # con <- db$make_db_connection("display_log") + # con <- db$make_db_connection(scheme(),"display_log") # on.exit(db$close_db_connection(con, "display_log"), add = TRUE) # query <- if (!is.null(values$main_key)) { diff --git a/modules/db.R b/modules/db.R index 54d635a..fd3c22f 100644 --- a/modules/db.R +++ b/modules/db.R @@ -2,9 +2,9 @@ #' @export #' @description Function to open connection to db, disigned to easy dubugging. #' @param where text mark to distingiush calss -make_db_connection = function(where = "") { +make_db_connection = function(scheme, where = "") { if (getOption("APP.DEBUG", FALSE)) message("=== DB CONNECT ", where) - DBI::dbConnect(RSQLite::SQLite(), getOption("APP.FILE_DB", FALSE)) + DBI::dbConnect(RSQLite::SQLite(), fs::path("db", scheme, ext = "sqlite")) } #' @export diff --git a/modules/global_options.R b/modules/global_options.R index af2fcf9..e457d4c 100644 --- a/modules/global_options.R +++ b/modules/global_options.R @@ -3,17 +3,19 @@ set_global_options = function( SYMBOL_DELIM = "; ", APP.DEBUG = FALSE, - APP.FILE_DB = fs::path("data.sqlite"), + # APP.FILE_DB = fs::path("data.sqlite"), shiny.host = "127.0.0.1", shiny.port = 1337, + enabled_schemas = c("schema", "schema_example"), ... ) { options( SYMBOL_DELIM = SYMBOL_DELIM, APP.DEBUG = APP.DEBUG, - APP.FILE_DB = APP.FILE_DB, + # APP.FILE_DB = APP.FILE_DB, shiny.host = shiny.host, shiny.port = shiny.port, + enabled_schemas = enabled_schemas, ... ) } @@ -23,21 +25,27 @@ check_and_init_scheme = function() { cli::cli_inform(c("*" = "проверка схемы...")) - scheme_file <- fs::path("configs/schemas", "schema.xlsx") - hash_file <- "schema_hash.rds" + # scheme_file <- fs::path("configs/schemas", "schema.xlsx") + scheme_names <- getOption("enabled_schemas") + scheme_file <- paste0("configs/schemas/", scheme_names, ".xlsx") + scheme_file <- stats::setNames(scheme_file, scheme_names) + + db_files <- paste0("db/", scheme_names, ".sqlite") + + hash_file <- "temp/schema_hash.rds" # exist_hash <- tools::md5sum(scheme_file) # если первый запуск (нет файла с кешем) инициализация схемы - if (!file.exists("schema_hash.rds") | !file.exists("scheme.rds")) { + if (!file.exists(hash_file) | !file.exists("scheme.rds") | !all(file.exists(db_files))) { init_scheme(scheme_file) # в ином случае - проверяем кэш } else { - saved_hash <- readRDS("schema_hash.rds") + saved_hash <- readRDS(hash_file) # если данные были изменены проводим реинициализацию таблицы и схемы if (!all(exist_hash == saved_hash)) { @@ -50,6 +58,7 @@ check_and_init_scheme = function() { } # перезаписываем файл + if (!dir.exists("temp")) dir.create("temp") saveRDS(exist_hash, hash_file) } @@ -62,12 +71,34 @@ init_scheme = function(scheme_file) { modules/scheme_generator[scheme_R6] ) - con <- db$make_db_connection() - on.exit(db$close_db_connection(con), add = TRUE) - cli::cli_h1("Инициализация схемы") - schm <- scheme_R6$new(scheme_file) - db$check_if_table_is_exist_and_init_if_not(schm, con) + schms <- purrr::map2( + .x = scheme_file, + .y = names(scheme_file), + \(x, y) { - saveRDS(schm, "scheme.rds") -} \ No newline at end of file + con <- db$make_db_connection(y) + on.exit(db$close_db_connection(con), add = TRUE) + + schm <- scheme_R6$new(x) + db$check_if_table_is_exist_and_init_if_not(schm, con) + schm + } + ) + + # проверка на наличие дублирующихся названий вложенных таблиц + nested_tables_ids <- purrr::map( + names(schms), + \(x) schms[[x]]$nested_tables_names + ) + nested_tables_ids <- unlist(nested_tables_ids) + tab <- table(nested_tables_ids) + + # если встречается хоть одно значение несколько раз - начать истошно кричать (могут возникнуть пробемы при вызове всплывающих окон в формах) + if (!all(!tab > 1)) { + cli::cli_abort(c("В одной или нескольких схемах наименования вложенных форм совпадают:", paste("-", names(tab)[tab > 1]))) + + } + + saveRDS(schms, "scheme.rds") +} diff --git a/modules/scheme_generator.R b/modules/scheme_generator.R index c2e3d4e..8fd4e9a 100644 --- a/modules/scheme_generator.R +++ b/modules/scheme_generator.R @@ -125,18 +125,28 @@ scheme_R6 <- R6::R6Class( c("subgroup", "form_id", "form_label", "form_type") ) - readxl::read_xlsx(private$scheme_file_path, sheet = sheet_name) |> + table <- readxl::read_xlsx(private$scheme_file_path, sheet = sheet_name) |> # fill NA down tidyr::fill(all_of(colnames), .direction = "down") |> dplyr::group_by(form_id) |> tidyr::fill(c(condition, required), .direction = "down") |> dplyr::ungroup() + duplicate_ids <- table |> + dplyr::mutate(rleid = dplyr::consecutive_id(form_id)) |> + dplyr::distinct(form_id, rleid) |> + dplyr::count(form_id) |> + dplyr::filter(n > 1) |> + dplyr::pull(form_id) + + if (length(duplicate_ids) > 0) { + cli::cli_abort(c("В схеме для формы '{sheet_name}' содержатся повторяющиеся id:", paste("-", duplicate_ids))) + } + table } ) ) -# schm <- scheme_R6$new(fs::path("configs/schemas", "schema.xlsx")) # object.size(schm) # schm$get_key_id("main") # schm$get_forms_ids("main") diff --git a/renv.lock b/renv.lock index 5b53b05..c219b23 100644 --- a/renv.lock +++ b/renv.lock @@ -232,14 +232,14 @@ }, "box": { "Package": "box", - "Version": "1.2.0", + "Version": "1.2.2", "Source": "Repository", - "Repository": "RSPM", + "Repository": "CRAN", "Requirements": [ "R", "tools" ], - "Hash": "d94049c1d9446b0abb413fde9e82a505" + "Hash": "5fd0a60cdaaea2b97046a82c13e17bfe" }, "bslib": { "Package": "bslib",