feat: работа с несколькими схемами в пределах одного приложения
This commit is contained in:
211
app.R
211
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)) {
|
||||
|
||||
Reference in New Issue
Block a user