Compare commits
14 Commits
e7497c7d53
...
devel
| Author | SHA1 | Date | |
|---|---|---|---|
| c63beeef0c | |||
| 87444b5718 | |||
| 4b05fbafc2 | |||
| c8da651e72 | |||
| fd5a7927cb | |||
| bc5b4ea208 | |||
| 0c3c35936e | |||
| 7b6cbc67e4 | |||
| 696f2e3ac8 | |||
| 985cf99f5f | |||
| a9bbaf4504 | |||
| bb6f94126c | |||
| 43af8c20c4 | |||
| fe7cb9589e |
299
app.R
299
app.R
@@ -16,45 +16,49 @@ box::use(
|
||||
modules/global_options,
|
||||
modules/db,
|
||||
modules/data_validation,
|
||||
modules/scheme_generator[scheme_R6]
|
||||
app/forms,
|
||||
app/tasks
|
||||
)
|
||||
|
||||
# global settings:
|
||||
global_options$set_global_options(
|
||||
shiny.host = "0.0.0.0"
|
||||
shiny.host = "0.0.0.0",
|
||||
APP.DEBUG = FALSE
|
||||
)
|
||||
|
||||
# init:
|
||||
global_options$check_and_init_scheme()
|
||||
|
||||
# global vars
|
||||
# global vars:
|
||||
box::use(
|
||||
modules/global_options[AUTH_ENABLED]
|
||||
)
|
||||
enabled_schemes <- unlist(config::get()$form_schemes)
|
||||
enabled_schemes <- setNames(names(enabled_schemes), enabled_schemes)
|
||||
|
||||
# SETTINGS ================================
|
||||
HEADER_TEXT <- sprintf("%s (%s)", config::get("form_name"), config::get("form_app_version"))
|
||||
# load schemes object:
|
||||
schms <- readRDS("scheme.rds")
|
||||
|
||||
# sadasdasdasdasdas
|
||||
options(box.path = config::get("form_app_configure_path"))
|
||||
box::use(configs/enabled_schemes[enabled_schemes])
|
||||
|
||||
# CHECK FOR PANDOC
|
||||
# TEMP ! NEED TO HANDLE
|
||||
# CHECK FOR PANDOC ----------
|
||||
rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/")
|
||||
|
||||
# TODO: dynamic button render depend on pandoc installation
|
||||
if (!rmarkdown::pandoc_available()) warning("Can't find pandoc!")
|
||||
|
||||
# SCHEME_MAIN UNPACK ==========================
|
||||
schms <- readRDS("scheme.rds")
|
||||
|
||||
# UI =======================
|
||||
ui <- page_sidebar(
|
||||
# title = HEADER_TEXT,
|
||||
# title = config::get("form_name"),
|
||||
title = tagList(
|
||||
h4(HEADER_TEXT, style = "margin-top: .5rem"),
|
||||
tooltip(
|
||||
span("about", icon("circle-info", lib = "font-awesome")),
|
||||
"Данный функционал позволяет обрабатывать информацию о пациентах на комиссию, используя Excel (обновление данных возможно через окно формирования списка пациентов)"
|
||||
h4(config::get("form_name"), style = "margin-top: .5rem"),
|
||||
popover(
|
||||
span(
|
||||
config::get("form_app_version"),
|
||||
fontawesome::fa("circle-info", a11y = "sem", title = "Settings"),
|
||||
style = "color: #9c9c9c"),
|
||||
title = "about",
|
||||
placement = "left",
|
||||
tagList(span("здесь пока ничего нет"), br(), span("вот"))
|
||||
)
|
||||
),
|
||||
theme = bs_theme(version = 5, preset = "bootstrap"),
|
||||
@@ -67,6 +71,7 @@ ui <- page_sidebar(
|
||||
uiOutput("status_message"),
|
||||
textOutput("status_message2"),
|
||||
uiOutput("display_log"),
|
||||
actionButton("tasks-display_task_modal", "Задачи: нет активных", icon("list-check")),
|
||||
position = "left",
|
||||
open = list(mobile = "always")
|
||||
),
|
||||
@@ -75,12 +80,13 @@ ui <- page_sidebar(
|
||||
|
||||
# init auth =======================
|
||||
if (AUTH_ENABLED) {
|
||||
|
||||
# shinymanager::set_labels("en", "Please authenticate" = "scheme()")
|
||||
ui <- ui |>
|
||||
shinymanager::secure_app(
|
||||
status = "primary",
|
||||
tags_top = tags$div(
|
||||
tags$h3(HEADER_TEXT, style = "align:center"),
|
||||
tags$h3(config::get("form_name"), style = "align:center"),
|
||||
# tags$img(
|
||||
# src = "https://www.r-project.org/logo/Rlogo.png", width = 100
|
||||
# )
|
||||
@@ -126,13 +132,14 @@ server <- function(input, output, session) {
|
||||
if (AUTH_ENABLED) {
|
||||
reactiveValuesToList(res_auth)
|
||||
if (res_auth$admin) {
|
||||
# print("admin")
|
||||
} else {
|
||||
# print("not_admin")
|
||||
showing_buttons <- FALSE
|
||||
}
|
||||
}
|
||||
|
||||
# update user name
|
||||
values$current_user <- ifelse(AUTH_ENABLED, res_auth$user, "anonymous")
|
||||
|
||||
if (showing_buttons) {
|
||||
tagList(
|
||||
br(),
|
||||
@@ -146,13 +153,19 @@ server <- function(input, output, session) {
|
||||
}
|
||||
})
|
||||
|
||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
# REACTIVE VALUES =================================
|
||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
# Create a reactive values object to store the input data
|
||||
values <- reactiveValues(
|
||||
data = NULL,
|
||||
tasks_data = NULL,
|
||||
main_key = NULL,
|
||||
nested_key = NULL,
|
||||
nested_form_id = NULL
|
||||
nested_form_id = NULL,
|
||||
tasks_id = NULL,
|
||||
current_user = NULL
|
||||
)
|
||||
|
||||
scheme <- reactiveVal(enabled_schemes[1]) # наименование выбранной схемы
|
||||
@@ -164,20 +177,29 @@ server <- function(input, output, session) {
|
||||
validator_nested <- reactiveVal(NULL)
|
||||
|
||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
# ГЛАВНАЯ СТРАНИЦА ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
# reactive ui -------------------------------
|
||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
## reactive ui -----------------------------------
|
||||
### main screen ------
|
||||
output$main_ui_navset <- renderUI({
|
||||
|
||||
if (main_form_is_empty()) {
|
||||
validator_main(NULL)
|
||||
div(
|
||||
h5("Выбрать базу данных для работы:"),
|
||||
shiny::radioButtons(
|
||||
"schmes_selector",
|
||||
label = strong("Выбрать базу данных для работы:"),
|
||||
label = NULL,
|
||||
choices = enabled_schemes,
|
||||
selected = scheme()
|
||||
),
|
||||
hr(),
|
||||
uiOutput("base_data"),
|
||||
hr(),
|
||||
"Для начала работы нужно создать новую запись или загрузить существующую!",
|
||||
hr(),
|
||||
# сво
|
||||
# загрузка панели для работы с базой данных
|
||||
uiOutput("admin_buttons_panel")
|
||||
)
|
||||
@@ -187,52 +209,70 @@ server <- function(input, output, session) {
|
||||
validator_main(data_validation$init_val(mhcs()$get_scheme("main")))
|
||||
validator_main()$enable()
|
||||
mhcs()$get_main_form_ui
|
||||
|
||||
}
|
||||
})
|
||||
|
||||
### bases info ----------------
|
||||
observeEvent(main_form_is_empty(), {
|
||||
|
||||
output$base_data <- renderUI({
|
||||
|
||||
if (main_form_is_empty() == TRUE) {
|
||||
con <- db$make_db_connection(scheme(),"base_data")
|
||||
on.exit(db$close_db_connection(con, "base_data"), add = TRUE)
|
||||
|
||||
tasks$update_task_button_count(con, values, NS("tasks"))
|
||||
|
||||
# записей в базе всего
|
||||
records_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT ({mhcs()$get_main_key_id}) FROM main")) |>
|
||||
dplyr::pull()
|
||||
|
||||
# задачи на сегодня
|
||||
if ("tasks" %in% DBI::dbListTables(con)) {
|
||||
|
||||
tasks_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM tasks WHERE task_status = 'active'")) |>
|
||||
dplyr::pull()
|
||||
|
||||
tasks_today_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM tasks WHERE task_status = 'active' AND task_due_date = {as.integer(Sys.Date())}")) |>
|
||||
dplyr::pull()
|
||||
|
||||
tasks_overdue_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM tasks WHERE task_status = 'active' AND task_due_date < {as.integer(Sys.Date())}")) |>
|
||||
dplyr::pull()
|
||||
|
||||
} else {
|
||||
|
||||
tasks_count <- 0
|
||||
tasks_today_count <- 0
|
||||
tasks_overdue_count <- 0
|
||||
|
||||
}
|
||||
|
||||
div(
|
||||
h5("Общая информация о базе данных:"),
|
||||
strong("Записей всего:"), records_count,
|
||||
hr(),
|
||||
h5("Задачи:"),
|
||||
span(strong("Активных всего:"), if (tasks_count > 0) actionLink("tasks-show_dt_all", tasks_count) else "0", br()),
|
||||
span(strong("Активных на сегодня:"), if (tasks_today_count > 0) actionLink("tasks-show_dt_today", tasks_today_count) else "0", br()),
|
||||
span(strong("Просроченных:"), if (tasks_overdue_count > 0) actionLink("tasks-show_dt_overdue", tasks_overdue_count) else "0", br())
|
||||
)
|
||||
}
|
||||
})
|
||||
})
|
||||
|
||||
# обновление данных схем ------
|
||||
observeEvent(input$schmes_selector, {
|
||||
|
||||
scheme(input$schmes_selector)
|
||||
mhcs(schms[[input$schmes_selector]])
|
||||
|
||||
})
|
||||
|
||||
# ==========================================
|
||||
# ОБЩИЕ ФУНКЦИИ ============================
|
||||
# ==========================================
|
||||
|
||||
## перенос данных из датафрейма в форму -----------------------
|
||||
load_data_to_form <- function(
|
||||
df,
|
||||
table_name = "main",
|
||||
schm,
|
||||
ns
|
||||
) {
|
||||
|
||||
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
|
||||
# loaded_df_for_id <- as.list(df)
|
||||
# loaded_df_for_id <- df[input_ids]
|
||||
|
||||
# rewrite input forms
|
||||
purrr::walk2(
|
||||
.x = input_types,
|
||||
.y = input_ids,
|
||||
.f = \(x_type, x_id) {
|
||||
|
||||
# updating forms with loaded data
|
||||
utils$update_forms_with_data(
|
||||
form_id = x_id,
|
||||
form_type = x_type,
|
||||
value = df[[x_id]],
|
||||
scheme = mhcs()$get_scheme(table_name),
|
||||
ns = ns
|
||||
)
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
## сохранение данных из форм в базу данных --------
|
||||
save_inputs_to_db <- function(
|
||||
table_name,
|
||||
@@ -309,6 +349,7 @@ server <- function(input, output, session) {
|
||||
# ====================================
|
||||
# NESTED FORMS =======================
|
||||
# ====================================
|
||||
|
||||
## кнопки для каждой вложенной таблицы -------------------------------
|
||||
observe({
|
||||
|
||||
@@ -338,6 +379,7 @@ server <- function(input, output, session) {
|
||||
observers_started(c(
|
||||
isolate(observers_started()), isolate(scheme())
|
||||
))
|
||||
|
||||
})
|
||||
|
||||
## функция отображения вложенной формы для выбранной таблицы --------
|
||||
@@ -362,7 +404,10 @@ server <- function(input, output, session) {
|
||||
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)
|
||||
|
||||
if (length(values$nested_key) == 0) {
|
||||
values$nested_key <- if (length(kyes_for_this_table) == 0) NULL else kyes_for_this_table[[1]]
|
||||
}
|
||||
|
||||
# если ключ в формате даты - дать человекочитаемые данные
|
||||
if (this_nested_form_key_scheme_smoll$form_type == "date") {
|
||||
@@ -374,6 +419,7 @@ server <- function(input, output, session) {
|
||||
|
||||
# nested ui
|
||||
nested_form_panels <- if (!is.null(values$nested_key)) {
|
||||
|
||||
purrr::map(
|
||||
.x = unique(this_nested_form_scheme$subgroup),
|
||||
.f = \(subgroup) {
|
||||
@@ -394,7 +440,9 @@ server <- function(input, output, session) {
|
||||
}
|
||||
)
|
||||
} else {
|
||||
|
||||
list(bslib::nav_panel("", div("Нет доступных записей.", br(), "Необходимо создать новую запись.")))
|
||||
|
||||
}
|
||||
|
||||
# ui для всплывающего окна
|
||||
@@ -459,7 +507,7 @@ server <- function(input, output, session) {
|
||||
output$dt_nested <- DT::renderDataTable(
|
||||
DT::datatable(
|
||||
values$data,
|
||||
caption = 'Table 1: This is a simple caption for the table.',
|
||||
caption = 'В данной таблице можно изменять данные',
|
||||
rownames = FALSE,
|
||||
colnames = col_types |> dplyr::pull(form_id, form_label),
|
||||
extensions = c('KeyTable', "FixedColumns"),
|
||||
@@ -480,7 +528,7 @@ server <- function(input, output, session) {
|
||||
DT::dataTableOutput("dt_nested"),
|
||||
size = "xl",
|
||||
footer = tagList(
|
||||
actionButton("nested_form_dt_save", "сохранить изменения")
|
||||
actionButton("nested_form_dt_save", "Сохранить изменения", icon("floppy-disk"))
|
||||
),
|
||||
easyClose = TRUE
|
||||
))
|
||||
@@ -494,8 +542,9 @@ server <- function(input, output, session) {
|
||||
|
||||
### кнопка: отображение DT -----------------------------
|
||||
observeEvent(input$nested_form_dt_button, {
|
||||
con <- db$make_db_connection(scheme(),"nested_form_save_button")
|
||||
on.exit(db$close_db_connection(con, "nested_form_save_button"), add = TRUE)
|
||||
|
||||
con <- db$make_db_connection(scheme(),"nested_form_dt_button")
|
||||
on.exit(db$close_db_connection(con, "nested_form_dt_button"), add = TRUE)
|
||||
|
||||
removeModal()
|
||||
show_modal_for_nested_form_dt(con)
|
||||
@@ -579,8 +628,8 @@ server <- function(input, output, session) {
|
||||
|
||||
observeEvent(values$nested_key, {
|
||||
|
||||
con <- db$make_db_connection(scheme(),"nested_tables")
|
||||
on.exit(db$close_db_connection(con, "nested_tables"), add = TRUE)
|
||||
con <- db$make_db_connection(scheme(),"nested_key")
|
||||
on.exit(db$close_db_connection(con, "nested_key"), add = TRUE)
|
||||
|
||||
kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, mhcs(), values$main_key, con)
|
||||
|
||||
@@ -596,10 +645,10 @@ server <- function(input, output, session) {
|
||||
)
|
||||
|
||||
# загрузка данных в формы
|
||||
load_data_to_form(
|
||||
forms$load_data_to_form(
|
||||
df = df,
|
||||
table_name = values$nested_form_id,
|
||||
mhcs(),
|
||||
mhcs = mhcs,
|
||||
ns = NS(values$nested_form_id)
|
||||
)
|
||||
} else {
|
||||
@@ -637,8 +686,8 @@ server <- function(input, output, session) {
|
||||
observeEvent(input$confirm_create_new_nested_key, {
|
||||
req(input[[mhcs()$get_key_id(values$nested_form_id)]])
|
||||
|
||||
con <- db$make_db_connection(scheme(),"confirm_create_new_key")
|
||||
on.exit(db$close_db_connection(con, "confirm_create_new_key"), add = TRUE)
|
||||
con <- db$make_db_connection(scheme(),"confirm_create_new_nested_key")
|
||||
on.exit(db$close_db_connection(con, "confirm_create_new_nested_key"), add = TRUE)
|
||||
|
||||
existed_key <- db$get_nested_keys_from_table(
|
||||
table_name = values$nested_form_id,
|
||||
@@ -689,7 +738,9 @@ server <- function(input, output, session) {
|
||||
# =========================================
|
||||
# MAIN BUTTONS LOGIC ======================
|
||||
# =========================================
|
||||
|
||||
## добавить новый главный ключ ------------------------
|
||||
### modal -------
|
||||
observeEvent(input$add_new_main_key_button, {
|
||||
|
||||
# данные для главного ключа
|
||||
@@ -715,7 +766,7 @@ server <- function(input, output, session) {
|
||||
|
||||
})
|
||||
|
||||
## действие при подтверждении (проверка нового создаваемого ключа) -------
|
||||
### подтверждение(проверка нового создаваемого ключа) -------
|
||||
observeEvent(input$confirm_create_new_main_key, {
|
||||
req(input[[mhcs()$get_main_key_id]])
|
||||
|
||||
@@ -723,7 +774,6 @@ server <- function(input, output, session) {
|
||||
on.exit(db$close_db_connection(con, "confirm_create_new_key"), add = TRUE)
|
||||
|
||||
new_main_key <- trimws(input[[mhcs()$get_main_key_id]])
|
||||
|
||||
existed_key <- db$get_keys_from_table("main", mhcs(), con)
|
||||
|
||||
# если введенный ключ уже есть в базе
|
||||
@@ -736,15 +786,12 @@ 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", mhcs())
|
||||
|
||||
removeModal()
|
||||
})
|
||||
|
||||
## очистка всех полей -----------------------
|
||||
# show modal on click of button
|
||||
## переход на главный акран -----------------------
|
||||
### show modal -------
|
||||
observeEvent(input$clean_data_button, {
|
||||
showModal(modalDialog(
|
||||
"Данное действие очистит все заполненные данные. Убедитесь, что нужные данные сохранены.",
|
||||
@@ -757,7 +804,7 @@ server <- function(input, output, session) {
|
||||
))
|
||||
})
|
||||
|
||||
# when action confirm - perform action
|
||||
### when action confirm - perform action ---
|
||||
observeEvent(input$clean_all_action, {
|
||||
|
||||
# rewrite all inputs with empty data
|
||||
@@ -767,6 +814,7 @@ server <- function(input, output, session) {
|
||||
|
||||
removeModal()
|
||||
showNotification("Данные очищены!", type = "warning")
|
||||
|
||||
})
|
||||
|
||||
## сохранение даннных -------------------------------
|
||||
@@ -789,7 +837,8 @@ server <- function(input, output, session) {
|
||||
)
|
||||
})
|
||||
|
||||
## список ключей для загрузки данных -------------------
|
||||
## загрузка данных -------------------
|
||||
### modal with keys -----
|
||||
observeEvent(input$load_data_button, {
|
||||
|
||||
con <- db$make_db_connection(scheme(),"load_data_button")
|
||||
@@ -832,30 +881,51 @@ server <- function(input, output, session) {
|
||||
)
|
||||
})
|
||||
|
||||
## загрузка данных по главному ключу ------------------
|
||||
### confirm ------------------
|
||||
observeEvent(input$load_data, {
|
||||
req(input$load_data_key_selector)
|
||||
|
||||
values$main_key <- input$load_data_key_selector
|
||||
|
||||
})
|
||||
|
||||
## логика: смена ключа -------
|
||||
observeEvent(values$main_key, {
|
||||
|
||||
con <- db$make_db_connection(scheme(),"load_data")
|
||||
on.exit(db$close_db_connection(con, "load_data"), add = TRUE)
|
||||
|
||||
if (!is.null(values$main_key)) {
|
||||
existed_main_keys <- db$get_keys_from_table("main", mhcs(), con)
|
||||
|
||||
if (values$main_key %in% existed_main_keys) {
|
||||
|
||||
df <- db$read_df_from_db_by_id(
|
||||
table_name = "main",
|
||||
schm = mhcs(),
|
||||
main_key_value = input$load_data_key_selector,
|
||||
main_key_value = values$main_key,
|
||||
con = con
|
||||
)
|
||||
|
||||
load_data_to_form(
|
||||
forms$load_data_to_form(
|
||||
df = df,
|
||||
table_name = "main",
|
||||
mhcs()
|
||||
mhcs
|
||||
)
|
||||
|
||||
values$main_key <- input$load_data_key_selector
|
||||
log_action_to_db("loading data", values$main_key, con = con)
|
||||
|
||||
} else {
|
||||
|
||||
utils$clean_forms("main", mhcs())
|
||||
|
||||
}
|
||||
|
||||
main_form_is_empty(FALSE)
|
||||
|
||||
log_action_to_db("loading data", values$main_key, con = con)
|
||||
}
|
||||
|
||||
tasks$update_task_button_count(con, values, NS("tasks"))
|
||||
removeModal()
|
||||
|
||||
})
|
||||
@@ -903,7 +973,7 @@ server <- function(input, output, session) {
|
||||
# добавить мета информацию
|
||||
list_of_df[["meta"]] <- dplyr::tribble(
|
||||
~`Параметр` , ~`Значение`,
|
||||
"Пользователь" , ifelse(AUTH_ENABLED, res_auth$user, "anonymous"),
|
||||
"Пользователь" , values$current_user,
|
||||
"Название базы" , names(enabled_schemes)[enabled_schemes == scheme()],
|
||||
"id базы" , scheme(),
|
||||
"id формы" , config::get("form_id"),
|
||||
@@ -1024,6 +1094,7 @@ server <- function(input, output, session) {
|
||||
)
|
||||
|
||||
## import data from xlsx ----------------------
|
||||
### modal -----
|
||||
observeEvent(input$button_upload_data_from_xlsx, {
|
||||
|
||||
showModal(modalDialog(
|
||||
@@ -1047,6 +1118,7 @@ server <- function(input, output, session) {
|
||||
|
||||
})
|
||||
|
||||
### confirm --------
|
||||
observeEvent(input$button_upload_data_from_xlsx_confirm, {
|
||||
req(input$upload_xlsx)
|
||||
|
||||
@@ -1155,13 +1227,15 @@ server <- function(input, output, session) {
|
||||
append = TRUE
|
||||
)
|
||||
|
||||
message <- glue::glue("Данные таблицы '{table_name}' успешно обновлены (добавлено {nrow(df)} записей)")
|
||||
message <- glue::glue("Данные таблицы '{table_name}' успешно загружены (добавлено {nrow(df)} записей)")
|
||||
showNotification(
|
||||
message,
|
||||
type = "message"
|
||||
)
|
||||
cli::cli_alert_success(message)
|
||||
}
|
||||
|
||||
db$db_clean_orphans(mhcs(), con)
|
||||
log_action_to_db("importing data from xlsx", con = con)
|
||||
removeModal()
|
||||
})
|
||||
@@ -1205,7 +1279,7 @@ server <- function(input, output, session) {
|
||||
|
||||
action_row <- tibble(
|
||||
date = Sys.time(),
|
||||
user = ifelse(AUTH_ENABLED, res_auth$user, "anonymous"),
|
||||
user = values$current_user,
|
||||
app_id = config::get("form_id"),
|
||||
app_ver = config::get("form_app_version"),
|
||||
remote_addr = session$request$REMOTE_ADDR,
|
||||
@@ -1216,58 +1290,9 @@ server <- function(input, output, session) {
|
||||
DBI::dbWriteTable(con, "log", action_row, append = TRUE)
|
||||
}
|
||||
|
||||
# КРАТКАЯ СВОДКА ПРО ЛОГГИНГ ------------------
|
||||
# observe({
|
||||
# TASKS ---------------------------------------
|
||||
tasks$server("tasks", values, scheme, mhcs)
|
||||
|
||||
# output$display_log <- renderUI({
|
||||
|
||||
# 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)) {
|
||||
# sprintf("SELECT * FROM log WHERE key = '%s'", values$main_key)
|
||||
# } else {
|
||||
# "SELECT * FROM log"
|
||||
# }
|
||||
|
||||
# log_rows <- DBI::dbGetQuery(con, query)
|
||||
|
||||
# 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(
|
||||
# "<b>[%s %s]</b>: %s - %s (%s)",
|
||||
# format(date, "%d.%m.%y"),
|
||||
# format(date, "%H:%M"),
|
||||
# user,
|
||||
# action,
|
||||
# n_actions
|
||||
# )) |>
|
||||
# pull(string_to_print) |>
|
||||
# paste(collapse = "</br>")
|
||||
|
||||
# } else {
|
||||
# lines <- ""
|
||||
# }
|
||||
|
||||
# tagList(
|
||||
# paste0("ID: ", values$main_key),
|
||||
# br(),
|
||||
# p(
|
||||
# HTML(lines),
|
||||
# style = "font-size:10px;"
|
||||
# )
|
||||
# )
|
||||
# })
|
||||
# })
|
||||
}
|
||||
|
||||
|
||||
|
||||
34
app/forms.R
Normal file
34
app/forms.R
Normal file
@@ -0,0 +1,34 @@
|
||||
options(box.path = here::here())
|
||||
box::use(
|
||||
modules/utils,
|
||||
)
|
||||
|
||||
#' @export
|
||||
load_data_to_form <- function(
|
||||
df,
|
||||
table_name = "main",
|
||||
mhcs,
|
||||
ns
|
||||
) {
|
||||
|
||||
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
|
||||
|
||||
# rewrite input forms
|
||||
purrr::walk2(
|
||||
.x = input_types,
|
||||
.y = input_ids,
|
||||
.f = \(x_type, x_id) {
|
||||
|
||||
# updating forms with loaded data
|
||||
utils$update_forms_with_data(
|
||||
form_id = x_id,
|
||||
form_type = x_type,
|
||||
value = df[[x_id]],
|
||||
scheme = mhcs()$get_scheme(table_name),
|
||||
ns = ns
|
||||
)
|
||||
}
|
||||
)
|
||||
}
|
||||
466
app/tasks.R
Normal file
466
app/tasks.R
Normal file
@@ -0,0 +1,466 @@
|
||||
|
||||
box::use(
|
||||
shiny[...],
|
||||
bslib[...]
|
||||
)
|
||||
|
||||
options(box.path = here::here())
|
||||
box::use(
|
||||
modules/db,
|
||||
modules/utils,
|
||||
app/forms
|
||||
)
|
||||
|
||||
#' @export
|
||||
server <- function(id, values, scheme, mhcs) {
|
||||
|
||||
ns <- NS(id)
|
||||
|
||||
moduleServer(id, function(input, output, session) {
|
||||
|
||||
# BOOKMARKS SETUP ========================
|
||||
# observe({
|
||||
# # print(values$current_user)
|
||||
# })
|
||||
|
||||
# functions -------------------
|
||||
## new tasks ----------------
|
||||
get_default_task <- function() {
|
||||
|
||||
tibble::tibble(
|
||||
task_id = paste0(format(Sys.time(), "%Y%m%d%H%M%S"), "_", values$main_key),
|
||||
task_main_key = values$main_key,
|
||||
task_status = "active",
|
||||
task_title = "НОВАЯ ЗАДАЧА",
|
||||
task_description = "",
|
||||
task_due_date = NA,
|
||||
task_user_created = values$current_user,
|
||||
task_datetime_created = Sys.time(),
|
||||
task_user_last_updated = NA,
|
||||
task_datetime_last_updated = NA,
|
||||
task_user_completed = NA,
|
||||
task_datetime_completed = NA
|
||||
)
|
||||
}
|
||||
|
||||
# logic ---------------------
|
||||
## modal fun -----
|
||||
show_modal_for_tasks <- function() {
|
||||
|
||||
if (!is.null(values$tasks_data)) {
|
||||
|
||||
tasks_selector <- values$tasks_data |>
|
||||
dplyr::filter(task_status != "completed") |>
|
||||
dplyr::pull(task_id)
|
||||
|
||||
tasks_selector <- unique(c(values$tasks_id, tasks_selector))
|
||||
tasks_selector <- sort(tasks_selector)
|
||||
|
||||
if (length(values$tasks_id) == 0) {
|
||||
values$tasks_id <- if (length(tasks_selector) == 0) NULL else tasks_selector[[1]]
|
||||
}
|
||||
|
||||
} else {
|
||||
|
||||
tasks_selector <- NULL
|
||||
|
||||
}
|
||||
|
||||
# ui --------------------
|
||||
# очень большой костыль
|
||||
subroup_scheme <- mhcs()$get_scheme("tasks") |>
|
||||
dplyr::filter(form_id != "dummy")
|
||||
|
||||
tab <- if (length(tasks_selector) > 0) {
|
||||
bslib::nav_panel(
|
||||
title = "no name provided",
|
||||
purrr::pmap(
|
||||
.l = dplyr::distinct(subroup_scheme, form_id, form_label, form_type),
|
||||
.f = utils$render_forms,
|
||||
main_scheme = subroup_scheme,
|
||||
ns = ns
|
||||
)
|
||||
)
|
||||
} else {
|
||||
bslib::nav_panel("", div("Нет доступных записей.", br(), "Необходимо создать новую запись."))
|
||||
}
|
||||
|
||||
ui <- layout_sidebar(
|
||||
sidebar = tagList(
|
||||
selectizeInput(ns("tasks_id_selector"), label = "ID задачи:", choices = tasks_selector, selected = values$tasks_id),
|
||||
actionButton(ns("tasks_create_new_task"), "Новая задача", icon("plus")),
|
||||
actionButton(ns("tasks_add_autoreview"), "Новая авто-задача (тест)", icon("calendar")),
|
||||
actionButton(ns("tasks_DT_VIEW"), "DT", icon("table"))
|
||||
),
|
||||
tab
|
||||
)
|
||||
|
||||
showModal(modalDialog(
|
||||
ui,
|
||||
size = "l",
|
||||
footer = tagList(
|
||||
actionButton(ns("tasks_saving_button"), "Сохранить изменения", icon("floppy-disk"))
|
||||
),
|
||||
easyClose = TRUE
|
||||
))
|
||||
}
|
||||
|
||||
## отображение окна -----------------
|
||||
observeEvent(input$display_task_modal, {
|
||||
|
||||
if (is.null(values$main_key)) {
|
||||
showNotification("необходимо выбрать запись", type = "error")
|
||||
return()
|
||||
}
|
||||
|
||||
con <- db$make_db_connection(scheme(),"display_task_modal")
|
||||
on.exit(db$close_db_connection(con, "display_task_modal"), add = TRUE)
|
||||
|
||||
values$tasks_data <- if ("tasks" %in% DBI::dbListTables(con)) {
|
||||
DBI::dbGetQuery(con, glue::glue("SELECT * FROM tasks WHERE task_main_key = '{values$main_key}'")) |>
|
||||
dplyr::mutate(dplyr::across(c("task_datetime_created", "task_datetime_last_updated", "task_datetime_completed"), as.POSIXct)) |>
|
||||
dplyr::mutate(dplyr::across(c("task_due_date"), as.Date))
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
|
||||
values$tasks_id <- NULL
|
||||
show_modal_for_tasks()
|
||||
|
||||
})
|
||||
|
||||
## изменение выбранной задачи -------
|
||||
observeEvent(input$tasks_id_selector, {
|
||||
req(input$tasks_id_selector)
|
||||
req(values$tasks_id)
|
||||
|
||||
# выбранный ключ в форме - перемещаем в RV
|
||||
values$tasks_id <- input$tasks_id_selector
|
||||
|
||||
})
|
||||
|
||||
## обновление формы при измененнии id ключа ------
|
||||
observeEvent(values$tasks_id, {
|
||||
|
||||
df <- values$tasks_data |>
|
||||
dplyr::filter(task_id == values$tasks_id)
|
||||
|
||||
forms$load_data_to_form(
|
||||
df = df,
|
||||
table_name = "tasks",
|
||||
mhcs
|
||||
# ns = ns
|
||||
)
|
||||
})
|
||||
|
||||
## saving button ------------------------------
|
||||
observeEvent(input$tasks_saving_button, {
|
||||
|
||||
con <- db$make_db_connection(scheme(),"tasks_saving_button")
|
||||
on.exit(db$close_db_connection(con, "tasks_saving_button"), add = TRUE)
|
||||
|
||||
id_and_types_list <- mhcs()$get_id_type_list("tasks")
|
||||
input_types <- unname(id_and_types_list)
|
||||
input_ids <- names(id_and_types_list)
|
||||
|
||||
exported_values <- purrr::map2(
|
||||
.x = input_ids,
|
||||
.y = input_types,
|
||||
.f = \(x_id, x_type) {
|
||||
|
||||
input_d <- input[[x_id]]
|
||||
|
||||
# return empty if 0 element
|
||||
if (length(input_d) == 0) {
|
||||
return(utils$get_empty_data(x_type))
|
||||
} else {
|
||||
input_d
|
||||
}
|
||||
}
|
||||
)
|
||||
|
||||
exported_df <- stats::setNames(exported_values, input_ids) |>
|
||||
dplyr::as_tibble()
|
||||
|
||||
df <- values$tasks_data
|
||||
|
||||
df[df$task_id == values$tasks_id,]$task_status <- exported_df$task_status
|
||||
df[df$task_id == values$tasks_id,]$task_title <- exported_df$task_title
|
||||
df[df$task_id == values$tasks_id,]$task_description <- exported_df$task_description
|
||||
df[df$task_id == values$tasks_id,]$task_due_date <- exported_df$task_due_date
|
||||
df[df$task_id == values$tasks_id,]$task_user_last_updated <- values$current_user
|
||||
df[df$task_id == values$tasks_id,]$task_datetime_last_updated <- Sys.time()
|
||||
|
||||
if (exported_df$task_status == "completed") {
|
||||
df[df$task_id == values$tasks_id,]$task_user_completed <- values$current_user
|
||||
df[df$task_id == values$tasks_id,]$task_datetime_completed <- Sys.time()
|
||||
}
|
||||
|
||||
values$tasks_data <- df
|
||||
|
||||
if ("tasks" %in% DBI::dbListTables(con)) {
|
||||
query <- glue::glue("
|
||||
DELETE
|
||||
FROM tasks
|
||||
WHERE task_main_key = '{values$main_key}'
|
||||
")
|
||||
DBI::dbExecute(con, query)
|
||||
}
|
||||
|
||||
DBI::dbWriteTable(con, "tasks", df, append = TRUE)
|
||||
|
||||
update_task_button_count(con, values)
|
||||
showNotification("Задача успешно создана/обновлена", type = "message")
|
||||
|
||||
tasks_selector <- values$tasks_data |>
|
||||
dplyr::filter(task_status != "completed") |>
|
||||
dplyr::pull(task_id)
|
||||
|
||||
selector <- ifelse(!values$tasks_id %in% tasks_selector, tasks_selector[1], values$tasks_id)
|
||||
|
||||
updateSelectInput(inputId = "tasks_id_selector", choices = tasks_selector, selected = selector)
|
||||
|
||||
})
|
||||
|
||||
## show DT --------------------------
|
||||
observeEvent(input$tasks_DT_VIEW, {
|
||||
|
||||
rename_cols <- tasks_colnames[tasks_colnames %in% colnames(values$tasks_data)]
|
||||
|
||||
date_cols <- c("task_datetime_created", "task_datetime_completed", "task_datetime_last_updated", "task_due_date")
|
||||
date_cols <- which(colnames(values$tasks_data) %in% date_cols)
|
||||
|
||||
output$dt_tasks <- DT::renderDataTable(
|
||||
DT::datatable(
|
||||
values$tasks_data,
|
||||
caption = 'Table 1: This is a simple caption for the table.',
|
||||
rownames = FALSE,
|
||||
colnames = rename_cols,
|
||||
extensions = c('KeyTable', "FixedColumns"),
|
||||
# editable = 'cell',
|
||||
class = 'cell-border stripe',
|
||||
selection = "none",
|
||||
options = list(
|
||||
dom = 'tip',
|
||||
scrollX = TRUE,
|
||||
fixedColumns = list(leftColumns = 1),
|
||||
keys = TRUE,
|
||||
autoWidth = TRUE,
|
||||
columnDefs = list(
|
||||
list(
|
||||
targets = 3:4,
|
||||
width = '200px',
|
||||
render = htmlwidgets::JS(
|
||||
"function(data, type, row, meta) {",
|
||||
"return type === 'display' && data.length > 20 ?",
|
||||
"'<span title=\"' + data + '\">' + data.substr(0, 20) + '...</span>' : data;",
|
||||
"}")
|
||||
)
|
||||
)
|
||||
)
|
||||
) |>
|
||||
DT::formatDate(date_cols, "toLocaleDateString", params = list('ru-RU'))
|
||||
)
|
||||
|
||||
showModal(modalDialog(
|
||||
DT::dataTableOutput(ns("dt_tasks")),
|
||||
size = "xl",
|
||||
# footer = tagList(
|
||||
# actionButton("nested_form_dt_save", "сохранить изменения")
|
||||
# ),
|
||||
easyClose = TRUE
|
||||
))
|
||||
|
||||
})
|
||||
|
||||
## создание новой задачи -------------
|
||||
observeEvent(input$tasks_create_new_task, {
|
||||
new_task <- get_default_task()
|
||||
|
||||
values$tasks_data <- rbind(values$tasks_data, new_task)
|
||||
values$tasks_id <- new_task$task_id
|
||||
|
||||
tasks_selector <- values$tasks_data |>
|
||||
dplyr::filter(task_status != "completed") |>
|
||||
dplyr::pull(task_id)
|
||||
|
||||
updateSelectInput(inputId = "tasks_id_selector", choices = tasks_selector, selected = values$tasks_id)
|
||||
removeModal()
|
||||
show_modal_for_tasks()
|
||||
})
|
||||
|
||||
## создание новой авто-задачи -------------
|
||||
observeEvent(input$tasks_add_autoreview, {
|
||||
new_task <- get_default_task()
|
||||
|
||||
new_task$task_title <- "autoreview"
|
||||
new_task$task_description <- "напоминание об актуализации данных"
|
||||
new_task$task_due_date <- Sys.Date() + 28
|
||||
|
||||
values$tasks_data <- rbind(values$tasks_data, new_task)
|
||||
values$tasks_id <- new_task$task_id
|
||||
|
||||
tasks_selector <- values$tasks_data |>
|
||||
dplyr::filter(task_status != "completed") |>
|
||||
dplyr::pull(task_id)
|
||||
|
||||
updateSelectInput(inputId = "tasks_id_selector", choices = tasks_selector, selected = values$tasks_id)
|
||||
removeModal()
|
||||
show_modal_for_tasks()
|
||||
})
|
||||
|
||||
# review задач ----------------
|
||||
### все активные задачи ------------
|
||||
observeEvent(input$show_dt_all, {
|
||||
|
||||
con <- db$make_db_connection(scheme(),"display_task_modal")
|
||||
on.exit(db$close_db_connection(con, "display_task_modal"), add = TRUE)
|
||||
|
||||
values$tasks_data <- DBI::dbGetQuery(con, glue::glue("SELECT * FROM tasks WHERE task_status = 'active'")) |>
|
||||
dplyr::mutate(dplyr::across(c("task_datetime_created", "task_datetime_last_updated", "task_datetime_completed"), as.POSIXct)) |>
|
||||
dplyr::mutate(dplyr::across(c("task_due_date"), as.Date))
|
||||
|
||||
display_tasks_dt_review()
|
||||
})
|
||||
|
||||
### задачи для текущего дня ------------
|
||||
observeEvent(input$show_dt_today, {
|
||||
|
||||
con <- db$make_db_connection(scheme(),"display_task_modal")
|
||||
on.exit(db$close_db_connection(con, "display_task_modal"), add = TRUE)
|
||||
|
||||
values$tasks_data <- DBI::dbGetQuery(con, glue::glue("SELECT * FROM tasks WHERE task_status = 'active' AND task_due_date = {as.integer(Sys.Date())}")) |>
|
||||
dplyr::mutate(dplyr::across(c("task_datetime_created", "task_datetime_last_updated", "task_datetime_completed"), as.POSIXct)) |>
|
||||
dplyr::mutate(dplyr::across(c("task_due_date"), as.Date))
|
||||
|
||||
display_tasks_dt_review()
|
||||
})
|
||||
|
||||
### просроченные ------------
|
||||
observeEvent(input$show_dt_overdue, {
|
||||
|
||||
con <- db$make_db_connection(scheme(),"display_task_modal")
|
||||
on.exit(db$close_db_connection(con, "display_task_modal"), add = TRUE)
|
||||
|
||||
values$tasks_data <- DBI::dbGetQuery(con, glue::glue("SELECT * FROM tasks WHERE task_status = 'active' AND task_due_date < {as.integer(Sys.Date())}")) |>
|
||||
dplyr::mutate(dplyr::across(c("task_datetime_created", "task_datetime_last_updated", "task_datetime_completed"), as.POSIXct)) |>
|
||||
dplyr::mutate(dplyr::across(c("task_due_date"), as.Date))
|
||||
|
||||
display_tasks_dt_review()
|
||||
})
|
||||
|
||||
### modal -----
|
||||
display_tasks_dt_review <- function() {
|
||||
|
||||
values$tasks_data <- values$tasks_data |>
|
||||
dplyr::select(task_id:task_datetime_last_updated)
|
||||
|
||||
rename_cols <- tasks_colnames[tasks_colnames %in% colnames(values$tasks_data)]
|
||||
|
||||
date_cols <- c("task_datetime_created", "task_datetime_completed", "task_datetime_last_updated", "task_due_date")
|
||||
date_cols <- which(colnames(values$tasks_data) %in% date_cols)
|
||||
|
||||
output$dt_todays_tasks <- DT::renderDataTable(
|
||||
DT::datatable(
|
||||
values$tasks_data,
|
||||
caption = 'Table 1: This is a simple caption for the table.',
|
||||
rownames = FALSE,
|
||||
colnames = rename_cols,
|
||||
extensions = c("FixedColumns"),
|
||||
# editable = 'cell',
|
||||
selection = "single",
|
||||
options = list(
|
||||
dom = 'tip',
|
||||
scrollX = TRUE,
|
||||
fixedColumns = list(leftColumns = 1),
|
||||
autoWidth = TRUE,
|
||||
columnDefs = list(
|
||||
list(
|
||||
targets = 3:4,
|
||||
width = '200px',
|
||||
render = htmlwidgets::JS(
|
||||
"function(data, type, row, meta) {",
|
||||
"return type === 'display' && data.length > 20 ?",
|
||||
"'<span title=\"' + data + '\">' + data.substr(0, 20) + '...</span>' : data;",
|
||||
"}")
|
||||
)
|
||||
)
|
||||
)
|
||||
) |>
|
||||
DT::formatDate(date_cols, "toLocaleDateString", params = list('ru-RU'))
|
||||
)
|
||||
|
||||
showModal(modalDialog(
|
||||
DT::dataTableOutput(ns("dt_todays_tasks")),
|
||||
size = "xl",
|
||||
footer = tagList(
|
||||
actionButton(ns("jump_to_main_key"), "перейти к id", icon("right-to-bracket"))
|
||||
),
|
||||
easyClose = TRUE
|
||||
))
|
||||
|
||||
}
|
||||
|
||||
### jump to main_key ---------
|
||||
observeEvent(input$jump_to_main_key, {
|
||||
|
||||
if (is.null(input$dt_todays_tasks_rows_selected)) {
|
||||
showNotification("необходимо выбрать задачу", type = "error")
|
||||
} else {
|
||||
|
||||
# get key
|
||||
main_key_to_jump <- values$tasks_data[input$dt_todays_tasks_rows_selected,]$task_main_key
|
||||
values$main_key <- main_key_to_jump
|
||||
|
||||
removeModal()
|
||||
|
||||
}
|
||||
})
|
||||
|
||||
})
|
||||
}
|
||||
|
||||
#' @export
|
||||
update_task_button_count <- function(con, values, ns) {
|
||||
|
||||
inputID <- "display_task_modal"
|
||||
if (!missing(ns)) inputID <- ns(inputID)
|
||||
|
||||
|
||||
# если ключ не определен - выход из функции
|
||||
if (is.null(values$main_key)) {
|
||||
|
||||
updateActionButton(inputId = inputID, label = "Задачи")
|
||||
return()
|
||||
|
||||
}
|
||||
|
||||
# при наличии таблицы - полу
|
||||
if ("tasks" %in% DBI::dbListTables(con)) {
|
||||
|
||||
tasks_num <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT ('task_id') FROM tasks WHERE task_main_key = '{values$main_key}' AND task_status = 'active'")) |>
|
||||
dplyr::pull()
|
||||
|
||||
if (tasks_num > 0) {
|
||||
updateActionButton(inputId = inputID, label = paste("активных задач:", tasks_num))
|
||||
} else {
|
||||
updateActionButton(inputId = inputID, label = "Задачи: нет активных")
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
tasks_colnames <- c(
|
||||
"id задачи" = "task_id",
|
||||
"id записи" = "task_main_key",
|
||||
"статус" = "task_status",
|
||||
"задача" = "task_title",
|
||||
"описание" = "task_description",
|
||||
"срок выполнения" = "task_due_date",
|
||||
"создана" = "task_user_created",
|
||||
"дата создания" = "task_datetime_created",
|
||||
"обновлено" = "task_user_last_updated",
|
||||
"дата обновления" = "task_datetime_last_updated",
|
||||
"завершено" = "task_user_completed",
|
||||
"дата выполнения" = "task_datetime_completed"
|
||||
)
|
||||
11
config.yml
11
config.yml
@@ -5,9 +5,16 @@ default:
|
||||
|
||||
prod:
|
||||
form_app_configure_path: "."
|
||||
form_auth_enabled: true
|
||||
form_auth_enabled: false
|
||||
form_schemes:
|
||||
example_of_scheme: Тестовая база данных
|
||||
main_register: АВЗ и АМИЛОИОДОЗЫ
|
||||
|
||||
devel:
|
||||
form_app_configure_path: _devel/d2tra
|
||||
form_app_configure_path: _devel/new_bases
|
||||
form_auth_enabled: false
|
||||
form_app_version: 0.16.0 dev
|
||||
form_schemes:
|
||||
antifib: антифибротическая
|
||||
d2tra_t: D2TRA_test
|
||||
|
||||
@@ -1,4 +0,0 @@
|
||||
#' @export
|
||||
enabled_schemes <- c(
|
||||
`Тестовая база данных` = "example_of_scheme"
|
||||
)
|
||||
@@ -71,6 +71,7 @@ val_is_a_number = function(x) {
|
||||
|
||||
# exit if empty
|
||||
if (is_this_empty_value(x)) return(NULL)
|
||||
|
||||
# хак для пропуска значений
|
||||
if (x == "NA") return(NULL)
|
||||
|
||||
|
||||
83
modules/db.R
83
modules/db.R
@@ -3,7 +3,7 @@
|
||||
#' @description Function to open connection to db, disigned to easy dubugging.
|
||||
#' @param where text mark to distingiush calss
|
||||
make_db_connection = function(scheme, where = "") {
|
||||
if (getOption("APP.DEBUG", FALSE)) message("=== DB CONNECT ", where)
|
||||
|
||||
DBI::dbConnect(RSQLite::SQLite(), fs::path(
|
||||
config::get("form_app_configure_path"),
|
||||
"db",
|
||||
@@ -46,14 +46,13 @@ check_if_table_is_exist_and_init_if_not = function(
|
||||
|
||||
if (table_name %in% DBI::dbListTables(con)) {
|
||||
|
||||
cli::cli_inform(c("*" = "проверка таблицы в базе данных: '{table_name}'"))
|
||||
|
||||
# если таблица существует, производим проверку структуры таблицы
|
||||
compare_existing_table_with_schema(
|
||||
table_name = table_name,
|
||||
schm = schm
|
||||
)
|
||||
|
||||
# инициализируем все таблицы
|
||||
} else {
|
||||
|
||||
if (table_name == "main") {
|
||||
@@ -63,6 +62,7 @@ check_if_table_is_exist_and_init_if_not = function(
|
||||
.before = 1
|
||||
)
|
||||
}
|
||||
|
||||
if (table_name != "main") {
|
||||
dummy_df <- get_dummy_df(forms_id_type_list) |>
|
||||
dplyr::mutate(
|
||||
@@ -121,6 +121,8 @@ compare_existing_table_with_schema = function(
|
||||
con = rlang::env_get(rlang::caller_env(), nm = "con")
|
||||
) {
|
||||
|
||||
cli::cli_progress_step("проверка таблицы в базе данных: '{table_name}'")
|
||||
|
||||
main_key <- schm$get_main_key_id
|
||||
key_id <- schm$get_key_id(table_name)
|
||||
forms_ids <- schm$get_forms_ids(table_name)
|
||||
@@ -364,7 +366,6 @@ local_db_backup <- function(
|
||||
.y = names(schedule),
|
||||
.f = \(schedule_days, schedule_name) {
|
||||
|
||||
# daily
|
||||
daily_folder <- fs::path(backup_folder, schedule_name)
|
||||
todays_backup <- fs::path(daily_folder, paste0(db_name, "_", format(Sys.time(), "%Y%m%d")), ext = "sqlite")
|
||||
|
||||
@@ -382,25 +383,81 @@ local_db_backup <- function(
|
||||
dates <- stringr::str_extract(existed_files, "((?:19|20)\\d\\d)(0?[1-9]|1[012])([12][0-9]|3[01]|0?[1-9])")
|
||||
dates <- as.Date(dates, "%Y%m%d")
|
||||
|
||||
# если количество существующих бэкапов значимо превышает установленный лимит, удаляем лишнее
|
||||
if (length(existed_files) > backups_limit) {
|
||||
if (length(existed_files) == 0) {
|
||||
file.copy(db_full_path, todays_backup)
|
||||
cli::cli_alert_success("создан {schedule_name}-бэкап для '{db_name}'")
|
||||
return()
|
||||
}
|
||||
|
||||
# если количество существующих бэкапов превышает установленный лимит, удаляем лишнее
|
||||
if (length(existed_files) >= backups_limit) {
|
||||
file.remove(utils::tail(existed_files, length(existed_files) - backups_limit))
|
||||
}
|
||||
|
||||
# если количество существующих бэкапов равно имеющемуся и пора делать бэкап - делаем бэкап, удаляем послендий файл
|
||||
if (length(existed_files) >= backups_limit & dates[1] + schedule_days == Sys.Date()) {
|
||||
|
||||
file.remove(utils::tail(existed_files, 1))
|
||||
file.copy(db_full_path, todays_backup)
|
||||
|
||||
} else if(length(existed_files) == 0) {
|
||||
if (dates[1] + schedule_days == Sys.Date()) {
|
||||
|
||||
file.copy(db_full_path, todays_backup)
|
||||
cli::cli_alert_success("создан {schedule_name}-бэкап для '{db_name}'")
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
#' @export
|
||||
db_clean_orphans = function(schm, con) {
|
||||
|
||||
main_key <- schm$get_main_key_id
|
||||
nested_tables <- schm$nested_tables_names
|
||||
|
||||
all_main_keys <- DBI::dbGetQuery(con, glue::glue("SELECT DISTINCT {main_key} FROM main"))
|
||||
all_main_keys <- dplyr::pull(all_main_keys)
|
||||
|
||||
purrr::walk(
|
||||
.x = nested_tables,
|
||||
.f = \(table_name) clear_orphans(table_name = table_name, main_key = main_key, all_main_keys = all_main_keys, con = con)
|
||||
)
|
||||
|
||||
clear_orphans(table_name = "tasks", main_key = "task_main_key", all_main_keys = all_main_keys, con = con, drop_na_keys = FALSE)
|
||||
clear_orphans(table_name = "log", main_key = "key", all_main_keys = all_main_keys, con = con, drop_na_keys = FALSE)
|
||||
|
||||
}
|
||||
|
||||
clear_orphans <- function(
|
||||
table_name,
|
||||
main_key,
|
||||
all_main_keys,
|
||||
con,
|
||||
drop_na_keys = TRUE
|
||||
) {
|
||||
|
||||
if (!table_name %in% DBI::dbListTables(con)) return(invisible())
|
||||
|
||||
all_main_keys_from_nested <- DBI::dbGetQuery(con, glue::glue("SELECT DISTINCT {main_key} FROM {table_name}"))
|
||||
all_main_keys_from_nested <- dplyr::pull(all_main_keys_from_nested)
|
||||
|
||||
if (!drop_na_keys) {
|
||||
all_main_keys_from_nested <- all_main_keys_from_nested[!is.na(all_main_keys_from_nested)]
|
||||
}
|
||||
|
||||
if (all(all_main_keys_from_nested %in% all_main_keys)) {
|
||||
cli::cli_alert_success("Все ключи в таблице '{table_name}' соответствуют действующим")
|
||||
} else {
|
||||
|
||||
orphaned_keys <- all_main_keys_from_nested[!all_main_keys_from_nested %in% all_main_keys]
|
||||
cli::cli_alert_warning(c("В таблице '{table_name}' найдены орфанные записи для следующих ID: ", paste("\n -", orphaned_keys)))
|
||||
|
||||
orphaned_keys <- paste0("'", orphaned_keys, "'", collapse = ", ")
|
||||
del_query <- glue::glue("DELETE FROM {table_name} WHERE {main_key} IN ({orphaned_keys})")
|
||||
deleted <- DBI::dbExecute(con, del_query)
|
||||
|
||||
if (drop_na_keys) {
|
||||
deleted <- deleted + DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE {main_key} IS NULL"))
|
||||
}
|
||||
|
||||
cli::cli_alert_success("Из таблицы '{table_name}' было удалено {deleted} орфанных записей")
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
@@ -43,17 +43,14 @@ check_and_init_scheme = function() {
|
||||
options(box.path = here::here())
|
||||
box::use(modules/db[local_db_backup])
|
||||
|
||||
options(box.path = config::get("form_app_configure_path"))
|
||||
box::use(configs/enabled_schemes[enabled_schemes])
|
||||
|
||||
# список файлов, изменение которых, приведут к переинициализиации схемы
|
||||
files_to_watch <- c(
|
||||
fs::path(config::get("form_app_configure_path"), "configs", "enabled_schemes.R"),
|
||||
"config.yml",
|
||||
"modules/scheme_generator.R",
|
||||
"modules/utils.R"
|
||||
)
|
||||
|
||||
scheme_names <- enabled_schemes
|
||||
scheme_names <- names(config::get()$form_schemes)
|
||||
scheme_file <- paste0(config::get("form_app_configure_path"), "/configs/schemas/", scheme_names, ".xlsx")
|
||||
scheme_file <- stats::setNames(scheme_file, scheme_names)
|
||||
|
||||
@@ -113,6 +110,7 @@ init_scheme = function(scheme_file) {
|
||||
if (!dir.exists(db_path)) dir.create(db_path)
|
||||
|
||||
cli::cli_h1("Инициализация схемы")
|
||||
|
||||
schms <- purrr::map2(
|
||||
.x = scheme_file,
|
||||
.y = names(scheme_file),
|
||||
@@ -121,8 +119,15 @@ init_scheme = function(scheme_file) {
|
||||
con <- db$make_db_connection(y)
|
||||
on.exit(db$close_db_connection(con), add = TRUE)
|
||||
|
||||
# новый объект
|
||||
schm <- scheme_R6$new(x)
|
||||
|
||||
# проверка схемы с существующей базой данных и инициализация таблиц
|
||||
db$check_if_table_is_exist_and_init_if_not(schm, con)
|
||||
|
||||
# удаление орфанных записей
|
||||
|
||||
db$db_clean_orphans(schm = schm, con = con)
|
||||
schm
|
||||
}
|
||||
)
|
||||
@@ -132,13 +137,13 @@ init_scheme = function(scheme_file) {
|
||||
names(schms),
|
||||
\(x) schms[[x]]$nested_tables_names
|
||||
)
|
||||
|
||||
nested_tables_ids <- unlist(nested_tables_ids)
|
||||
tab <- table(nested_tables_ids)
|
||||
|
||||
# если встречается хоть одно значение несколько раз - начать истошно кричать (могут возникнуть пробемы при вызове всплывающих окон в формах)
|
||||
if (!all(!tab > 1)) {
|
||||
cli::cli_abort(c("В одной или нескольких схемах наименования вложенных форм совпадают:", paste("-", names(tab)[tab > 1])))
|
||||
|
||||
}
|
||||
|
||||
saveRDS(schms, "scheme.rds")
|
||||
|
||||
@@ -40,6 +40,19 @@ scheme_R6 <- R6::R6Class(
|
||||
}
|
||||
)
|
||||
|
||||
# отдельно для тасков
|
||||
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")
|
||||
|
||||
@@ -78,6 +91,7 @@ scheme_R6 <- R6::R6Class(
|
||||
get_scheme = function(table_name) {
|
||||
private$schemes_list[[table_name]]
|
||||
},
|
||||
|
||||
## с полями имеющие значение -------
|
||||
get_scheme_with_values_forms = function(table_name) {
|
||||
private$schemes_list[[table_name]] |>
|
||||
@@ -117,7 +131,7 @@ scheme_R6 <- R6::R6Class(
|
||||
nested_forms_names = NA,
|
||||
bslib_rendered_ui = NA,
|
||||
excluded_types = c("nested_forms", "description", "description_header"),
|
||||
reserved_table_names = c("meta", "log", "main"),
|
||||
reserved_table_names = c("meta", "log", "main", "tasks"),
|
||||
|
||||
load_scheme_from_xlsx = function(sheet_name) {
|
||||
|
||||
|
||||
@@ -135,7 +135,8 @@ render_forms = function(
|
||||
form <- shiny::textAreaInput(
|
||||
inputId = form_id,
|
||||
label = label,
|
||||
rows = 1
|
||||
rows = 1,
|
||||
resize = "none"
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user