diff --git a/app.R b/app.R
index f234cbe..de549ac 100644
--- a/app.R
+++ b/app.R
@@ -11,10 +11,6 @@ suppressPackageStartupMessages({
source("helpers/functions.R")
-
-# box::purge_cache()
-# box::use(./helpers/db)
-
# SOURCE FILES ============================
box::purge_cache()
box::use(
@@ -22,7 +18,7 @@ box::use(
modules/global_options,
modules/db,
modules/data_validation,
- helpers/scheme_generator[scheme_R6]
+ modules/scheme_generator[scheme_R6]
)
# SETTINGS ================================
@@ -1122,57 +1118,57 @@ server <- function(input, output, session) {
}
# КРАТКАЯ СВОДКА ПРО ЛОГГИНГ ------------------
- observe({
+ # observe({
- output$display_log <- renderUI({
+ # output$display_log <- renderUI({
- con <- db$make_db_connection("display_log")
- on.exit(db$close_db_connection(con, "display_log"), add = TRUE)
+ # con <- db$make_db_connection("display_log")
+ # on.exit(db$close_db_connection(con, "display_log"), add = TRUE)
- query <- if (!is.null(values$main_key)) {
- sprintf("SELECT * FROM log WHERE key = '%s'", values$main_key)
- } else {
- "SELECT * FROM log"
- }
+ # query <- if (!is.null(values$main_key)) {
+ # sprintf("SELECT * FROM log WHERE key = '%s'", values$main_key)
+ # } else {
+ # "SELECT * FROM log"
+ # }
- log_rows <- DBI::dbGetQuery(con, query)
+ # log_rows <- DBI::dbGetQuery(con, query)
- if (nrow(log_rows) > 0) {
+ # if (nrow(log_rows) > 0) {
- lines <- log_rows |>
- mutate(date = as.POSIXct(date)) |>
- mutate(
- # date = date + lubridate::hours(3), # fix datetime
- date_day = as.Date(date)
- ) |>
- mutate(cons_actions = dplyr::consecutive_id(action, user)) |>
- mutate(n_actions = row_number(), .by = c(cons_actions, user, action, date_day)) |>
- slice(which.max(n_actions), .by = c(user, action, date_day)) |>
- mutate(string_to_print = sprintf(
- "[%s %s]: %s - %s (%s)",
- format(date, "%d.%m.%y"),
- format(date, "%H:%M"),
- user,
- action,
- n_actions
- )) |>
- pull(string_to_print) |>
- paste(collapse = "")
+ # lines <- log_rows |>
+ # mutate(date = as.POSIXct(date)) |>
+ # mutate(
+ # # date = date + lubridate::hours(3), # fix datetime
+ # date_day = as.Date(date)
+ # ) |>
+ # mutate(cons_actions = dplyr::consecutive_id(action, user)) |>
+ # mutate(n_actions = row_number(), .by = c(cons_actions, user, action, date_day)) |>
+ # slice(which.max(n_actions), .by = c(user, action, date_day)) |>
+ # mutate(string_to_print = sprintf(
+ # "[%s %s]: %s - %s (%s)",
+ # format(date, "%d.%m.%y"),
+ # format(date, "%H:%M"),
+ # user,
+ # action,
+ # n_actions
+ # )) |>
+ # pull(string_to_print) |>
+ # paste(collapse = "")
- } else {
- lines <- ""
- }
+ # } else {
+ # lines <- ""
+ # }
- tagList(
- paste0("ID: ", values$main_key),
- br(),
- p(
- HTML(lines),
- style = "font-size:10px;"
- )
- )
- })
- })
+ # tagList(
+ # paste0("ID: ", values$main_key),
+ # br(),
+ # p(
+ # HTML(lines),
+ # style = "font-size:10px;"
+ # )
+ # )
+ # })
+ # })
}
diff --git a/modules/db.R b/modules/db.R
index 64c8955..dc42750 100644
--- a/modules/db.R
+++ b/modules/db.R
@@ -117,6 +117,7 @@ compare_existing_table_with_schema <- function(
main_key <- schm$get_main_key_id
key_id <- schm$get_key_id(table_name)
forms_ids <- schm$get_forms_ids(table_name)
+ forms_id_type_list <- schm$get_id_type_list(table_name)
if (table_name == "main") {
all_ids_from_schema <- c(main_key, forms_ids)
diff --git a/modules/global_options.R b/modules/global_options.R
index 8492df8..94553f2 100644
--- a/modules/global_options.R
+++ b/modules/global_options.R
@@ -59,7 +59,7 @@ init_scheme <- function(scheme_file) {
options(box.path = here::here())
box::use(
modules/db,
- helpers/scheme_generator[scheme_R6]
+ modules/scheme_generator[scheme_R6]
)
con <- db$make_db_connection()
diff --git a/modules/scheme_generator.R b/modules/scheme_generator.R
new file mode 100644
index 0000000..965c607
--- /dev/null
+++ b/modules/scheme_generator.R
@@ -0,0 +1,146 @@
+
+#' @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")
+
+ 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) {
+
+ 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
+ },
+ get_main_form_ui = function() {
+ private$testest
+ }
+ ),
+ private = list(
+ scheme_file_path = NA,
+ 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) {
+
+ 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(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()
+
+ }
+ )
+)
+
+# 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