diff --git a/app.R b/app.R index 037270d..f234cbe 100644 --- a/app.R +++ b/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) { diff --git a/helpers/scheme_generator.R b/helpers/scheme_generator.R index 685b6ac..965c607 100644 --- a/helpers/scheme_generator.R +++ b/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( } ) -) \ No newline at end of file +) + +# 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 \ No newline at end of file diff --git a/modules/global_options.R b/modules/global_options.R index 227d418..8492df8 100644 --- a/modules/global_options.R +++ b/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") } \ No newline at end of file diff --git a/modules/utils.R b/modules/utils.R index 03336e7..d11784c 100644 --- a/modules/utils.R +++ b/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) {