feat: манипуляции со схемами через R6 объект а не танцы с листами и вложенными таблицами

app.R

@@ -10,6 +10,7 @@ suppressPackageStartupMessages({
 })
 
 source("helpers/functions.R")
+source("helpers/scheme_generator.R")
 
 # box::purge_cache()
 # box::use(./helpers/db)
@@ -40,106 +41,41 @@ rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/")
 # TODO: dynamic button render depend on pandoc installation
 if (!rmarkdown::pandoc_available()) warning("Can't find pandoc!")
 
-load_scheme_from_xlsx <- function(
-  sheet_name
-) {
-
-  colnames <- switch(sheet_name,
-    "main" = c("part", "subgroup", "form_id", "form_label", "form_type"),
-    c("subgroup", "form_id", "form_label", "form_type")
-  )
-
-  readxl::read_xlsx(FILE_SCHEME, 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()
-
-}
-
-extract_forms_id_and_types_from_scheme <- function(scheme, drop_key = c("main_key", "nested_key")) {
-
-  drop_key <- match.arg(drop_key)
-
-  form_id_and_types_list <- scheme |>
-    dplyr::filter(!form_type %in% c("inline_table", "nested_forms","description", "description_header")) |>
-    dplyr::distinct(form_id, form_type) |>
-    tibble::deframe()
-
-  if(!drop_key %in% names(form_id_and_types_list)) cli::cli_abort("в схеме должно быть поле с ключем (key)")
-  form_id_and_types_list[names(form_id_and_types_list) != drop_key]
-
-}
-
 # SCHEME_MAIN UNPACK ==========================
-# load scheme
+schm <- scheme_R6$new(FILE_SCHEME)
-SCHEMES_LIST <- list()
+object.size(schm)
-SCHEMES_LIST[["main"]] <- load_scheme_from_xlsx("main")
+schm$get_key_id("main")
+schm$get_forms_ids("main")
+schm$get_all_ids("main")
 
-# get list of simple inputs
+schm$get_schema("main")
-main_id_and_types_list <- extract_forms_id_and_types_from_scheme(SCHEMES_LIST[["main"]])
 
-nested_forms_df <- SCHEMES_LIST[["main"]] |>
+schm$get_id_type_list("allergo_anamnesis")
-  dplyr::filter(form_type == "nested_forms") |>
-  dplyr::distinct(form_id, .keep_all = TRUE)
 
-# лист со схемами для всех вложенных формы
+# active
-purrr::walk(
+schm$get_main_key_id
+schm$all_tables_names
 
-  .x = purrr::set_names(unique(nested_forms_df$form_id)),
-  .f = \(nested_form_id) {
 
-    nested_form_scheme_sheet_name <- nested_forms_df |>
-      dplyr::filter(form_id == {nested_form_id}) |>
-      dplyr::pull(choices)
 
-    # загрузка схемы для данной вложенной формы
-    SCHEMES_LIST[[nested_form_id]] <<- load_scheme_from_xlsx(nested_form_scheme_sheet_name)
-
-  }
-)
 
 # establish connection
 con <- db$make_db_connection()
 
 # init DB (write dummy data to "main" table)
-db$check_if_table_is_exist_and_init_if_not("main", main_id_and_types_list)
+# db$check_if_table_is_exist_and_init_if_not("main", main_id_and_types_list)
-
+db$check_if_table_is_exist_and_init_if_not(schm, con)
-purrr::walk(
-  .x = unique(nested_forms_df$form_id),
-  .f = \(table_name) {
-
-    this_inline_table2_info <- nested_forms_df |>
-      dplyr::filter(form_id == {table_name})
-
-    # получение имя файла с таблицой
-    nested_form_scheme_sheet_name <- this_inline_table2_info$choices
-
-    # загрузка схемы для данной вложенной формы
-    this_nested_form_scheme <- load_scheme_from_xlsx(nested_form_scheme_sheet_name)
-
-    this_table_id_and_types_list <- extract_forms_id_and_types_from_scheme(this_nested_form_scheme, "nested_key")
-
-    db$check_if_table_is_exist_and_init_if_not(
-      table_name,
-      this_table_id_and_types_list,
-      con = con
-    )
-
-  }
-)
 
 # close connection to prevent data loss
 db$close_db_connection(con)
 
 # generate nav panels for each page
 nav_panels_list <- purrr::map(
-  .x = unique(SCHEMES_LIST[["main"]]$part),
+  .x = unique(schm$get_schema("main")$part),
   .f = \(page_name) {
 
     # отделить схему для каждой страницы
-    this_page_panels_scheme <- SCHEMES_LIST[["main"]] |>
+    this_page_panels_scheme <- schm$get_schema("main") |>
       dplyr::filter(!form_id %in% c("main_key", "nested_key")) |>
       dplyr::filter(part == {{page_name}})
 
@@ -269,7 +205,8 @@ server <- function(input, output, session) {
     ns, 
     con
   ) {
-    
+
+    nested_key_id <- schm$get_key_id(table_name)
     input_types <- unname(id_and_types_list)
     input_ids   <- names(id_and_types_list)
 
@@ -306,7 +243,7 @@ server <- function(input, output, session) {
     if (table_name == "main") {
       exported_df <- exported_df |>
         mutate(
-          main_key = values$main_key,
+          !!dplyr::sym(schm$get_main_key_id) := values$main_key,
           .before = 1
         )
     }
@@ -315,8 +252,8 @@ server <- function(input, output, session) {
     if (table_name != "main") {
       exported_df <- exported_df |>
         mutate(
-          main_key   = values$main_key,
+          !!dplyr::sym(schm$get_main_key_id) := values$main_key,
-          nested_key = values$nested_key,
+          !!dplyr::sym(nested_key_id) := values$nested_key,
           .before = 1
         )
     }
@@ -327,9 +264,9 @@ server <- function(input, output, session) {
     db$write_df_to_db(
       df = exported_df,
       table_name = table_name,
-      scheme = SCHEMES_LIST[[table_name]],
+      schm = schm,
-      main_key = values$main_key,
+      main_key_value = values$main_key,
-      nested_key = values$nested_key,
+      nested_key_value = values$nested_key,
       con = con
     )
   }
@@ -339,7 +276,7 @@ server <- function(input, output, session) {
   # ====================================
   ## кнопки для каждой вложенной таблицы -------------------------------
   purrr::walk(
-    .x = nested_forms_df$form_id,
+    .x = schm$nested_tables_names,
     .f = \(nested_form_id) {
 
       observeEvent(input[[nested_form_id]], {
@@ -350,7 +287,6 @@ server <- function(input, output, session) {
 
         values$nested_form_id <- nested_form_id
         values$nested_key     <- NULL # для нормальной работы реактивных значений
-
         show_modal_for_nested_form(con)
 
       })
@@ -363,8 +299,8 @@ server <- function(input, output, session) {
     ns <- NS(values$nested_form_id)
 
     # загрузка схемы для данной вложенной формы
-    this_nested_form_scheme <- SCHEMES_LIST[[values$nested_form_id]]
+    this_nested_form_scheme <-  schm$get_schema(values$nested_form_id)
-    values$nested_id_and_types <- extract_forms_id_and_types_from_scheme(this_nested_form_scheme, "nested_key")
+    values$nested_id_and_types <- schm$get_id_type_list(values$nested_form_id)
 
     # мини-схема для ключа
     this_nested_form_key_scheme <- subset(this_nested_form_scheme, form_id == "nested_key")
@@ -451,7 +387,7 @@ server <- function(input, output, session) {
       con = con
     )
 
-    col_types <- SCHEMES_LIST[[values$nested_form_id]] |>
+    col_types <- schm$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)
@@ -518,9 +454,9 @@ server <- function(input, output, session) {
     db$write_df_to_db(
       df = export_df,
       table_name = values$nested_form_id,
-      scheme = SCHEMES_LIST[[values$nested_form_id]],
+      schm = schm,
-      main_key = values$main_key,
+      main_key_value = values$main_key,
-      nested_key = NULL,
+      nested_key_value = NULL,
       con = con
     )
 
@@ -540,7 +476,7 @@ server <- function(input, output, session) {
     # сохраняем данные основной формы!!!
     save_inputs_to_db(
       table_name        = "main",
-      id_and_types_list = main_id_and_types_list,
+      id_and_types_list = schm$get_id_type_list("main"),
       con               = con
     )
 
@@ -600,7 +536,7 @@ server <- function(input, output, session) {
     removeModal()
 
     # та самая форма для ключа
-    scheme_for_key_input <- SCHEMES_LIST[[values$nested_form_id]] |>
+    scheme_for_key_input <- schm$get_schema(values$nested_form_id) |>
       dplyr::filter(form_id %in% c("nested_key"))
 
     ui1 <- rlang::exec(
@@ -650,7 +586,7 @@ server <- function(input, output, session) {
 
   # VALIDATIONS ============================
   # create new validator
-  iv_main <- data_validation$init_val(SCHEMES_LIST[["main"]])
+  iv_main <- data_validation$init_val(schm$get_schema("main"))
   iv_main$enable()
 
   # STATUSES ===============================
@@ -673,7 +609,7 @@ server <- function(input, output, session) {
   observeEvent(input$add_new_main_key_button, {
 
     # данные для главного ключа
-    scheme_for_key_input <- SCHEMES_LIST[["main"]] |>
+    scheme_for_key_input <- schm$get_schema("main") |>
       dplyr::filter(form_id == "main_key")
 
     # создать форму для выбора ключа
@@ -714,7 +650,7 @@ server <- function(input, output, session) {
     }
     
     values$main_key <- input$main_key
-    utils$clean_forms(main_id_and_types_list)
+    utils$clean_forms(schm$get_id_type_list("main"))
 
     removeModal()
   })
@@ -729,7 +665,7 @@ server <- function(input, output, session) {
   observeEvent(input$clean_all_action, {
     
     # rewrite all inputs with empty data
-    utils$clean_forms(main_id_and_types_list)
+    utils$clean_forms(schm$get_id_type_list("main"))
 
     removeModal()
     showNotification("Данные очищены!", type = "warning")
@@ -744,7 +680,7 @@ server <- function(input, output, session) {
 
     save_inputs_to_db(
       table_name = "main",
-      id_and_types_list = main_id_and_types_list,
+      id_and_types_list = schm$get_id_type_list("main"),
       con = con
     )
 
@@ -811,7 +747,7 @@ server <- function(input, output, session) {
 
     load_data_to_form(
       df = df,
-      id_and_types_list = main_id_and_types_list
+      id_and_types_list = schm$get_id_type_list("main")
     )
   
     values$main_key <- input$load_data_key_selector
@@ -829,14 +765,14 @@ server <- function(input, output, session) {
 
       # get all data
       list_of_df <- purrr::map(
-        .x = purrr::set_names(c("main", unique(nested_forms_df$form_id))),
+        .x = purrr::set_names(schm$all_tables_names),
         .f = \(x) {
 
           df <- read_df_from_db_all(x, con) |>
             tibble::as_tibble()
 
           # handle with data
-          scheme <- SCHEMES_LIST[[x]]
+          scheme <- schm$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)
@@ -890,7 +826,7 @@ server <- function(input, output, session) {
 
       # iterate by scheme parts
       purrr::walk(
-        .x = unique(SCHEMES_LIST[["main"]]$part),
+        .x = unique(schm$get_schema("main")$part),
         .f = \(x_iter1) {
           # write level 1 header
           HEADER_1 <- paste("#", x_iter1, "\n")
@@ -898,14 +834,14 @@ server <- function(input, output, session) {
 
           # iterate by level2 headers (subgroups)
           purrr::walk(
-            .x = dplyr::pull(unique(subset(SCHEMES_LIST[["main"]], part == x_iter1, "subgroup"))),
+            .x = dplyr::pull(unique(subset(schm$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 = SCHEMES_LIST[["main"]],
+                x = schm$get_schema("main"),
                 subset = part == x_iter1 & subgroup == x_iter2,
                 select = c("form_id", "form_label", "form_type")
               ) |>
@@ -989,30 +925,31 @@ server <- function(input, output, session) {
   })
 
   observeEvent(input$button_upload_data_from_xlsx_confirm, {
-    req(input$upload_xlsx
+    req(input$upload_xlsx)
-    )
+
     con <- db$make_db_connection("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
-    # print(file)
     wb <- openxlsx2::wb_load(file)
 
     # проверка на наличие всех листов в файле
-    if (!all(names(SCHEMES_LIST) %in% openxlsx2::wb_get_sheet_names(wb))) {
+    if (!all(schm$all_tables_names %in% openxlsx2::wb_get_sheet_names(wb))) {
       cli::cli_alert_warning("данные в файле '{file} не соответствуют схеме'")
       return()
     }
 
     # проверка схемы --------------
-    for (table_name in names(SCHEMES_LIST)) {
+    for (table_name in schm$all_tables_names) {
 
       df     <- openxlsx2::read_xlsx(wb, table_name) 
-      scheme <- SCHEMES_LIST[[table_name]] |>
+      scheme <- schm$get_schema(table_name) |>
         filter(!form_type %in% c("description", "nested_forms"))
 
       # столбцы в таблицы и схема
       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 ) {
         cli::cli_warn(c("в схеме для '{table_name}' нет следующих столбцов:", paste("- ", df_to_schema_compare)))
       }
@@ -1030,10 +967,10 @@ server <- function(input, output, session) {
     }
 
     # обновление данных
-    for (table_name in names(SCHEMES_LIST)) {
+    for (table_name in schm$all_tables_names) {
 
       df     <- openxlsx2::read_xlsx(wb, table_name) 
-      scheme <- SCHEMES_LIST[[table_name]] |>
+      scheme <- schm$get_schema(table_name) |>
         filter(!form_type %in% c("description", "nested_forms"))
 
       date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)

configs/config.yml

@@ -2,6 +2,6 @@ default:
   header: "TEST"
   version: "0.14.1"
   # shiny serve option
-  shiny_host: "127.0.0.1"
+  shiny_host: "0.0.0.0"
   shiny_port: 1337
   auth_module: FALSE # default: FALSE

helpers/scheme_generator.R

@@ -0,0 +1,123 @@
+
+#' @export
+scheme_R6 <- R6::R6Class(
+  "schemes_f",
+  public = list(
+
+    initialize = function(scheme_file_path = NULL) {
+      private$scheme_file_path <- scheme_file_path
+
+      # make list of schemas
+      private$schemes_list <- list()
+      private$schemes_list[["main"]] <- private$load_scheme_from_xlsx("main")
+
+      # имена вложенных форм
+      private$nested_forms_names <- private$schemes_list[["main"]] |>
+        dplyr::filter(form_type == "nested_forms") |>
+        dplyr::distinct(form_id) |>
+        dplyr::pull(form_id)
+
+      purrr::walk(
+        .x = purrr::set_names(private$nested_forms_names),
+        .f = \(nested_form_id) {
+
+          nested_form_scheme_sheet_name <- private$schemes_list[["main"]] |>
+            dplyr::filter(form_id == {{nested_form_id}}) |>
+            dplyr::distinct(form_id, .keep_all = TRUE) |>
+            dplyr::pull(choices)
+
+          # загрузка схемы для данной вложенной формы
+          private$schemes_list[[nested_form_id]] <<- private$load_scheme_from_xlsx(nested_form_scheme_sheet_name)
+        }
+      )
+
+      # extract main key
+      private$main_key_id <- self$get_key_id("main")
+    },
+
+    get_all_ids = function(table_name) {
+
+      private$schemes_list[[table_name]] |>
+        dplyr::filter(!form_type %in% private$exluded_types) |>
+        dplyr::distinct(form_id) |>
+        dplyr::pull(form_id)
+
+    },
+    get_key_id = function(table_name) {
+
+      ids <- self$get_all_ids(table_name)
+      ids[1]
+
+    },
+    get_forms_ids = function(table_name) {
+
+      ids <- self$get_all_ids(table_name)
+      ids[-1]
+
+    },
+
+    extract_forms_id_and_types_from_scheme2 = function(scheme) {
+
+      form_id_and_types_list <- scheme |>
+        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_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_id != {{this_key_id}}) |>
+        dplyr::distinct(form_id, form_type) |>
+        tibble::deframe()
+    }
+  ),
+  active = list(
+    get_main_key_id = function() {
+      private$main_key_id
+    },
+    all_tables_names = function() {
+      c("main", private$nested_forms_names)
+    },
+    nested_tables_names = function() {
+      private$nested_forms_names
+    }
+  ),
+  private = list(
+    scheme_file_path = NA,
+    schemes_list = NULL,
+    main_key_id = NA,
+    nested_forms_names = NA,
+    exluded_types = c("inline_table", "nested_forms","description", "description_header"),
+
+    load_scheme_from_xlsx = function(sheet_name) {
+
+      colnames <- switch(sheet_name,
+        "main" = c("part", "subgroup", "form_id", "form_label", "form_type"),
+        c("subgroup", "form_id", "form_label", "form_type")
+      )
+
+      readxl::read_xlsx(FILE_SCHEME, 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()
+
+    }
+  )
+)

modules/db.R

@@ -24,43 +24,57 @@ close_db_connection <- function(con, where = "") {
 #' @description
 #' Проверить если таблица есть в базе данных и инициировать ее, если от
 check_if_table_is_exist_and_init_if_not <- function(
-  table_name,
+  schm,
-  forms_id_type_list,
   con = rlang::env_get(rlang::caller_env(), nm = "con")
 ) {
 
-  if (table_name %in% DBI::dbListTables(con)) {
+  main_key <- schm$get_main_key_id
 
-    cli::cli_inform(c("*" = "таблица есть такая: '{table_name}'"))
+  purrr::walk(
+    .x = schm$all_tables_names,
+    .f = \(table_name, con) {
 
-    # если таблица существует, производим проверку структуры таблицы
+      forms_id_type_list <- schm$get_id_type_list(table_name)
-    compare_existing_table_with_schema(table_name, forms_id_type_list)
+      key_name           <- schm$get_key_id(table_name)
 
-  } else {
+      if (table_name %in% DBI::dbListTables(con)) {
 
-    if (table_name == "main") {
+        cli::cli_inform(c("*" = "таблица есть такая: '{table_name}'"))
-      dummy_df <- dplyr::mutate(
+
-        get_dummy_df(forms_id_type_list), 
+        # если таблица существует, производим проверку структуры таблицы
-        main_key = "dummy",
+        compare_existing_table_with_schema(
-        .before = 1
+          table_name = table_name,
-      )
+          schm = schm
-    }
-    if (table_name != "main") {
-      dummy_df <- get_dummy_df(forms_id_type_list) |>
-        dplyr::mutate(
-          main_key = "dummy",
-          nested_key = "dummy",
-          .before = 1
         )
-    }
 
-    # write dummy df into base, then delete dummy row
+      } else {
-    DBI::dbWriteTable(con, table_name, dummy_df, append = TRUE)
-    DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE main_key = 'dummy'"))
 
-    cli::cli_alert_success("таблица '{table_name}' успешно создана")
+        if (table_name == "main") {
-  }
+          dummy_df <- get_dummy_df(forms_id_type_list) |>
+            dplyr::mutate(
+              !!dplyr::sym(main_key) := "dummy",
+              .before = 1
+            )
+        }
+        if (table_name != "main") {
+          dummy_df <- get_dummy_df(forms_id_type_list) |>
+            dplyr::mutate(
+              !!dplyr::sym(main_key) := "dummy",
+              !!dplyr::sym(key_name) := "dummy",
+              .before = 1
+            )
+        }
 
+        # write dummy df into base, then delete dummy row
+        DBI::dbWriteTable(con, table_name, dummy_df, append = TRUE)
+        DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE {main_key} = 'dummy'"))
+
+        cli::cli_alert_success("таблица '{table_name}' успешно создана")
+      }
+    },
+    con = con
+  )
+  
 }
 
 #' @description
@@ -96,45 +110,47 @@ get_dummy_df <- function(forms_id_type_list) {
 #' коррекции таблицы
 compare_existing_table_with_schema <- function(
   table_name,
-  forms_id_type_list,
+  schm,
   con = rlang::env_get(rlang::caller_env(), nm = "con")
 ) {
 
-  forms_id_type_list_names <- names(forms_id_type_list)
+  main_key  <- schm$get_main_key_id
+  key_id    <- schm$get_key_id(table_name)
+  forms_ids <- schm$get_forms_ids(table_name)
 
   if (table_name == "main") {
-    forms_id_type_list_names <- c("main_key", forms_id_type_list_names)
+    all_ids_from_schema <- c(main_key, forms_ids)
   } else {
-    forms_id_type_list_names <- c("main_key", "nested_key", forms_id_type_list_names)
+    all_ids_from_schema <- c(main_key, key_id, forms_ids)
   }
 
   options(box.path = here::here())
   box::use(modules/utils)
 
   # checking if db structure in form compatible with alrady writed data (in case on changig form)
-  if (identical(colnames(DBI::dbReadTable(con, table_name)), forms_id_type_list_names)) {
+  if (identical(colnames(DBI::dbReadTable(con, table_name)), all_ids_from_schema)) {
     # ...
   } else {
 
     df_to_rewrite <- DBI::dbReadTable(con, table_name)
-    form_base_difference <- setdiff(forms_id_type_list_names, colnames(df_to_rewrite))
+    form_base_difference <- setdiff(all_ids_from_schema, colnames(df_to_rewrite))
-    base_form_difference <- setdiff(colnames(df_to_rewrite), forms_id_type_list_names)
+    base_form_difference <- setdiff(colnames(df_to_rewrite), all_ids_from_schema)
 
     # if lengths are equal
-    if (length(forms_id_type_list_names) == length(colnames(df_to_rewrite)) &&
+    if (length(all_ids_from_schema) == length(colnames(df_to_rewrite)) &&
           length(form_base_difference) == 0 &&
           length(base_form_difference) == 0) {
       cli::cli_warn("changes in scheme file detected: assuming order changed only")
-      print(forms_id_type_list_names)
+      print(all_ids_from_schema)
     }
 
-    if (length(forms_id_type_list_names) == length(colnames(df_to_rewrite)) &&
+    if (length(all_ids_from_schema) == length(colnames(df_to_rewrite)) &&
           length(form_base_difference) != 0 &&
           length(base_form_difference) != 0) {
       cli::cli_abort("changes in scheme file detected: structure has been changed")
     }
 
-    if (length(forms_id_type_list_names) > length(colnames(df_to_rewrite)) && length(form_base_difference) != 0) {
+    if (length(all_ids_from_schema) > length(colnames(df_to_rewrite)) && length(form_base_difference) != 0) {
       cli::cli_warn("changes in scheme file detected: new inputs form was added")
       cli::cli_warn("trying to adapt database")
 
@@ -146,13 +162,13 @@ compare_existing_table_with_schema <- function(
 
       # reorder due to scheme
       df_to_rewrite <- df_to_rewrite |>
-        dplyr::select(dplyr::all_of(forms_id_type_list_names))
+        dplyr::select(dplyr::all_of(all_ids_from_schema))
 
       DBI::dbWriteTable(con, table_name, df_to_rewrite, overwrite = TRUE)
-      DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE main_key = 'dummy'"))
+      DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE {main_key} = 'dummy'"))
     }
 
-    if (length(forms_id_type_list_names) < length(colnames(df_to_rewrite))) {
+    if (length(all_ids_from_schema) < length(colnames(df_to_rewrite))) {
       cli::cli_abort("changes in scheme file detected: some of inputs form was deleted! it may cause data loss!")
     }
     
@@ -160,7 +176,18 @@ compare_existing_table_with_schema <- function(
 }
 
 #' @export
-write_df_to_db <- function(df, table_name, scheme, main_key, nested_key, con) {
+write_df_to_db <- function(
+  df, 
+  table_name, 
+  schm,
+  main_key_value, 
+  nested_key_value, 
+  con
+) {
+
+  scheme         <- schm$get_schema(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)
@@ -174,25 +201,25 @@ write_df_to_db <- function(df, table_name, scheme, main_key, nested_key, con) {
     )
 
   if (table_name == "main") {
-    del_query <- glue::glue("DELETE FROM main WHERE main_key = '{main_key}'")
+    del_query <- glue::glue("DELETE FROM main WHERE {main_key_id} = '{main_key_value}'")
   }
 
   if (table_name != "main") {
-    if (is.null(nested_key)) {
+    if (is.null(nested_key_value)) {
-      del_query <- glue::glue("DELETE FROM '{table_name}' WHERE main_key = '{main_key}'")
+      del_query <- glue::glue("DELETE FROM '{table_name}' WHERE {main_key_id} = '{main_key_value}'")
     } else {
-      del_query <- glue::glue("DELETE FROM '{table_name}' WHERE main_key = '{main_key}' AND nested_key = '{nested_key}'")
+      del_query <- glue::glue("DELETE FROM '{table_name}' WHERE {main_key_id} = '{main_key_value}' AND {nested_key_id} = '{nested_key_value}'")
     }
   }
 
   deleted <- DBI::dbExecute(con, del_query)
-  cli::cli_alert_success("deleted {deleted} rows for '{main_key}' in '{table_name}")
+  cli::cli_alert_success("deleted {deleted} rows for '{main_key_value}' in '{table_name}")
 
   # записать данные
   DBI::dbWriteTable(con, table_name, df, append = TRUE)
 
   # report
-  cli::cli_alert_success("данные для '{main_key}' в таблице '{table_name}' успешно обновлены")
+  cli::cli_alert_success("данные для '{main_key_value}' в таблице '{table_name}' успешно обновлены")
 
 }