refactor: вся основа кода в отдельной папке
This commit is contained in:
183
R/modules/scheme_generator.R
Normal file
183
R/modules/scheme_generator.R
Normal file
@@ -0,0 +1,183 @@
|
||||
|
||||
#' @export
|
||||
scheme_R6 <- R6::R6Class(
|
||||
"schemes_generator",
|
||||
public = list(
|
||||
|
||||
initialize = function(scheme_file_path = NULL) {
|
||||
|
||||
private$scheme_file_path <- scheme_file_path
|
||||
|
||||
# make list of schemes
|
||||
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)
|
||||
|
||||
# проверка на не пересечение с зарезервированными именами
|
||||
check <- private$reserved_table_names %in% private$nested_forms_names
|
||||
if (any(check)) cli::cli_abort(c("нельзя использовать данные имена вложенных таблиц:", paste("- ", private$reserved_table_names[check])))
|
||||
|
||||
# проверка на длину строк
|
||||
check <- (nchar(private$nested_forms_names) > 31)
|
||||
if (any(check)) cli::cli_abort(c("нельзя использовать имена длиной более 31 символа:", paste("- ", private$nested_forms_names[check])))
|
||||
|
||||
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)
|
||||
}
|
||||
)
|
||||
|
||||
# отдельно для тасков
|
||||
private$schemes_list[["tasks"]] <- tibble::tribble(
|
||||
~ form_id, ~form_type, ~form_label, ~form_description, ~choices,
|
||||
"dummy", "text", "dummy", "dummy", NA,
|
||||
"task_status", "select_one", "Статус задачи", NA, "active",
|
||||
"task_status", "select_one", "Статус задачи", NA, "completed",
|
||||
"task_status", "select_one", "Статус задачи", NA, "deleted",
|
||||
"task_title", "text", "Название задачи", NA, NA,
|
||||
"task_description", "text", "Описание задачи", "краткое описание", "3",
|
||||
"task_due_date", "date", "Дата выполнения задачи", NA, NA,
|
||||
) |>
|
||||
dplyr::mutate(condition = NA)
|
||||
|
||||
# extract main key
|
||||
private$main_key_id <- self$get_key_id("main")
|
||||
|
||||
box::use(R/modules/utils)
|
||||
private$bslib_rendered_ui <- bslib::navset_card_underline(
|
||||
id = "main",
|
||||
!!!utils$make_list_of_pages(private$schemes_list[["main"]], private$main_key_id),
|
||||
header = NULL,
|
||||
height = NULL
|
||||
)
|
||||
},
|
||||
|
||||
get_all_ids = function(table_name) {
|
||||
|
||||
private$schemes_list[[table_name]] |>
|
||||
dplyr::filter(!form_type %in% private$excluded_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]
|
||||
|
||||
},
|
||||
|
||||
# возврат схемы ------------------------------------
|
||||
## полностью -------
|
||||
get_scheme = function(table_name) {
|
||||
private$schemes_list[[table_name]]
|
||||
},
|
||||
|
||||
## с полями имеющие значение -------
|
||||
get_scheme_with_values_forms = function(table_name) {
|
||||
private$schemes_list[[table_name]] |>
|
||||
dplyr::filter(!form_type %in% private$excluded_types)
|
||||
},
|
||||
|
||||
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$excluded_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
|
||||
},
|
||||
get_main_form_ui = function() {
|
||||
private$bslib_rendered_ui
|
||||
}
|
||||
),
|
||||
private = list(
|
||||
scheme_file_path = NA,
|
||||
schemes_list = NULL,
|
||||
main_key_id = NA,
|
||||
nested_forms_names = NA,
|
||||
bslib_rendered_ui = NA,
|
||||
excluded_types = c("nested_forms", "description", "description_header"),
|
||||
reserved_table_names = c("meta", "log", "main", "tasks"),
|
||||
|
||||
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")
|
||||
)
|
||||
|
||||
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("В схеме '{private$scheme_file_path}' для формы '{sheet_name}' содержатся повторяющиеся id:", paste("-", duplicate_ids)))
|
||||
}
|
||||
|
||||
# проверка на корректные id
|
||||
input_names_with_dash <- unique(table$form_id)[grepl("-", unique(table$form_id))]
|
||||
if (length(input_names_with_dash) > 0) {
|
||||
cli::cli_abort(c("В схеме '{private$scheme_file_path}' в id форм содержатся `-`, может привести к некорректной последующей работой с базой данных", paste("-", input_names_with_dash)))
|
||||
}
|
||||
|
||||
table
|
||||
}
|
||||
)
|
||||
)
|
||||
|
||||
# object.size(schm)
|
||||
# schm$get_key_id("main")
|
||||
# schm$get_forms_ids("main")
|
||||
# schm$get_all_ids("main")
|
||||
|
||||
# schm$get_scheme("main")
|
||||
|
||||
# schm$get_id_type_list("allergo_anamnesis")
|
||||
|
||||
# # active
|
||||
# schm$get_main_key_id
|
||||
# schm$all_tables_names
|
||||
Reference in New Issue
Block a user