feat: препроверка схемы перед загрузкой

app.R

@@ -10,29 +10,30 @@ suppressPackageStartupMessages({
 })
 
 source("helpers/functions.R")
-source("helpers/scheme_generator.R")
+
 
 # box::purge_cache()
 # box::use(./helpers/db)
 
 # SOURCE FILES ============================
-FILE_SCHEME <- fs::path("configs/schemas", "schema.xlsx")
-HEADER_TEXT <- sprintf("%s (%s)", Sys.getenv("FORM_TITLE", "NA"), Sys.getenv("FORM_VERSION", "NA"))
-
 box::purge_cache()
 box::use(
   modules/utils,
   modules/global_options,
   modules/db,
-  modules/data_validation
+  modules/data_validation,
+  helpers/scheme_generator[scheme_R6]
 )
 
+# SETTINGS ================================
+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"))
+
 global_options$set_global_options(
   shiny.host = "0.0.0.0"
 )
-
-# SETTINGS ================================
-AUTH_ENABLED <- Sys.getenv("FORM_AUTH_ENABLED", FALSE)
+global_options$check_and_init_scheme()
 
 # CHECK FOR PANDOC
 # TEMP ! NEED TO HANDLE
@@ -42,50 +43,20 @@ rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/")
 if (!rmarkdown::pandoc_available()) warning("Can't find pandoc!")
 
 # SCHEME_MAIN UNPACK ==========================
-schm <- scheme_R6$new(FILE_SCHEME)
-object.size(schm)
-schm$get_key_id("main")
-schm$get_forms_ids("main")
-schm$get_all_ids("main")
+schm            <- readRDS("scheme.rds")
+nav_panels_list <- schm$get_main_form_ui
 
-schm$get_schema("main")
+# 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")
 
-schm$get_id_type_list("allergo_anamnesis")
+# check tables
 
-# active
-schm$get_main_key_id
-schm$all_tables_names
-# ----------------------------
-
-# 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(schm, 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(schm$get_schema("main")$part),
-  .f = \(page_name) {
-
-    # отделить схему для каждой страницы
-    this_page_panels_scheme <- schm$get_schema("main") |>
-      dplyr::filter(!form_id %in% schm$get_main_key_id) |>
-      dplyr::filter(part == {{page_name}})
-
-    this_page_panels <- utils$make_panels(this_page_panels_scheme)
-
-    # add panel wrap to nav_panel
-    bslib::nav_panel(
-      title = page_name,
-      this_page_panels
-    )
-  }
-)
 
 # UI =======================
 ui <- page_sidebar(
@@ -153,10 +124,13 @@ server <- function(input, output, session) {
     NULL
   }
 
+  # важные кнопки управления
   output$admin_buttons_panel <- renderUI({
 
+    # показывать важные кнопки управления по умолчанию
     showing_buttons <- TRUE
 
+    # если включена авторизация, то демонстрация только для админов
     if (AUTH_ENABLED) {
       reactiveValuesToList(res_auth)
       if (res_auth$admin) {

helpers/scheme_generator.R

@@ -5,6 +5,7 @@ scheme_R6 <- R6::R6Class(
   public = list(
 
     initialize = function(scheme_file_path = NULL) {
+
       private$scheme_file_path <- scheme_file_path
 
       # make list of schemas
@@ -33,6 +34,9 @@ scheme_R6 <- R6::R6Class(
 
       # extract main key
       private$main_key_id <- self$get_key_id("main")
+
+      box::use(modules/utils)
+      private$testest     <- utils$make_list_of_pages(private$schemes_list[["main"]], private$main_key_id)
     },
 
     get_all_ids = function(table_name) {
@@ -96,6 +100,9 @@ scheme_R6 <- R6::R6Class(
     },
     nested_tables_names = function() {
       private$nested_forms_names
+    },
+    get_main_form_ui = function() {
+      private$testest
     }
   ),
   private = list(
@@ -103,6 +110,7 @@ scheme_R6 <- R6::R6Class(
     schemes_list = NULL,
     main_key_id = NA,
     nested_forms_names = NA,
+    testest = NA,
     exluded_types = c("inline_table", "nested_forms","description", "description_header"),
 
     load_scheme_from_xlsx = function(sheet_name) {
@@ -112,7 +120,7 @@ scheme_R6 <- R6::R6Class(
         c("subgroup", "form_id", "form_label", "form_type")
       )
 
-      readxl::read_xlsx(FILE_SCHEME, sheet = sheet_name) |>
+      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) |>
@@ -121,4 +129,18 @@ scheme_R6 <- R6::R6Class(
 
     }
   )
-)
+)
+
+# schm <- scheme_R6$new(fs::path("configs/schemas", "schema.xlsx"))
+# object.size(schm)
+# schm$get_key_id("main")
+# schm$get_forms_ids("main")
+# schm$get_all_ids("main")
+
+# schm$get_schema("main")
+
+# schm$get_id_type_list("allergo_anamnesis")
+
+# # active
+# schm$get_main_key_id
+# schm$all_tables_names

modules/global_options.R

@@ -16,4 +16,58 @@ set_global_options <- function(
     shiny.port = shiny.port,
     ...
   )
+}
+
+#' @export
+check_and_init_scheme <- function() {
+
+  cli::cli_inform(c("*" = "проверка схемы..."))
+
+  scheme_file <- fs::path("configs/schemas", "schema.xlsx")
+  hash_file   <- "schema_hash.rds"
+
+  # 
+  exist_hash <- tools::md5sum(scheme_file)
+
+  # если первый запуск (нет файла с кешем) инициализация схемы
+  if (!file.exists("schema_hash.rds") | !file.exists("scheme.rds")) {
+
+    init_scheme(scheme_file)
+
+  # в ином случае - проверяем кэш
+  } else {
+    
+    saved_hash <- readRDS("schema_hash.rds")
+
+    # если данные были изменены проводим реинициализацию таблицы и схемы
+    if (!all(exist_hash == saved_hash)) {
+
+      cli::cli_inform(c(">" = "Данные схемы были изменены..."))
+      init_scheme(scheme_file)
+    } else {
+      cli::cli_alert_success("изменений нет")
+    }
+  }
+
+  # перезаписываем файл
+  saveRDS(exist_hash, hash_file)
+}
+
+
+init_scheme <- function(scheme_file) {
+
+  options(box.path = here::here())
+  box::use(
+    modules/db,
+    helpers/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)
+
+  saveRDS(schm, "scheme.rds")
 }

modules/utils.R

@@ -1,3 +1,26 @@
+#' @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) {
+
+      # отделить схему для каждой страницы
+      this_page_panels_scheme <- main_schema |>
+        dplyr::filter(!form_id %in% main_key_id) |>
+        dplyr::filter(part == {{page_name}})
+
+      this_page_panels <- make_panels(this_page_panels_scheme)
+
+      # add panel wrap to nav_panel
+      bslib::nav_panel(
+        title = page_name,
+        this_page_panels
+      )
+    }
+  )
+}
+
 #' @export
 make_panels <- function(scheme) {