devel #1

Merged
madeliri merged 11 commits from devel into main 2026-04-24 16:00:04 +03:00
8 changed files with 69 additions and 62 deletions
Showing only changes of commit 87444b5718 - Show all commits

75
app.R
View File

@@ -16,40 +16,35 @@ box::use(
modules/global_options, modules/global_options,
modules/db, modules/db,
modules/data_validation, modules/data_validation,
modules/scheme_generator[scheme_R6] app/forms,
app/tasks
) )
# global settings:
global_options$set_global_options( global_options$set_global_options(
shiny.host = "0.0.0.0" shiny.host = "0.0.0.0",
# APP.DEBUG = TRUE APP.DEBUG = FALSE
) )
# init:
global_options$check_and_init_scheme() global_options$check_and_init_scheme()
# global vars # global vars:
box::use( box::use(
modules/global_options[AUTH_ENABLED] modules/global_options[AUTH_ENABLED]
) )
enabled_schemes <- unlist(config::get()$form_schemes)
enabled_schemes <- setNames(names(enabled_schemes), enabled_schemes)
# MODULES # load schemes object:
box::use(app/forms) schms <- readRDS("scheme.rds")
box::use(app/tasks)
# refactor LATER --------- # CHECK FOR PANDOC ----------
vv <- unlist(config::get()$form_schemes)
enabled_schemes <- names(vv)
vvvv <- unname(vv)
names(enabled_schemes) <- vvvv
# ------------------------
# CHECK FOR PANDOC
# TEMP ! NEED TO HANDLE
rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/") rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/")
# TODO: dynamic button render depend on pandoc installation # TODO: dynamic button render depend on pandoc installation
if (!rmarkdown::pandoc_available()) warning("Can't find pandoc!") if (!rmarkdown::pandoc_available()) warning("Can't find pandoc!")
# SCHEME_MAIN UNPACK ==========================
schms <- readRDS("scheme.rds")
# UI ======================= # UI =======================
ui <- page_sidebar( ui <- page_sidebar(
@@ -76,7 +71,7 @@ ui <- page_sidebar(
uiOutput("status_message"), uiOutput("status_message"),
textOutput("status_message2"), textOutput("status_message2"),
uiOutput("display_log"), uiOutput("display_log"),
actionButton("tasks-display_task_modal", "Задачи: нет активных"), actionButton("tasks-display_task_modal", "Задачи: нет активных", icon("list-check")),
position = "left", position = "left",
open = list(mobile = "always") open = list(mobile = "always")
), ),
@@ -137,9 +132,7 @@ server <- function(input, output, session) {
if (AUTH_ENABLED) { if (AUTH_ENABLED) {
reactiveValuesToList(res_auth) reactiveValuesToList(res_auth)
if (res_auth$admin) { if (res_auth$admin) {
# print("admin")
} else { } else {
# print("not_admin")
showing_buttons <- FALSE showing_buttons <- FALSE
} }
} }
@@ -160,8 +153,10 @@ server <- function(input, output, session) {
} }
}) })
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# REACTIVE VALUES ================================= # REACTIVE VALUES =================================
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Create a reactive values object to store the input data # Create a reactive values object to store the input data
values <- reactiveValues( values <- reactiveValues(
data = NULL, data = NULL,
@@ -182,7 +177,7 @@ server <- function(input, output, session) {
validator_nested <- reactiveVal(NULL) validator_nested <- reactiveVal(NULL)
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# ГЛАВНАЯ СТРАНИЦА ------------------------------- # reactive ui -------------------------------
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## reactive ui ----------------------------------- ## reactive ui -----------------------------------
@@ -221,10 +216,9 @@ server <- function(input, output, session) {
### bases info ---------------- ### bases info ----------------
observeEvent(main_form_is_empty(), { observeEvent(main_form_is_empty(), {
if (main_form_is_empty() == TRUE) { output$base_data <- renderUI({
output$base_data <- renderUI({
if (main_form_is_empty() == TRUE) {
con <- db$make_db_connection(scheme(),"base_data") con <- db$make_db_connection(scheme(),"base_data")
on.exit(db$close_db_connection(con, "base_data"), add = TRUE) on.exit(db$close_db_connection(con, "base_data"), add = TRUE)
@@ -239,8 +233,10 @@ server <- function(input, output, session) {
tasks_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM tasks WHERE task_status = 'active'")) |> tasks_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM tasks WHERE task_status = 'active'")) |>
dplyr::pull() 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())}")) |> 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() 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())}")) |> 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() dplyr::pull()
@@ -261,15 +257,16 @@ server <- function(input, output, session) {
span(strong("Активных на сегодня:"), if (tasks_today_count > 0) actionLink("tasks-show_dt_today", tasks_today_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()) span(strong("Просроченных:"), if (tasks_overdue_count > 0) actionLink("tasks-show_dt_overdue", tasks_overdue_count) else "0", br())
) )
}) }
} })
}) })
# обновление данных схем ------ # обновление данных схем ------
observeEvent(input$schmes_selector, { observeEvent(input$schmes_selector, {
scheme(input$schmes_selector) scheme(input$schmes_selector)
mhcs(schms[[input$schmes_selector]]) mhcs(schms[[input$schmes_selector]])
}) })
# ========================================== # ==========================================
@@ -422,6 +419,7 @@ server <- function(input, output, session) {
# nested ui # nested ui
nested_form_panels <- if (!is.null(values$nested_key)) { nested_form_panels <- if (!is.null(values$nested_key)) {
purrr::map( purrr::map(
.x = unique(this_nested_form_scheme$subgroup), .x = unique(this_nested_form_scheme$subgroup),
.f = \(subgroup) { .f = \(subgroup) {
@@ -442,7 +440,9 @@ server <- function(input, output, session) {
} }
) )
} else { } else {
list(bslib::nav_panel("", div("Нет доступных записей.", br(), "Необходимо создать новую запись."))) list(bslib::nav_panel("", div("Нет доступных записей.", br(), "Необходимо создать новую запись.")))
} }
# ui для всплывающего окна # ui для всплывающего окна
@@ -507,7 +507,7 @@ server <- function(input, output, session) {
output$dt_nested <- DT::renderDataTable( output$dt_nested <- DT::renderDataTable(
DT::datatable( DT::datatable(
values$data, values$data,
caption = 'Table 1: This is a simple caption for the table.', caption = 'В данной таблице можно изменять данные',
rownames = FALSE, rownames = FALSE,
colnames = col_types |> dplyr::pull(form_id, form_label), colnames = col_types |> dplyr::pull(form_id, form_label),
extensions = c('KeyTable', "FixedColumns"), extensions = c('KeyTable', "FixedColumns"),
@@ -528,7 +528,7 @@ server <- function(input, output, session) {
DT::dataTableOutput("dt_nested"), DT::dataTableOutput("dt_nested"),
size = "xl", size = "xl",
footer = tagList( footer = tagList(
actionButton("nested_form_dt_save", "сохранить изменения") actionButton("nested_form_dt_save", "Сохранить изменения", icon("floppy-disk"))
), ),
easyClose = TRUE easyClose = TRUE
)) ))
@@ -542,8 +542,9 @@ server <- function(input, output, session) {
### кнопка: отображение DT ----------------------------- ### кнопка: отображение DT -----------------------------
observeEvent(input$nested_form_dt_button, { 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() removeModal()
show_modal_for_nested_form_dt(con) show_modal_for_nested_form_dt(con)
@@ -627,8 +628,8 @@ server <- function(input, output, session) {
observeEvent(values$nested_key, { observeEvent(values$nested_key, {
con <- db$make_db_connection(scheme(),"nested_tables") con <- db$make_db_connection(scheme(),"nested_key")
on.exit(db$close_db_connection(con, "nested_tables"), add = TRUE) 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) kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, mhcs(), values$main_key, con)
@@ -685,8 +686,8 @@ server <- function(input, output, session) {
observeEvent(input$confirm_create_new_nested_key, { observeEvent(input$confirm_create_new_nested_key, {
req(input[[mhcs()$get_key_id(values$nested_form_id)]]) req(input[[mhcs()$get_key_id(values$nested_form_id)]])
con <- db$make_db_connection(scheme(),"confirm_create_new_key") con <- db$make_db_connection(scheme(),"confirm_create_new_nested_key")
on.exit(db$close_db_connection(con, "confirm_create_new_key"), add = TRUE) on.exit(db$close_db_connection(con, "confirm_create_new_nested_key"), add = TRUE)
existed_key <- db$get_nested_keys_from_table( existed_key <- db$get_nested_keys_from_table(
table_name = values$nested_form_id, table_name = values$nested_form_id,

View File

@@ -3,7 +3,6 @@ box::use(
modules/utils, modules/utils,
) )
#' @export #' @export
load_data_to_form <- function( load_data_to_form <- function(
df, df,
@@ -16,10 +15,6 @@ load_data_to_form <- function(
input_ids <- names(mhcs()$get_id_type_list(table_name)) input_ids <- names(mhcs()$get_id_type_list(table_name))
if (missing(ns)) ns <- NULL 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 # rewrite input forms
purrr::walk2( purrr::walk2(
.x = input_types, .x = input_types,

View File

@@ -61,7 +61,9 @@ server <- function(id, values, scheme, mhcs) {
} }
} else { } else {
tasks_selector <- NULL tasks_selector <- NULL
} }
# ui -------------------- # ui --------------------
@@ -86,9 +88,9 @@ server <- function(id, values, scheme, mhcs) {
ui <- layout_sidebar( ui <- layout_sidebar(
sidebar = tagList( sidebar = tagList(
selectizeInput(ns("tasks_id_selector"), label = "ID задачи:", choices = tasks_selector, selected = values$tasks_id), selectizeInput(ns("tasks_id_selector"), label = "ID задачи:", choices = tasks_selector, selected = values$tasks_id),
actionButton(ns("tasks_create_new_task"), "new_task"), actionButton(ns("tasks_create_new_task"), "Новая задача", icon("plus")),
actionButton(ns("tasks_add_autoreview"), "add autotask"), actionButton(ns("tasks_add_autoreview"), "Новая авто-задача (тест)", icon("calendar")),
actionButton(ns("tasks_DT_VIEW"), "DT") actionButton(ns("tasks_DT_VIEW"), "DT", icon("table"))
), ),
tab tab
) )
@@ -97,7 +99,7 @@ server <- function(id, values, scheme, mhcs) {
ui, ui,
size = "l", size = "l",
footer = tagList( footer = tagList(
actionButton(ns("tasks_saving_button"), "сохранить изменения") actionButton(ns("tasks_saving_button"), "Сохранить изменения", icon("floppy-disk"))
), ),
easyClose = TRUE easyClose = TRUE
)) ))
@@ -105,6 +107,11 @@ server <- function(id, values, scheme, mhcs) {
## отображение окна ----------------- ## отображение окна -----------------
observeEvent(input$display_task_modal, { observeEvent(input$display_task_modal, {
if (is.null(values$main_key)) {
showNotification("необходимо выбрать запись", type = "error")
return()
}
con <- db$make_db_connection(scheme(),"display_task_modal") con <- db$make_db_connection(scheme(),"display_task_modal")
on.exit(db$close_db_connection(con, "display_task_modal"), add = TRUE) on.exit(db$close_db_connection(con, "display_task_modal"), add = TRUE)
@@ -387,7 +394,7 @@ server <- function(id, values, scheme, mhcs) {
DT::dataTableOutput(ns("dt_todays_tasks")), DT::dataTableOutput(ns("dt_todays_tasks")),
size = "xl", size = "xl",
footer = tagList( footer = tagList(
actionButton(ns("jump_to_main_key"), "перейти к id") actionButton(ns("jump_to_main_key"), "перейти к id", icon("right-to-bracket"))
), ),
easyClose = TRUE easyClose = TRUE
)) ))
@@ -422,24 +429,25 @@ update_task_button_count <- function(con, values, ns) {
inputID <- "display_task_modal" inputID <- "display_task_modal"
if (!missing(ns)) inputID <- ns(inputID) if (!missing(ns)) inputID <- ns(inputID)
# если ключ не определен - выход из функции
if (is.null(values$main_key)) { if (is.null(values$main_key)) {
updateActionButton(inputId = inputID, label = "Задачи: нет активных")
updateActionButton(inputId = inputID, label = "Задачи")
return() return()
} }
# при наличии таблицы - полу
if ("tasks" %in% DBI::dbListTables(con)) { 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'")) |> 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() dplyr::pull()
if (tasks_num > 0) { if (tasks_num > 0) {
updateActionButton(inputId = inputID, label = paste("активных задач:", tasks_num)) updateActionButton(inputId = inputID, label = paste("активных задач:", tasks_num))
} else { } else {
updateActionButton(inputId = inputID, label = "Задачи: нет активных") updateActionButton(inputId = inputID, label = "Задачи: нет активных")
} }
} }

View File

@@ -11,8 +11,10 @@ prod:
main_register: АВЗ и АМИЛОИОДОЗЫ main_register: АВЗ и АМИЛОИОДОЗЫ
devel: devel:
form_app_configure_path: _devel/antifib form_app_configure_path: _devel/new_bases
form_auth_enabled: false form_auth_enabled: false
form_app_version: 0.16.0 dev form_app_version: 0.16.0 dev
form_schemes: form_schemes:
antifib: антифибротическая antifib: антифибротическая
d2tra_t: D2TRA_test

View File

@@ -71,6 +71,7 @@ val_is_a_number = function(x) {
# exit if empty # exit if empty
if (is_this_empty_value(x)) return(NULL) if (is_this_empty_value(x)) return(NULL)
# хак для пропуска значений # хак для пропуска значений
if (x == "NA") return(NULL) if (x == "NA") return(NULL)
@@ -82,7 +83,7 @@ val_is_a_number = function(x) {
## находится ли число в заданном диапазоне значений ------- ## находится ли число в заданном диапазоне значений -------
val_number_within_a_range = function(x, ranges) { val_number_within_a_range = function(x, ranges) {
# exit if empty # exit if empty
if (is_this_empty_value(x)) return(NULL) if (is_this_empty_value(x)) return(NULL)
if (x == "NA") return(NULL) if (x == "NA") return(NULL)

View File

@@ -46,8 +46,6 @@ check_if_table_is_exist_and_init_if_not = function(
if (table_name %in% DBI::dbListTables(con)) { if (table_name %in% DBI::dbListTables(con)) {
cli::cli_inform(c("*" = "проверка таблицы в базе данных: '{table_name}'"))
# если таблица существует, производим проверку структуры таблицы # если таблица существует, производим проверку структуры таблицы
compare_existing_table_with_schema( compare_existing_table_with_schema(
table_name = table_name, table_name = table_name,
@@ -121,6 +119,8 @@ compare_existing_table_with_schema = function(
con = rlang::env_get(rlang::caller_env(), nm = "con") con = rlang::env_get(rlang::caller_env(), nm = "con")
) { ) {
cli::cli_progress_step("проверка таблицы в базе данных: '{table_name}'")
main_key <- schm$get_main_key_id main_key <- schm$get_main_key_id
key_id <- schm$get_key_id(table_name) key_id <- schm$get_key_id(table_name)
forms_ids <- schm$get_forms_ids(table_name) forms_ids <- schm$get_forms_ids(table_name)
@@ -401,5 +401,4 @@ local_db_backup <- function(
} }
} }
) )
} }

View File

@@ -48,8 +48,8 @@ scheme_R6 <- R6::R6Class(
"task_status", "select_one", "Статус задачи", NA, "completed", "task_status", "select_one", "Статус задачи", NA, "completed",
"task_status", "select_one", "Статус задачи", NA, "deleted", "task_status", "select_one", "Статус задачи", NA, "deleted",
"task_title", "text", "Название задачи", NA, NA, "task_title", "text", "Название задачи", NA, NA,
"task_description", "text", "Описание задачи", "краткое описание", NA, "task_description", "text", "Описание задачи", "краткое описание", "2",
"task_due_date", "date", "Дата выполнения задачи", "YE DJN", NA, "task_due_date", "date", "Дата выполнения задачи", NA, NA,
) |> ) |>
dplyr::mutate(condition = NA) dplyr::mutate(condition = NA)

View File

@@ -135,7 +135,8 @@ render_forms = function(
form <- shiny::textAreaInput( form <- shiny::textAreaInput(
inputId = form_id, inputId = form_id,
label = label, label = label,
rows = 1 rows = 1,
resize = "none"
) )
} }