Compare commits
46 Commits
bb6f94126c
...
0.18.3
| Author | SHA1 | Date | |
|---|---|---|---|
| 8f3343a103 | |||
| 4baec1003a | |||
| 7ed3ee0480 | |||
| a178480912 | |||
| a4d829e3dd | |||
| 89d58c8df5 | |||
| 4c50473c7e | |||
| df740c4f71 | |||
| d73699a1d1 | |||
| e6e15392c3 | |||
| 2ececc8029 | |||
| a0340d78e5 | |||
| 81dc89cf02 | |||
| 0c9dda215d | |||
| 835f053584 | |||
| 358a238f4e | |||
| eb11ad8672 | |||
| 39ae2337d4 | |||
| 436a6172e6 | |||
| f52d110a59 | |||
| d615024640 | |||
| 870f0d93cc | |||
| 2544bbbed0 | |||
| 8fa6753f31 | |||
| 3bbb903022 | |||
| 66006696ac | |||
| 182d9bcf3e | |||
| 73df94fe94 | |||
| ae95389f10 | |||
| 91b2deccf6 | |||
| f5031bfe1c | |||
| da277ffb06 | |||
| c247699b23 | |||
| b8b2951fd6 | |||
| 317d6e3d64 | |||
| c63beeef0c | |||
| 87444b5718 | |||
| 4b05fbafc2 | |||
| c8da651e72 | |||
| fd5a7927cb | |||
| bc5b4ea208 | |||
| 0c3c35936e | |||
| 7b6cbc67e4 | |||
| 696f2e3ac8 | |||
| 985cf99f5f | |||
| a9bbaf4504 |
26
.Rprofile
26
.Rprofile
@@ -4,7 +4,6 @@ source("renv/activate.R")
|
||||
(function() {
|
||||
|
||||
paths <- c(
|
||||
"R_CONFIG_ACTIVE",
|
||||
"AUTH_DB_KEY"
|
||||
)
|
||||
|
||||
@@ -18,3 +17,28 @@ source("renv/activate.R")
|
||||
))
|
||||
}
|
||||
})()
|
||||
|
||||
(function() {
|
||||
|
||||
if (Sys.getenv("R_CONFIG_ACTIVE") == "") {
|
||||
Sys.setenv(R_CONFIG_ACTIVE = "prod")
|
||||
cli::cli_inform(c(
|
||||
"i" = "Не указана конфигурация по умолчанию, автоматически установлен 'prod'. Для изменения конфигурации добавьте в {.file .Renviron}:"
|
||||
))
|
||||
cli::cli_code(paste0("R_CONFIG_ACTIVE", "="))
|
||||
|
||||
}
|
||||
Sys.setenv(R_CONFIG_FILE = "config/config.yml")
|
||||
|
||||
})()
|
||||
|
||||
|
||||
# при первом запуске скопировать пример конфига
|
||||
(function() {
|
||||
|
||||
if (!file.exists("config/config.yml")) {
|
||||
file.copy("config/config_example.yml", "config/config.yml")
|
||||
}
|
||||
|
||||
})()
|
||||
|
||||
|
||||
4
.gitignore
vendored
4
.gitignore
vendored
@@ -1,8 +1,10 @@
|
||||
/renv
|
||||
/temp
|
||||
/_devel
|
||||
/all_bases
|
||||
|
||||
config/config.yml
|
||||
|
||||
scheme.rds
|
||||
.Renviron
|
||||
.DS_Store
|
||||
.lintr
|
||||
|
||||
24
CHANGELOG.md
24
CHANGELOG.md
@@ -1,3 +1,27 @@
|
||||
### 0.18.2 - 0.18.3 (2026-06-18)
|
||||
##### features
|
||||
- возможность отражение лога действий по базам (для администраторов) и отдельно для каждой записи (сгруппированы по уникальным действиям)
|
||||
- возможность экспорта таблицы со списком значений не прошедшие валидацию согласно схеме (для администраторов)
|
||||
|
||||
##### refactor
|
||||
- перестройка структуры репозитория
|
||||
|
||||
### 0.18.1 (2026-06-08)
|
||||
##### fix
|
||||
- правильный экспорт текстовых данных
|
||||
|
||||
### 0.18.0 (2026-06-06)
|
||||
##### features
|
||||
- возможность отрганичить доступ к базам данных для отдельных пользователей
|
||||
|
||||
### 0.17.0 (2026-04-24)
|
||||
##### features
|
||||
- модуль с задачами: для каждой записи в базе можно создать задачи, на главном экране отображается общее количество активных задач, по сроку выполнения на сегодня и просроченные задачи;
|
||||
- проверка на наличие орфанных записей в базе (сверка существующих ключей из главной таблицы `main` с каждой вложенной таблицей)
|
||||
|
||||
##### changes
|
||||
- определение активных схем - теперь в файле `config.yml`
|
||||
|
||||
### 0.16.0 (2026-04-21)
|
||||
##### features
|
||||
- возможность импорта данных в базу данных из ранее экспортированных .xlsx таблиц;
|
||||
|
||||
34
R/app/forms.R
Normal file
34
R/app/forms.R
Normal file
@@ -0,0 +1,34 @@
|
||||
options(box.path = here::here())
|
||||
box::use(
|
||||
R/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
|
||||
)
|
||||
}
|
||||
)
|
||||
}
|
||||
129
R/app/logs.R
Normal file
129
R/app/logs.R
Normal file
@@ -0,0 +1,129 @@
|
||||
box::use(
|
||||
shiny[...],
|
||||
bslib[...]
|
||||
)
|
||||
|
||||
options(box.path = here::here())
|
||||
box::use(
|
||||
R/modules/db,
|
||||
R/modules/utils,
|
||||
R/app/forms
|
||||
)
|
||||
|
||||
#' @export
|
||||
server <- function(id, values, scheme, mhcs) {
|
||||
|
||||
ns <- NS(id)
|
||||
|
||||
moduleServer(id, function(input, output, session) {
|
||||
|
||||
# отображение DT-таблицы со списком последних действий
|
||||
observeEvent(input$show_last_actions, {
|
||||
|
||||
con <- db$make_db_connection(scheme(),"show_last_actions")
|
||||
on.exit(db$close_db_connection(con, "show_last_actions"), add = TRUE)
|
||||
|
||||
log_df <- DBI::dbReadTable(con, "log")
|
||||
|
||||
# новые записи вначале, формат даты с временем
|
||||
log_df <- log_df |>
|
||||
dplyr::arrange(dplyr::desc(date)) |>
|
||||
dplyr::mutate(date = format(as.POSIXct(date), "%d.%m.%Y %H:%M"))
|
||||
|
||||
output$dt_logs <- DT::renderDataTable(
|
||||
DT::datatable(
|
||||
log_df,
|
||||
# caption = 'Table 1: This is a simple caption for the table.',
|
||||
rownames = FALSE,
|
||||
colnames = logs_colnames,
|
||||
extensions = c('KeyTable', "FixedColumns"),
|
||||
# editable = 'cell',
|
||||
class = 'cell-border stripe',
|
||||
selection = "single",
|
||||
options = list(
|
||||
# dom = 'tipf',
|
||||
scrollX = TRUE,
|
||||
fixedColumns = list(leftColumns = 1),
|
||||
keys = TRUE,
|
||||
autoWidth = TRUE,
|
||||
columnDefs = list(
|
||||
list(width = "150px", targets = c(0,6)),
|
||||
list(width = "110px", targets = c(1:4))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
showModal(modalDialog(
|
||||
DT::dataTableOutput(ns("dt_logs")),
|
||||
size = "xl",
|
||||
# footer = tagList(
|
||||
# actionButton("nested_form_dt_save", "сохранить изменения")
|
||||
# ),
|
||||
easyClose = TRUE
|
||||
))
|
||||
|
||||
})
|
||||
|
||||
# observe({
|
||||
# print(input$dt_logs_rows_selected)
|
||||
# })
|
||||
|
||||
output$display_log <- renderUI({
|
||||
req(values$main_key)
|
||||
|
||||
# получение логов
|
||||
con <- db$make_db_connection(scheme(),"display_log")
|
||||
on.exit(db$close_db_connection(con, "display_log"), add = TRUE)
|
||||
|
||||
query <- sprintf("SELECT * FROM \"log\" WHERE key = '%s'", values$main_key)
|
||||
log_df_for_id <- DBI::dbGetQuery(con, query)
|
||||
|
||||
if (nrow(log_df_for_id) > 0) {
|
||||
|
||||
lines <- log_df_for_id |>
|
||||
dplyr::mutate(
|
||||
date = as.POSIXct(date),
|
||||
date = date + lubridate::hours(3), # fix datetime
|
||||
date_day = as.Date(date)
|
||||
) |>
|
||||
dplyr::mutate(cons_actions = dplyr::consecutive_id(action, user)) |>
|
||||
dplyr::mutate(n_actions = dplyr::row_number(), .by = c(cons_actions, user, action, date_day)) |>
|
||||
dplyr::slice(which.max(n_actions), .by = c(user, action, date_day)) |>
|
||||
dplyr::arrange(date) |>
|
||||
dplyr::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
|
||||
)) |>
|
||||
dplyr::pull(string_to_print) |>
|
||||
paste(collapse = "</br>")
|
||||
|
||||
} else {
|
||||
lines <- ""
|
||||
}
|
||||
|
||||
div(
|
||||
strong("Последние действия:"),
|
||||
br(),
|
||||
HTML(lines),
|
||||
style = "font-size:10px;"
|
||||
)
|
||||
|
||||
})
|
||||
|
||||
})
|
||||
}
|
||||
|
||||
logs_colnames <- c(
|
||||
"время" = "date",
|
||||
"пользователь" = "user",
|
||||
"приложение" = "app_id",
|
||||
"версия" = "app_ver",
|
||||
"ip" = "remote_addr",
|
||||
"ID записи" = "key",
|
||||
"действие" = "action"
|
||||
)
|
||||
474
R/app/tasks.R
Normal file
474
R/app/tasks.R
Normal file
@@ -0,0 +1,474 @@
|
||||
box::use(
|
||||
shiny[...],
|
||||
bslib[...]
|
||||
)
|
||||
|
||||
options(box.path = here::here())
|
||||
box::use(
|
||||
R/modules/db,
|
||||
R/modules/utils,
|
||||
R/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 == "active") |>
|
||||
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)
|
||||
|
||||
if (!values$main_key %in% db$get_keys_from_table("main", mhcs(), con)) {
|
||||
showNotification("Невозможно создать задачу для данного ID (нет в базе)", type = "error")
|
||||
return()
|
||||
}
|
||||
|
||||
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) |>
|
||||
dplyr::arrange(task_due_date)
|
||||
|
||||
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',
|
||||
class = 'cell-border stripe',
|
||||
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"
|
||||
)
|
||||
249
R/modules/data_validation.R
Normal file
249
R/modules/data_validation.R
Normal file
@@ -0,0 +1,249 @@
|
||||
options(box.path = here::here())
|
||||
box::use(
|
||||
R/modules/data_manipulations[is_this_empty_value]
|
||||
)
|
||||
|
||||
#' @export
|
||||
init_val = function(scheme, ns) {
|
||||
|
||||
iv <- shinyvalidate::InputValidator$new()
|
||||
|
||||
# если передана функция с пространством имен, то происходит модификация id
|
||||
if (!missing(ns)) {
|
||||
scheme <- scheme |>
|
||||
dplyr::mutate(form_id = ns(form_id))
|
||||
}
|
||||
|
||||
# формируем список id - тип
|
||||
inputs_simple_list <- scheme |>
|
||||
dplyr::filter(!form_type %in% c("nested_forms", "description", "description_header")) |>
|
||||
dplyr::distinct(form_id, form_type) |>
|
||||
tibble::deframe()
|
||||
|
||||
# add rules to all inputs
|
||||
purrr::walk(
|
||||
.x = names(inputs_simple_list),
|
||||
.f = \(x_input_id) {
|
||||
|
||||
form_type <- inputs_simple_list[[x_input_id]]
|
||||
|
||||
choices <- dplyr::filter(scheme, form_id == {{x_input_id}}) |>
|
||||
dplyr::pull(choices)
|
||||
|
||||
val_required <- dplyr::filter(scheme, form_id == {{x_input_id}}) |>
|
||||
dplyr::distinct(required) |>
|
||||
dplyr::pull(required)
|
||||
|
||||
# for `number` type: if in `choices` column has values then parsing them to range validation
|
||||
# value `0; 250` -> transform to rule validation value from 0 to 250
|
||||
if (form_type == "number") {
|
||||
|
||||
iv$add_rule(x_input_id, val_is_a_number)
|
||||
|
||||
# проверка на соответствие диапазону значений
|
||||
if (!is.na(choices)) {
|
||||
# разделить на несколько елементов
|
||||
ranges <- as.integer(stringr::str_split_1(choices, "; "))
|
||||
|
||||
# проверка на кол-во значений
|
||||
if (length(ranges) > 3) {
|
||||
warning("Количество переданных элементов'", x_input_id, "' > 2")
|
||||
} else {
|
||||
iv$add_rule(x_input_id, val_number_within_a_range, ranges = ranges)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (form_type %in% c("select_multiple", "select_one", "radio", "checkbox")) {
|
||||
iv$add_rule(x_input_id, val_choice_within_a_dict, choices = choices)
|
||||
}
|
||||
|
||||
# if in `required` column value is `1` apply standart validation
|
||||
if (!is.na(val_required) && val_required == 1) {
|
||||
iv$add_rule(x_input_id, shinyvalidate::sv_required(message = "Необходимо заполнить."))
|
||||
}
|
||||
}
|
||||
)
|
||||
iv
|
||||
}
|
||||
|
||||
# работа с числовыми значениями ------------------
|
||||
## проверка является ли значение числом ----------
|
||||
val_is_a_number = function(x) {
|
||||
|
||||
# exit if empty
|
||||
if (is_this_empty_value(x)) return(NULL)
|
||||
|
||||
# хак для пропуска значений
|
||||
if (x == "NA") return(NULL)
|
||||
|
||||
# check for numeric
|
||||
# if (grepl("^[-]?(\\d*\\,\\d+|\\d+\\,\\d*|\\d+)$", x)) NULL else "Значение должно быть числом."
|
||||
if (grepl("^[+-]?\\d*[\\.|\\,]?\\d+$", x)) NULL else "Значение должно быть числом."
|
||||
|
||||
}
|
||||
|
||||
## находится ли число в заданном диапазоне значений -------
|
||||
val_number_within_a_range = function(x, ranges) {
|
||||
|
||||
# exit if empty
|
||||
if (is_this_empty_value(x)) return(NULL)
|
||||
if (x == "NA") return(NULL)
|
||||
|
||||
# замена разделителя десятичных цифр
|
||||
x <- stringr::str_replace(x, ",", ".")
|
||||
|
||||
# check for currect value
|
||||
if (dplyr::between(as.double(x), ranges[1], ranges[2])) {
|
||||
NULL
|
||||
} else {
|
||||
glue::glue("Значение должно быть между {ranges[1]} и {ranges[2]}.")
|
||||
}
|
||||
}
|
||||
|
||||
# списки ---------------------------------------------------------
|
||||
## являются ли выбранные значения допустимы (согласно файлу схемы)
|
||||
val_choice_within_a_dict = function(x, choices) {
|
||||
|
||||
if (length(x) == 1) {
|
||||
if (is_this_empty_value(x)) return(NULL)
|
||||
}
|
||||
|
||||
# проверка на соответствие вариантов схеме ---------
|
||||
compare_to_dict <- (x %in% choices)
|
||||
if (!all(compare_to_dict)) {
|
||||
|
||||
text <- paste0("'",x[!compare_to_dict],"'", collapse = ", ")
|
||||
glue::glue("варианты, не соответствующие схеме: {text}")
|
||||
}
|
||||
}
|
||||
|
||||
# ЭКСПОРТ ДАННЫХ ДЛЯ ВАЛИДАЦИИ
|
||||
#' @export
|
||||
validate_value_for_form <- function(data_to_check, form_type, choices, val_required) {
|
||||
|
||||
res <- NULL
|
||||
# for `number` type: if in `choices` column has values then parsing them to range validation
|
||||
# value `0; 250` -> transform to rule validation value from 0 to 250
|
||||
if (form_type == "number") {
|
||||
|
||||
res <- val_is_a_number(data_to_check)
|
||||
if(!is.null(res)) return(res)
|
||||
|
||||
# проверка на соответствие диапазону значений
|
||||
if (!is.na(choices)) {
|
||||
|
||||
# разделить на несколько елементов
|
||||
ranges <- as.integer(stringr::str_split_1(choices, "; "))
|
||||
|
||||
# проверка на кол-во значений
|
||||
if (length(ranges) > 3) {
|
||||
warning("Количество переданных элементов'", x_input_id, "' > 2")
|
||||
} else {
|
||||
|
||||
res <- val_number_within_a_range(data_to_check, ranges = ranges)
|
||||
if (!is.null(res)) return(res)
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (form_type %in% c("select_multiple", "select_one", "radio", "checkbox")) {
|
||||
|
||||
if (!is_this_empty_value(data_to_check)) {
|
||||
split_data <- stringr::str_split_1(data_to_check, "; ")
|
||||
} else {
|
||||
split_data <- NA
|
||||
}
|
||||
|
||||
res <- val_choice_within_a_dict(split_data, choices = choices)
|
||||
if(!is.null(res)) return(res)
|
||||
}
|
||||
|
||||
# if in `required` column value is `1` apply standart validation
|
||||
if (!is.na(val_required) && val_required == 1) {
|
||||
|
||||
if (is_this_empty_value(data_to_check)) {
|
||||
|
||||
res <- "Необходимо заполнить."
|
||||
if(!is.null(res)) return(res)
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
if(is.null(res)) return(NA)
|
||||
}
|
||||
|
||||
#' @export
|
||||
get_table_with_data_validation_info <- function(schm, con) {
|
||||
|
||||
# итерациям по всем таблицам
|
||||
purrr::map(
|
||||
purrr::set_names(schm$all_tables_names),
|
||||
.f = \(table_name) {
|
||||
|
||||
scheme <- schm$get_scheme(table_name)
|
||||
data <- DBI::dbReadTable(con, table_name)
|
||||
|
||||
inputs_simple_list <- schm$get_id_type_list(table_name)
|
||||
|
||||
main_key <- schm$get_main_key_id
|
||||
key <- schm$get_key_id(table_name)
|
||||
|
||||
# итерация по всем form_id в текущей таблице
|
||||
ff <- purrr::map2(
|
||||
.x = names(inputs_simple_list),
|
||||
.y = unname(inputs_simple_list),
|
||||
.f = \(x_input_id, y_form_type) {
|
||||
|
||||
this_id_scheme <- dplyr::filter(scheme, form_id == {{x_input_id}})
|
||||
|
||||
choices <- this_id_scheme$choices
|
||||
val_required <- unique(this_id_scheme$required)
|
||||
|
||||
# extract data
|
||||
data_to_check <- data[[x_input_id]]
|
||||
main_keys <- data[[main_key]]
|
||||
keys <- data[[key]]
|
||||
iter <- purrr::set_names(data_to_check, keys)
|
||||
|
||||
# cli::cli_inform("~ input_id: {x_input_id} | type: {form_type} | value: {data_to_check}")
|
||||
validation_info <- purrr::map(iter, validate_value_for_form, y_form_type, choices, val_required)
|
||||
|
||||
df_with_result_and_validation_for_id <- tibble::enframe(validation_info, name = key, value = "value") |>
|
||||
tidyr::unnest(cols = c(value))
|
||||
|
||||
# если главный ключ и ключ для таблицы не одно и тоже, добавление главного ключа в таблицу
|
||||
if (main_key != key) {
|
||||
df_with_result_and_validation_for_id[main_key] <- main_keys
|
||||
}
|
||||
|
||||
df_with_result_and_validation_for_id |>
|
||||
dplyr::mutate(form_id = x_input_id)
|
||||
|
||||
}) |>
|
||||
purrr::list_rbind()
|
||||
|
||||
ff |>
|
||||
dplyr::distinct() |>
|
||||
dplyr::filter(!is.na(value)) |>
|
||||
# данные схемы для 'читабельности информации'
|
||||
dplyr::left_join(
|
||||
y = scheme |> dplyr::distinct(form_id, form_label) |> dplyr::mutate(nr = dplyr::row_number()),
|
||||
by = dplyr::join_by(form_id),
|
||||
) |>
|
||||
# сортировка (main_key, затем id формы - по порядку в схеме)
|
||||
dplyr::arrange(!!rlang::sym(main_key), !!rlang::sym(main_key), nr) |>
|
||||
dplyr::select(
|
||||
!!rlang::sym(main_key), !!rlang::sym(main_key),
|
||||
form_id,
|
||||
form_label,
|
||||
value
|
||||
)
|
||||
|
||||
}
|
||||
)
|
||||
|
||||
}
|
||||
|
||||
@@ -3,13 +3,14 @@
|
||||
#' @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",
|
||||
scheme,
|
||||
ext = "sqlite"
|
||||
))
|
||||
|
||||
}
|
||||
|
||||
#' @export
|
||||
@@ -46,14 +47,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 +63,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(
|
||||
@@ -102,7 +103,7 @@ get_dummy_data = function(type) {
|
||||
get_dummy_df = function(forms_id_type_list) {
|
||||
|
||||
options(box.path = here::here())
|
||||
box::use(modules/utils)
|
||||
box::use(R/modules/utils)
|
||||
|
||||
purrr::map(
|
||||
.x = forms_id_type_list,
|
||||
@@ -121,6 +122,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)
|
||||
@@ -133,7 +136,7 @@ compare_existing_table_with_schema = function(
|
||||
}
|
||||
|
||||
options(box.path = here::here())
|
||||
box::use(modules/utils)
|
||||
box::use(R/modules/utils)
|
||||
|
||||
# checking if db structure in form compatible with alrady writed data (in case on changig form)
|
||||
if (identical(colnames(DBI::dbReadTable(con, table_name)), all_ids_from_schema)) {
|
||||
@@ -198,7 +201,8 @@ write_df_to_db = function(
|
||||
|
||||
date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)
|
||||
number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
|
||||
other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
|
||||
# other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
|
||||
other_cols <- colnames(df)[!(colnames(df) %in% c(date_columns, number_columns))]
|
||||
|
||||
df <- df |>
|
||||
dplyr::mutate(
|
||||
@@ -206,7 +210,7 @@ write_df_to_db = function(
|
||||
dplyr::across(tidyselect::all_of({{date_columns}}), \(x) purrr::map_chr(x, excel_to_db_dates_converter)),
|
||||
# числа - к единому формату десятичных значений
|
||||
dplyr::across(tidyselect::all_of({{number_columns}}), ~ gsub("\\.", "," , .x)),
|
||||
dplyr::across(tidyselect::all_of({{other_cols}}), as.character),
|
||||
dplyr::across(tidyselect::all_of({{other_cols}}), \(x) dplyr::if_else(x == "", as.character(NA), as.character(x)))
|
||||
)
|
||||
|
||||
if (table_name == "main") {
|
||||
@@ -392,8 +396,8 @@ local_db_backup <- function(
|
||||
file.remove(utils::tail(existed_files, length(existed_files) - backups_limit))
|
||||
}
|
||||
|
||||
# если количество существующих бэкапов равно имеющемуся и пора делать бэкап - делаем бэкап, удаляем послендий файл
|
||||
if (dates[1] + schedule_days == Sys.Date()) {
|
||||
# если количество существующих бэкапов равно имеющемуся и пора делать бэкап - делаем бэкап
|
||||
if (dates[1] + schedule_days <= Sys.Date()) {
|
||||
|
||||
file.copy(db_full_path, todays_backup)
|
||||
cli::cli_alert_success("создан {schedule_name}-бэкап для '{db_name}'")
|
||||
@@ -403,3 +407,59 @@ local_db_backup <- function(
|
||||
)
|
||||
}
|
||||
|
||||
#' @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} орфанных записей")
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
@@ -1,60 +1,81 @@
|
||||
.on_load = function(ns) {
|
||||
|
||||
check_and_init_scheme()
|
||||
|
||||
# set global settings:
|
||||
set_global_options(
|
||||
shiny.host = "0.0.0.0",
|
||||
shiny.port = 1338,
|
||||
APP.DEBUG = FALSE
|
||||
)
|
||||
|
||||
}
|
||||
|
||||
#' @export
|
||||
#' @description костыли для упрощения работы себе
|
||||
set_global_options = function(
|
||||
SYMBOL_DELIM = "; ",
|
||||
APP.DEBUG = FALSE,
|
||||
shiny.host = "127.0.0.1",
|
||||
shiny.port = 1338,
|
||||
...
|
||||
) {
|
||||
|
||||
config_params_to_check <- c(
|
||||
"form_app_version",
|
||||
"form_id",
|
||||
"form_name",
|
||||
"form_app_configure_path",
|
||||
"form_auth_enabled",
|
||||
"form_id",
|
||||
"form_name"
|
||||
"form_schemes"
|
||||
)
|
||||
|
||||
expected_params_in_config <- config_params_to_check %in% names(config::get())
|
||||
if (!all(expected_params_in_config)) {
|
||||
cli::cli_abort(c("ну так не пойдет:", paste("-", config_params_to_check[!expected_params_in_config])))
|
||||
cli::cli_abort(c(
|
||||
"Необходимо добавить в файл конфига {.file config.yml} следующие параметры:",
|
||||
paste0(config_params_to_check[!expected_params_in_config], ":")
|
||||
))
|
||||
}
|
||||
|
||||
options(
|
||||
SYMBOL_DELIM = SYMBOL_DELIM,
|
||||
# form.db_path = config::get("form_db_path"),
|
||||
APP.DEBUG = APP.DEBUG,
|
||||
# APP.FILE_DB = APP.FILE_DB,
|
||||
shiny.host = shiny.host,
|
||||
shiny.port = shiny.port,
|
||||
...
|
||||
)
|
||||
}
|
||||
|
||||
# global vars ------------------------------------
|
||||
#' @export
|
||||
AUTH_ENABLED <- config::get("form_auth_enabled")
|
||||
|
||||
#' @export
|
||||
#' TODO: нормальный разворот
|
||||
ENABLED_SCHEMES <- unlist(config::get()$form_schemes)
|
||||
ENABLED_SCHEMES <- stats::setNames(names(ENABLED_SCHEMES), ENABLED_SCHEMES)
|
||||
|
||||
# -------------------------------------------------
|
||||
|
||||
#' @export
|
||||
check_and_init_scheme = function() {
|
||||
|
||||
cli::cli_inform(c("*" = "проверка схемы..."))
|
||||
|
||||
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])
|
||||
box::use(
|
||||
R/modules/db[local_db_backup]
|
||||
)
|
||||
|
||||
# список файлов, изменение которых, приведут к переинициализиации схемы
|
||||
files_to_watch <- c(
|
||||
fs::path(config::get("form_app_configure_path"), "configs", "enabled_schemes.R"),
|
||||
"modules/scheme_generator.R",
|
||||
"modules/utils.R"
|
||||
"config/config.yml",
|
||||
"R/modules/scheme_generator.R",
|
||||
"R/modules/utils.R"
|
||||
)
|
||||
|
||||
scheme_names <- enabled_schemes
|
||||
scheme_file <- paste0(config::get("form_app_configure_path"), "/configs/schemas/", scheme_names, ".xlsx")
|
||||
# проверка существования отслеживаемых файлов
|
||||
if (!all(file.exists(files_to_watch))) {
|
||||
cli::cli_abort("проверка схем: {files_to_watch[!file.exists(files_to_watch)]} is not exists")
|
||||
}
|
||||
|
||||
scheme_names <- names(config::get()$form_schemes)
|
||||
scheme_file <- paste0(config::get("form_app_configure_path"), "/schemas/", scheme_names, ".xlsx")
|
||||
scheme_file <- stats::setNames(scheme_file, scheme_names)
|
||||
|
||||
if (!all(file.exists(scheme_file))) {
|
||||
@@ -69,7 +90,7 @@ check_and_init_scheme = function() {
|
||||
exist_hash <- tools::md5sum(c(scheme_file, files_to_watch))
|
||||
|
||||
# если первый запуск (нет файла с кешем) инициализация схемы
|
||||
if (!file.exists(hash_file) | !file.exists("scheme.rds") | !all(file.exists(db_files))) {
|
||||
if (!file.exists(hash_file) | !file.exists("temp/scheme.rds") | !all(file.exists(db_files))) {
|
||||
|
||||
init_scheme(scheme_file)
|
||||
|
||||
@@ -105,14 +126,15 @@ init_scheme = function(scheme_file) {
|
||||
|
||||
options(box.path = here::here())
|
||||
box::use(
|
||||
modules/db,
|
||||
modules/scheme_generator[scheme_R6]
|
||||
R/modules/db,
|
||||
R/modules/scheme_generator[scheme_R6]
|
||||
)
|
||||
|
||||
db_path <- fs::path(config::get("form_app_configure_path"), "db")
|
||||
if (!dir.exists(db_path)) dir.create(db_path)
|
||||
|
||||
cli::cli_h1("Инициализация схемы")
|
||||
|
||||
schms <- purrr::map2(
|
||||
.x = scheme_file,
|
||||
.y = names(scheme_file),
|
||||
@@ -121,8 +143,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,14 +161,14 @@ 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")
|
||||
saveRDS(schms, "temp/scheme.rds")
|
||||
}
|
||||
@@ -40,10 +40,23 @@ 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")
|
||||
|
||||
box::use(modules/utils)
|
||||
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),
|
||||
@@ -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"
|
||||
)
|
||||
}
|
||||
|
||||
@@ -265,7 +266,7 @@ update_forms_with_data = function(
|
||||
) {
|
||||
|
||||
options(box.path = here::here())
|
||||
box::use(modules/data_manipulations[is_this_empty_value])
|
||||
box::use(R/modules/data_manipulations[is_this_empty_value])
|
||||
|
||||
# print("-----------------")
|
||||
# cli::cli_inform("form_id: {form_id} | form_type: {form_type}")
|
||||
@@ -3,17 +3,18 @@
|
||||
# SETUP AUTH =============================
|
||||
# Init DB using credentials data
|
||||
credentials <- data.frame(
|
||||
user = c("admin", "user"),
|
||||
password = c("admin", "user"),
|
||||
user = c("admin", "user", "user2"),
|
||||
password = c("admin", "user", "user2"),
|
||||
# password will automatically be hashed
|
||||
admin = c(TRUE, FALSE),
|
||||
admin = c(TRUE, FALSE, FALSE),
|
||||
scheme_access = c(NA, "all", "example_of_scheme"), # NA - none | all - all | string with seperate
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
# Init the database
|
||||
shinymanager::create_db(
|
||||
credentials_data = credentials,
|
||||
sqlite_path = "auth.sqlite", # will be created
|
||||
sqlite_path = "config/auth.sqlite", # will be created
|
||||
passphrase = Sys.getenv("AUTH_DB_KEY")
|
||||
# passphrase = "passphrase_wihtout_keyring"
|
||||
)
|
||||
@@ -23,10 +23,11 @@ git clone https://gitea.madelirihs.ru/madeliri/shiny_form.git
|
||||
|
||||
Восстановление окружения
|
||||
```r
|
||||
renv::activate()
|
||||
renv::init()
|
||||
```
|
||||
|
||||
# Насторйки
|
||||
# Настройки
|
||||
|
||||
## переменные окружения
|
||||
|
||||
@@ -46,7 +47,8 @@ FORM_APP_LOCAL_DB_BACKUP_PATH="path_to_backups"
|
||||
|
||||
Проверка осуществляется при каждом запуске приложения, бэкапы создаются раз в день (при первом запуске).
|
||||
|
||||
Количество сохраняемых бэкапов:
|
||||
Количество послдних сохраненных бэкапов:
|
||||
|
||||
```
|
||||
FORM_APP_LOCAL_DB_BACKUP_LIMITS=3
|
||||
```
|
||||
|
||||
560
app.R
560
app.R
@@ -1,91 +1,81 @@
|
||||
suppressPackageStartupMessages({
|
||||
library(DBI)
|
||||
library(tidyr)
|
||||
library(dplyr)
|
||||
library(purrr)
|
||||
library(magrittr)
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(shinymanager)
|
||||
})
|
||||
|
||||
# SOURCE FILES ============================
|
||||
# packages
|
||||
box::purge_cache()
|
||||
box::use(
|
||||
modules/utils,
|
||||
modules/global_options,
|
||||
modules/db,
|
||||
modules/data_validation,
|
||||
modules/scheme_generator[scheme_R6]
|
||||
bslib[...],
|
||||
shiny[...]
|
||||
)
|
||||
|
||||
global_options$set_global_options(
|
||||
shiny.host = "0.0.0.0"
|
||||
)
|
||||
|
||||
global_options$check_and_init_scheme()
|
||||
|
||||
# global vars
|
||||
# modules
|
||||
box::use(
|
||||
modules/global_options[AUTH_ENABLED]
|
||||
R/modules/utils,
|
||||
R/modules/db,
|
||||
R/modules/data_validation,
|
||||
R/app/forms,
|
||||
R/app/tasks,
|
||||
R/app/logs,
|
||||
R/modules/data_manipulations[is_this_empty_value]
|
||||
)
|
||||
|
||||
# SETTINGS ================================
|
||||
HEADER_TEXT <- config::get("form_name")
|
||||
# глобальные переменные и проверка/инициация схемы:
|
||||
box::use(
|
||||
R/modules/global_options[AUTH_ENABLED, ENABLED_SCHEMES],
|
||||
)
|
||||
|
||||
# sadasdasdasdasdas
|
||||
options(box.path = config::get("form_app_configure_path"))
|
||||
box::use(configs/enabled_schemes[enabled_schemes])
|
||||
SCHMS <- readRDS("temp/scheme.rds")
|
||||
|
||||
# CHECK FOR PANDOC
|
||||
# TEMP ! NEED TO HANDLE
|
||||
rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/")
|
||||
# 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")
|
||||
# web resources ------
|
||||
shiny::addResourcePath("www", "www")
|
||||
|
||||
|
||||
# UI =======================
|
||||
ui <- page_sidebar(
|
||||
# title = HEADER_TEXT,
|
||||
title = tagList(
|
||||
h4(HEADER_TEXT, 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",
|
||||
p("a"), p("b")
|
||||
)
|
||||
),
|
||||
title = config::get("form_name"),
|
||||
theme = bs_theme(version = 5, preset = "bootstrap"),
|
||||
header = tags$head(
|
||||
tags$link(rel = "icon", href = "www/favicon.ico")
|
||||
),
|
||||
sidebar = sidebar(
|
||||
actionButton("add_new_main_key_button", "Добавить новую запись", icon("plus", lib = "font-awesome")),
|
||||
actionButton("save_data_button", "Сохранить данные", icon("floppy-disk", lib = "font-awesome")),
|
||||
actionButton("clean_data_button", "Главная страница", icon("house", lib = "font-awesome")),
|
||||
actionButton("load_data_button", "Загрузить данные", icon("pencil", lib = "font-awesome")),
|
||||
downloadButton("downloadDocx", "get .docx (test only)"),
|
||||
# downloadButton("downloadDocx", "get .docx (test only)"),
|
||||
uiOutput("status_message"),
|
||||
textOutput("status_message2"),
|
||||
uiOutput("display_log"),
|
||||
actionButton("tasks-display_task_modal", "Задачи: нет активных", icon("list-check")),
|
||||
uiOutput("logs-display_log"),
|
||||
position = "left",
|
||||
open = list(mobile = "always")
|
||||
open = list(mobile = "always"),
|
||||
popover(
|
||||
span(
|
||||
config::get("form_app_version"),
|
||||
fontawesome::fa("circle-info", a11y = "sem", title = "Settings"),
|
||||
style = "color: #9c9c9c; position: fixed; bottom: 5px; left: 5px;"),
|
||||
title = "about",
|
||||
placement = "left",
|
||||
tagList(span("здесь пока ничего нет"), br(), span("вот"))
|
||||
)
|
||||
),
|
||||
as_fill_carrier(uiOutput("main_ui_navset")),
|
||||
|
||||
)
|
||||
|
||||
# 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
|
||||
# )
|
||||
@@ -111,8 +101,8 @@ server <- function(input, output, session) {
|
||||
res_auth <- if (AUTH_ENABLED) {
|
||||
# check_credentials directly on sqlite db
|
||||
shinymanager::secure_server(
|
||||
check_credentials = check_credentials(
|
||||
db = "auth.sqlite",
|
||||
check_credentials = shinymanager::check_credentials(
|
||||
db = "config/auth.sqlite",
|
||||
passphrase = Sys.getenv("AUTH_DB_KEY")
|
||||
),
|
||||
keep_token = TRUE
|
||||
@@ -121,6 +111,23 @@ server <- function(input, output, session) {
|
||||
NULL
|
||||
}
|
||||
|
||||
user_access <- function(string) {
|
||||
|
||||
if (is_this_empty_value(string)) return(NA)
|
||||
if (string == "all") return("all")
|
||||
|
||||
forms_access <- stringr::str_split_1(string, ", ")
|
||||
|
||||
# check if exists
|
||||
exists <- forms_access %in% ENABLED_SCHEMES
|
||||
if (!all(exists)) {
|
||||
cli::cli_warn(c("these forms is not exist:", paste("- ", forms_access[!exists])))
|
||||
}
|
||||
|
||||
# возращаем схемы для которых есть доступ
|
||||
forms_access[exists]
|
||||
}
|
||||
|
||||
# важные кнопки управления
|
||||
output$admin_buttons_panel <- renderUI({
|
||||
|
||||
@@ -131,113 +138,190 @@ 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(),
|
||||
strong("Импорт и экспорт данных для выбранной схемы:"),
|
||||
verticalLayout(
|
||||
downloadButton("downloadData", "Экспорт в .xlsx", style = "width: 250px; margin-top: 5px"),
|
||||
actionButton("button_upload_data_from_xlsx", "импорт!", icon("file-import", lib = "font-awesome"), style = "width: 250px; margin-top: 10px"),
|
||||
downloadButton("downloadData", "Экспорт базы в .xlsx", style = "width: 250px; margin-top: 5px"),
|
||||
actionButton("button_upload_data_from_xlsx", "Импорт базы из .xlsx", icon("file-import", lib = "font-awesome"), style = "width: 250px; margin-top: 10px"),
|
||||
fluid = FALSE
|
||||
),
|
||||
strong("Дополнительные опции:"),
|
||||
verticalLayout(
|
||||
actionButton("logs-show_last_actions", "Все действия", icon("scroll", lib = "font-awesome"), style = "width: 250px; margin-top: 10px"),
|
||||
downloadButton("download_data_validation_info", "Некорректно заполненные данные (.xlsx)", icon("scroll", lib = "font-awesome"), style = "width: 250px; margin-top: 10px"),
|
||||
fluid = FALSE
|
||||
)
|
||||
)
|
||||
}
|
||||
})
|
||||
|
||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
# 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,
|
||||
user_form_access = ENABLED_SCHEMES
|
||||
)
|
||||
|
||||
scheme <- reactiveVal(enabled_schemes[1]) # наименование выбранной схемы
|
||||
mhcs <- reactiveVal(schms[[enabled_schemes[1]]]) # объект для выбранной схемы
|
||||
scheme <- reactiveVal(NULL) # наименование выбранной схемы
|
||||
mhcs <- reactiveVal(NULL) # объект для выбранной схемы
|
||||
observers_started <- reactiveVal(NULL)
|
||||
|
||||
main_form_is_empty <- reactiveVal(TRUE)
|
||||
main_form_is_empty <- reactiveVal(NULL)
|
||||
validator_main <- reactiveVal(NULL)
|
||||
validator_nested <- reactiveVal(NULL)
|
||||
|
||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
# ГЛАВНАЯ СТРАНИЦА ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
output$main_ui_navset <- renderUI({
|
||||
# доступ к схемам
|
||||
observe({
|
||||
|
||||
if (main_form_is_empty()) {
|
||||
# определение доступа в завимости от условий (включена ли авторизация, и есть ли доступы)
|
||||
res <- if (AUTH_ENABLED) {
|
||||
# если администратор - полный доступ, если нет - проверка по полю
|
||||
ifelse(res_auth$admin, "all", user_access(res_auth$scheme_access))
|
||||
} else {
|
||||
# если нет авторизации - полный доступ
|
||||
"all"
|
||||
}
|
||||
if(length(res) == 0) return(NA)
|
||||
|
||||
# списки доступных схем
|
||||
allowed_schemas <- if (is.na(res)) {
|
||||
NA # нет доступа
|
||||
} else if (res == "all") {
|
||||
ENABLED_SCHEMES # все схемы
|
||||
} else {
|
||||
ENABLED_SCHEMES[ENABLED_SCHEMES == res] # только указанные
|
||||
}
|
||||
|
||||
# переопределяем переменные
|
||||
main_form_is_empty(ifelse(is.na(res), "empty", "main_menu"))
|
||||
values$user_form_access <- allowed_schemas
|
||||
scheme(values$user_form_access[1])
|
||||
mhcs(SCHMS[[values$user_form_access[1]]])
|
||||
})
|
||||
|
||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
# reactive ui -------------------------------
|
||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
## reactive ui -----------------------------------
|
||||
### main screen ------
|
||||
output$main_ui_navset <- renderUI({
|
||||
req(main_form_is_empty())
|
||||
|
||||
if (main_form_is_empty() == "main_menu") {
|
||||
validator_main(NULL)
|
||||
div(
|
||||
h5("Выбрать базу данных для работы:"),
|
||||
shiny::radioButtons(
|
||||
"schmes_selector",
|
||||
label = strong("Выбрать базу данных для работы:"),
|
||||
choices = enabled_schemes,
|
||||
label = NULL,
|
||||
choices = values$user_form_access,
|
||||
selected = scheme()
|
||||
),
|
||||
hr(),
|
||||
uiOutput("base_data"),
|
||||
hr(),
|
||||
"Для начала работы нужно создать новую запись или загрузить существующую!",
|
||||
hr(),
|
||||
# загрузка панели для работы с базой данных
|
||||
uiOutput("admin_buttons_panel")
|
||||
)
|
||||
} else {
|
||||
} else if (main_form_is_empty() == "form") {
|
||||
|
||||
# list of rendered panels
|
||||
validator_main(data_validation$init_val(mhcs()$get_scheme("main")))
|
||||
validator_main()$enable()
|
||||
mhcs()$get_main_form_ui
|
||||
|
||||
} else if (main_form_is_empty() == "empty") {
|
||||
|
||||
div(
|
||||
h5("Нет доступных баз данных для работы"),
|
||||
p("Для данного пользователя нет доступа к формам для работы."),
|
||||
p("Обратитесь к системному администратору.")
|
||||
)
|
||||
}
|
||||
})
|
||||
|
||||
### bases info ----------------
|
||||
observeEvent(main_form_is_empty(), {
|
||||
|
||||
output$base_data <- renderUI({
|
||||
|
||||
if (main_form_is_empty() == "main_menu") {
|
||||
|
||||
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]])
|
||||
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,
|
||||
@@ -276,13 +360,13 @@ server <- function(input, output, session) {
|
||||
}
|
||||
)
|
||||
|
||||
exported_df <- setNames(exported_values, input_ids) |>
|
||||
as_tibble()
|
||||
exported_df <- stats::setNames(exported_values, input_ids) |>
|
||||
dplyr::as_tibble()
|
||||
|
||||
# пайплайн для главной таблицы
|
||||
if (table_name == "main") {
|
||||
exported_df <- exported_df |>
|
||||
mutate(
|
||||
dplyr::mutate(
|
||||
!!dplyr::sym(mhcs()$get_main_key_id) := values$main_key,
|
||||
.before = 1
|
||||
)
|
||||
@@ -291,7 +375,7 @@ server <- function(input, output, session) {
|
||||
# для всех остальных таблицы (вложенные)
|
||||
if (table_name != "main") {
|
||||
exported_df <- exported_df |>
|
||||
mutate(
|
||||
dplyr::mutate(
|
||||
!!dplyr::sym(mhcs()$get_main_key_id) := values$main_key,
|
||||
!!dplyr::sym(nested_key_id) := values$nested_key,
|
||||
.before = 1
|
||||
@@ -314,8 +398,10 @@ server <- function(input, output, session) {
|
||||
# ====================================
|
||||
# NESTED FORMS =======================
|
||||
# ====================================
|
||||
|
||||
## кнопки для каждой вложенной таблицы -------------------------------
|
||||
observe({
|
||||
req(scheme())
|
||||
|
||||
# проверка инициализированы ли для этой схемы наблюдатели для кнопок вложенных таблиц
|
||||
is_observer_is_started <- (isolate(scheme()) %in% isolate(observers_started()))
|
||||
@@ -343,6 +429,7 @@ server <- function(input, output, session) {
|
||||
observers_started(c(
|
||||
isolate(observers_started()), isolate(scheme())
|
||||
))
|
||||
|
||||
})
|
||||
|
||||
## функция отображения вложенной формы для выбранной таблицы --------
|
||||
@@ -374,7 +461,7 @@ server <- function(input, output, session) {
|
||||
|
||||
# если ключ в формате даты - дать человекочитаемые данные
|
||||
if (this_nested_form_key_scheme_smoll$form_type == "date") {
|
||||
kyes_for_this_table <- setNames(
|
||||
kyes_for_this_table <- stats::setNames(
|
||||
kyes_for_this_table,
|
||||
format(as.Date(kyes_for_this_table), "%d.%m.%Y")
|
||||
)
|
||||
@@ -382,6 +469,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) {
|
||||
@@ -402,7 +490,9 @@ server <- function(input, output, session) {
|
||||
}
|
||||
)
|
||||
} else {
|
||||
|
||||
list(bslib::nav_panel("", div("Нет доступных записей.", br(), "Необходимо создать новую запись.")))
|
||||
|
||||
}
|
||||
|
||||
# ui для всплывающего окна
|
||||
@@ -457,17 +547,17 @@ server <- function(input, output, session) {
|
||||
str_cols <- which(col_types$form_type != "date")
|
||||
|
||||
values$data <- values$data |>
|
||||
select(-mhcs()$get_main_key_id) |>
|
||||
mutate(
|
||||
dplyr::select(-mhcs()$get_main_key_id) |>
|
||||
dplyr::mutate(
|
||||
dplyr::across(tidyselect::all_of({{date_cols}}), as.Date),
|
||||
dplyr::across(tidyselect::all_of({{str_cols}}), as.character),
|
||||
) |>
|
||||
arrange({{key_id}})
|
||||
dplyr::arrange({{key_id}})
|
||||
|
||||
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"),
|
||||
@@ -488,7 +578,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
|
||||
))
|
||||
@@ -502,8 +592,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)
|
||||
@@ -587,8 +678,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)
|
||||
|
||||
@@ -604,12 +695,13 @@ 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 {
|
||||
utils$clean_forms(values$nested_form_id, mhcs(), NS(values$nested_form_id))
|
||||
}
|
||||
@@ -626,7 +718,7 @@ server <- function(input, output, session) {
|
||||
|
||||
ui1 <- rlang::exec(
|
||||
.fn = utils$render_forms,
|
||||
!!!distinct(scheme_for_key_input, form_id, form_label, form_type),
|
||||
!!!dplyr::distinct(scheme_for_key_input, form_id, form_label, form_type),
|
||||
main_scheme = scheme_for_key_input
|
||||
)
|
||||
|
||||
@@ -645,8 +737,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,
|
||||
@@ -678,7 +770,7 @@ server <- function(input, output, session) {
|
||||
need(values$main_key, "⚠️ Необходимо указать id пациента!")
|
||||
)
|
||||
span(
|
||||
strong("Таблица: "), names(enabled_schemes)[enabled_schemes == scheme()],
|
||||
strong("Таблица: "), names(ENABLED_SCHEMES)[ENABLED_SCHEMES == scheme()],
|
||||
br(),
|
||||
strong("ID: "), values$main_key
|
||||
)
|
||||
@@ -697,8 +789,11 @@ server <- function(input, output, session) {
|
||||
# =========================================
|
||||
# MAIN BUTTONS LOGIC ======================
|
||||
# =========================================
|
||||
|
||||
## добавить новый главный ключ ------------------------
|
||||
### modal -------
|
||||
observeEvent(input$add_new_main_key_button, {
|
||||
req(main_form_is_empty() != "empty")
|
||||
|
||||
# данные для главного ключа
|
||||
scheme_for_key_input <- mhcs()$get_scheme("main") |>
|
||||
@@ -707,7 +802,7 @@ server <- function(input, output, session) {
|
||||
# создать форму для выбора ключа
|
||||
ui1 <- rlang::exec(
|
||||
.fn = utils$render_forms,
|
||||
!!!distinct(scheme_for_key_input, form_id, form_label, form_type),
|
||||
!!!dplyr::distinct(scheme_for_key_input, form_id, form_label, form_type),
|
||||
main_scheme = scheme_for_key_input
|
||||
)
|
||||
|
||||
@@ -723,7 +818,7 @@ server <- function(input, output, session) {
|
||||
|
||||
})
|
||||
|
||||
## действие при подтверждении (проверка нового создаваемого ключа) -------
|
||||
### подтверждение(проверка нового создаваемого ключа) -------
|
||||
observeEvent(input$confirm_create_new_main_key, {
|
||||
req(input[[mhcs()$get_main_key_id]])
|
||||
|
||||
@@ -731,7 +826,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)
|
||||
|
||||
# если введенный ключ уже есть в базе
|
||||
@@ -744,16 +838,15 @@ 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, {
|
||||
req(main_form_is_empty() == "form")
|
||||
|
||||
showModal(modalDialog(
|
||||
"Данное действие очистит все заполненные данные. Убедитесь, что нужные данные сохранены.",
|
||||
title = "Очистить форму?",
|
||||
@@ -765,16 +858,17 @@ 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
|
||||
values$main_key <- NULL
|
||||
utils$clean_forms("main", mhcs())
|
||||
main_form_is_empty(TRUE)
|
||||
main_form_is_empty("main_menu")
|
||||
|
||||
removeModal()
|
||||
showNotification("Данные очищены!", type = "warning")
|
||||
|
||||
})
|
||||
|
||||
## сохранение даннных -------------------------------
|
||||
@@ -797,13 +891,15 @@ server <- function(input, output, session) {
|
||||
)
|
||||
})
|
||||
|
||||
## список ключей для загрузки данных -------------------
|
||||
## загрузка данных -------------------
|
||||
### modal with keys -----
|
||||
observeEvent(input$load_data_button, {
|
||||
req(main_form_is_empty() != "empty")
|
||||
|
||||
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)) {
|
||||
if (length(DBI::dbListTables(con)) != 0 && "main" %in% DBI::dbListTables(con)) {
|
||||
|
||||
# GET DATA files
|
||||
ids <- db$get_keys_from_table("main", mhcs(), con)
|
||||
@@ -815,7 +911,7 @@ server <- function(input, output, session) {
|
||||
choices = ids,
|
||||
selected = NULL,
|
||||
options = list(
|
||||
placeholder = "id пациента",
|
||||
placeholder = "id",
|
||||
onInitialize = I('function() { this.setValue(""); }')
|
||||
)
|
||||
)
|
||||
@@ -840,30 +936,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
|
||||
main_form_is_empty(FALSE)
|
||||
|
||||
log_action_to_db("loading data", values$main_key, con = con)
|
||||
|
||||
} else {
|
||||
|
||||
utils$clean_forms("main", mhcs())
|
||||
|
||||
}
|
||||
|
||||
main_form_is_empty("form")
|
||||
|
||||
}
|
||||
|
||||
tasks$update_task_button_count(con, values, NS("tasks"))
|
||||
removeModal()
|
||||
|
||||
})
|
||||
@@ -874,6 +991,7 @@ server <- function(input, output, session) {
|
||||
paste0(isolate(scheme()), "_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".xlsx")
|
||||
},
|
||||
content = function(file) {
|
||||
req(main_form_is_empty() != "empty")
|
||||
|
||||
con <- db$make_db_connection(isolate(scheme()),"downloadData")
|
||||
on.exit(db$close_db_connection(con, "downloadData"), add = TRUE)
|
||||
@@ -891,7 +1009,8 @@ server <- function(input, output, session) {
|
||||
|
||||
date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)
|
||||
number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
|
||||
other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
|
||||
# other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
|
||||
other_cols <- colnames(df)[!(colnames(df) %in% c(date_columns, number_columns))]
|
||||
|
||||
df <- df |>
|
||||
dplyr::mutate(
|
||||
@@ -899,7 +1018,7 @@ server <- function(input, output, session) {
|
||||
dplyr::across(tidyselect::all_of({{date_columns}}), as.Date),
|
||||
# числа - к единому формату десятичных значений
|
||||
dplyr::across(tidyselect::all_of({{number_columns}}), ~ gsub("\\.", "," , .x)),
|
||||
dplyr::across(tidyselect::all_of({{other_cols}}), as.character)
|
||||
dplyr::across(tidyselect::all_of({{other_cols}}), \(x) dplyr::if_else(x == "", as.character(NA), as.character(x)))
|
||||
) |>
|
||||
# очистка от пустых ключей
|
||||
dplyr::filter(!is.na(mhcs()$get_main_key_id))
|
||||
@@ -911,8 +1030,8 @@ server <- function(input, output, session) {
|
||||
# добавить мета информацию
|
||||
list_of_df[["meta"]] <- dplyr::tribble(
|
||||
~`Параметр` , ~`Значение`,
|
||||
"Пользователь" , ifelse(AUTH_ENABLED, res_auth$user, "anonymous"),
|
||||
"Название базы" , names(enabled_schemes)[enabled_schemes == scheme()],
|
||||
"Пользователь" , values$current_user,
|
||||
"Название базы" , names(ENABLED_SCHEMES)[ENABLED_SCHEMES == scheme()],
|
||||
"id базы" , scheme(),
|
||||
"id формы" , config::get("form_id"),
|
||||
"ver формы" , config::get("form_app_version"),
|
||||
@@ -943,6 +1062,8 @@ server <- function(input, output, session) {
|
||||
paste0(values$main_key, "_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".docx")
|
||||
},
|
||||
content = function(file) {
|
||||
req(main_form_is_empty() != "empty")
|
||||
|
||||
# prepare YAML sections
|
||||
empty_vec <- c(
|
||||
"---",
|
||||
@@ -952,7 +1073,6 @@ server <- function(input, output, session) {
|
||||
"---",
|
||||
"\n"
|
||||
)
|
||||
box::use(modules/data_manipulations[is_this_empty_value])
|
||||
|
||||
# iterate by scheme parts
|
||||
purrr::walk(
|
||||
@@ -1032,6 +1152,7 @@ server <- function(input, output, session) {
|
||||
)
|
||||
|
||||
## import data from xlsx ----------------------
|
||||
### modal -----
|
||||
observeEvent(input$button_upload_data_from_xlsx, {
|
||||
|
||||
showModal(modalDialog(
|
||||
@@ -1055,6 +1176,7 @@ server <- function(input, output, session) {
|
||||
|
||||
})
|
||||
|
||||
### confirm --------
|
||||
observeEvent(input$button_upload_data_from_xlsx_confirm, {
|
||||
req(input$upload_xlsx)
|
||||
|
||||
@@ -1106,7 +1228,8 @@ server <- function(input, output, session) {
|
||||
|
||||
date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)
|
||||
number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
|
||||
other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
|
||||
# other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
|
||||
other_cols <- colnames(df)[!(colnames(df) %in% c(date_columns, number_columns))]
|
||||
|
||||
# функция для преобразование числовых значений и сохранения "NA"
|
||||
num_converter <- function(old_col) {
|
||||
@@ -1126,12 +1249,12 @@ server <- function(input, output, session) {
|
||||
# даты - к единому формату
|
||||
dplyr::across(tidyselect::all_of({{date_columns}}), \(x) purrr::map_chr(x, db$excel_to_db_dates_converter)),
|
||||
dplyr::across(tidyselect::all_of({{number_columns}}), num_converter),
|
||||
dplyr::across(tidyselect::all_of({{other_cols}}), as.character)
|
||||
dplyr::across(tidyselect::all_of({{other_cols}}), \(x) dplyr::if_else(x == "", as.character(NA), as.character(x)))
|
||||
) |>
|
||||
select(all_of(unique(c(main_key_id, scheme$form_id))))
|
||||
dplyr::select(tidyselect::all_of(unique(c(main_key_id, scheme$form_id))))
|
||||
|
||||
df_original <- DBI::dbReadTable(con, table_name) |>
|
||||
as_tibble()
|
||||
dplyr::as_tibble()
|
||||
|
||||
if (input$upload_data_from_xlsx_owerwrite_all_data == TRUE) {
|
||||
|
||||
@@ -1140,15 +1263,24 @@ server <- function(input, output, session) {
|
||||
} else {
|
||||
|
||||
# удаление данных в базе данных по ключам
|
||||
walk(
|
||||
.x = unique(df[[main_key_id]]),
|
||||
.f = \(main_key) {
|
||||
# purrr::walk(
|
||||
# .x = unique(df[[main_key_id]]),
|
||||
# .f = \(main_key) {
|
||||
|
||||
if (main_key %in% unique(df_original[[main_key_id]])) {
|
||||
DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE {main_key_id} = '{main_key}'"))
|
||||
}
|
||||
}
|
||||
)
|
||||
# if (main_key %in% unique(df_original[[main_key_id]])) {
|
||||
# DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE {main_key_id} = '{main_key}'"))
|
||||
# }
|
||||
# }
|
||||
# )
|
||||
|
||||
# TODO
|
||||
all_existed_keys <- unique(df_original[[main_key_id]])
|
||||
all_new_keys <- unique(df[[main_key_id]])
|
||||
|
||||
keys_to_delete <- all_existed_keys[all_existed_keys %in% all_new_keys]
|
||||
keys_to_delete <- paste0("'", keys_to_delete, "'", collapse = ", ")
|
||||
|
||||
DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE \"{main_key_id}\" IN ({keys_to_delete})"))
|
||||
|
||||
}
|
||||
|
||||
@@ -1163,13 +1295,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()
|
||||
})
|
||||
@@ -1184,7 +1318,7 @@ server <- function(input, output, session) {
|
||||
read_df_from_db_all <- function(table_name, con) {
|
||||
|
||||
# check if this table exist
|
||||
if (table_name %in% dbListTables(con)) {
|
||||
if (table_name %in% DBI::dbListTables(con)) {
|
||||
# prepare query
|
||||
query <- glue::glue("
|
||||
SELECT * FROM {table_name}
|
||||
@@ -1203,6 +1337,7 @@ server <- function(input, output, session) {
|
||||
"loading data",
|
||||
"creating new key",
|
||||
"exporting data to xlsx",
|
||||
"export validation dataset",
|
||||
"importing data from xlsx"
|
||||
),
|
||||
key = NA,
|
||||
@@ -1211,9 +1346,9 @@ server <- function(input, output, session) {
|
||||
|
||||
action <- match.arg(action)
|
||||
|
||||
action_row <- tibble(
|
||||
action_row <- dplyr::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,
|
||||
@@ -1224,61 +1359,60 @@ 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({
|
||||
# SHOW LOGS -----------------------------------
|
||||
logs$server("logs", values, scheme, mhcs)
|
||||
|
||||
# con <- db$make_db_connection(scheme(),"display_log")
|
||||
# on.exit(db$close_db_connection(con, "display_log"), add = TRUE)
|
||||
# экспорт таблицы с информации о валидации данных -------------------
|
||||
output$download_data_validation_info <- downloadHandler(
|
||||
filename = function(){
|
||||
paste0("dvinfo_", isolate(scheme()), "_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".xlsx")
|
||||
},
|
||||
content = function(file) {
|
||||
req(main_form_is_empty() != "empty")
|
||||
|
||||
# query <- if (!is.null(values$main_key)) {
|
||||
# sprintf("SELECT * FROM log WHERE key = '%s'", values$main_key)
|
||||
# } else {
|
||||
# "SELECT * FROM log"
|
||||
# }
|
||||
box::use(
|
||||
R/modules/data_validation[get_table_with_data_validation_info]
|
||||
)
|
||||
|
||||
# log_rows <- DBI::dbGetQuery(con, query)
|
||||
con <- db$make_db_connection(isolate(scheme()),"download_data_validation_info")
|
||||
on.exit(db$close_db_connection(con, "download_data_validation_info"), add = TRUE)
|
||||
|
||||
# if (nrow(log_rows) > 0) {
|
||||
list_of_df <- get_table_with_data_validation_info(mhcs(), con)
|
||||
|
||||
# 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>")
|
||||
# добавить мета информацию
|
||||
list_of_df[["meta"]] <- dplyr::tribble(
|
||||
~`Параметр` , ~`Значение`,
|
||||
"Пользователь" , values$current_user,
|
||||
"Название базы" , names(ENABLED_SCHEMES)[ENABLED_SCHEMES == scheme()],
|
||||
"id базы" , scheme(),
|
||||
"id формы" , config::get("form_id"),
|
||||
"ver формы" , config::get("form_app_version"),
|
||||
"Время выгрузки" , format(Sys.time(), "%d.%m.%Y %H:%M:%S"),
|
||||
)
|
||||
|
||||
# } else {
|
||||
# lines <- ""
|
||||
# }
|
||||
# set date params
|
||||
options("openxlsx2.dateFormat" = "dd.mm.yyyy")
|
||||
|
||||
cli::cli_alert_success("Данные успешно экспортированы")
|
||||
showNotification("Данные успешно экспортированы", type = "message")
|
||||
log_action_to_db("export validation dataset", con = con)
|
||||
|
||||
# pass tables to export
|
||||
openxlsx2::write_xlsx(
|
||||
purrr::compact(list_of_df),
|
||||
file,
|
||||
na.strings = "",
|
||||
as_table = TRUE,
|
||||
col_widths = 20
|
||||
)
|
||||
}
|
||||
)
|
||||
|
||||
# tagList(
|
||||
# paste0("ID: ", values$main_key),
|
||||
# br(),
|
||||
# p(
|
||||
# HTML(lines),
|
||||
# style = "font-size:10px;"
|
||||
# )
|
||||
# )
|
||||
# })
|
||||
# })
|
||||
}
|
||||
|
||||
app <- shiny::shinyApp(ui = ui, server = server)
|
||||
|
||||
app <- shinyApp(ui = ui, server = server)
|
||||
|
||||
runApp(app, launch.browser = TRUE)
|
||||
shiny::runApp(app, launch.browser = TRUE)
|
||||
13
config.yml
13
config.yml
@@ -1,13 +0,0 @@
|
||||
default:
|
||||
form_app_version: 0.16.0
|
||||
form_id: new_formy
|
||||
form_name: NEW FORMY
|
||||
|
||||
prod:
|
||||
form_app_configure_path: "."
|
||||
form_auth_enabled: false
|
||||
|
||||
devel:
|
||||
form_app_configure_path: _devel/antifib
|
||||
form_auth_enabled: false
|
||||
form_app_version: 0.16.0 dev
|
||||
10
config/config_example.yml
Normal file
10
config/config_example.yml
Normal file
@@ -0,0 +1,10 @@
|
||||
default:
|
||||
form_app_version: !expr config::get("form_app_version", file = "config/descr.yml")
|
||||
form_id: !expr config::get("form_id", file = "config/descr.yml")
|
||||
form_name: !expr config::get("form_name", file = "config/descr.yml")
|
||||
|
||||
prod:
|
||||
form_app_configure_path: "example_scheme"
|
||||
form_auth_enabled: false
|
||||
form_schemes:
|
||||
example_of_scheme: Тестовая база данных
|
||||
4
config/descr.yml
Normal file
4
config/descr.yml
Normal file
@@ -0,0 +1,4 @@
|
||||
default:
|
||||
form_app_version: 0.18.3
|
||||
form_id: formy
|
||||
form_name: FORMY
|
||||
@@ -1,4 +0,0 @@
|
||||
#' @export
|
||||
enabled_schemes <- c(
|
||||
`Тестовая база данных` = "example_of_scheme"
|
||||
)
|
||||
@@ -1,116 +0,0 @@
|
||||
options(box.path = here::here())
|
||||
box::use(modules/data_manipulations[is_this_empty_value])
|
||||
|
||||
#' @export
|
||||
init_val = function(scheme, ns) {
|
||||
|
||||
iv <- shinyvalidate::InputValidator$new()
|
||||
|
||||
# если передана функция с пространством имен, то происходит модификация id
|
||||
if (!missing(ns)) {
|
||||
scheme <- scheme |>
|
||||
dplyr::mutate(form_id = ns(form_id))
|
||||
}
|
||||
|
||||
# формируем список id - тип
|
||||
inputs_simple_list <- scheme |>
|
||||
dplyr::filter(!form_type %in% c("nested_forms", "description", "description_header")) |>
|
||||
dplyr::distinct(form_id, form_type) |>
|
||||
tibble::deframe()
|
||||
|
||||
# add rules to all inputs
|
||||
purrr::walk(
|
||||
.x = names(inputs_simple_list),
|
||||
.f = \(x_input_id) {
|
||||
|
||||
form_type <- inputs_simple_list[[x_input_id]]
|
||||
|
||||
choices <- dplyr::filter(scheme, form_id == {{x_input_id}}) |>
|
||||
dplyr::pull(choices)
|
||||
|
||||
val_required <- dplyr::filter(scheme, form_id == {{x_input_id}}) |>
|
||||
dplyr::distinct(required) |>
|
||||
dplyr::pull(required)
|
||||
|
||||
# for `number` type: if in `choices` column has values then parsing them to range validation
|
||||
# value `0; 250` -> transform to rule validation value from 0 to 250
|
||||
if (form_type == "number") {
|
||||
|
||||
iv$add_rule(x_input_id, val_is_a_number)
|
||||
|
||||
# проверка на соответствие диапазону значений
|
||||
if (!is.na(choices)) {
|
||||
# разделить на несколько елементов
|
||||
ranges <- as.integer(stringr::str_split_1(choices, "; "))
|
||||
|
||||
# проверка на кол-во значений
|
||||
if (length(ranges) > 3) {
|
||||
warning("Количество переданных элементов'", x_input_id, "' > 2")
|
||||
} else {
|
||||
iv$add_rule(x_input_id, val_number_within_a_range, ranges = ranges)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (form_type %in% c("select_multiple", "select_one", "radio", "checkbox")) {
|
||||
iv$add_rule(x_input_id, val_choice_within_a_dict, choices = choices)
|
||||
}
|
||||
|
||||
# if in `required` column value is `1` apply standart validation
|
||||
if (!is.na(val_required) && val_required == 1) {
|
||||
iv$add_rule(x_input_id, shinyvalidate::sv_required(message = "Необходимо заполнить."))
|
||||
}
|
||||
}
|
||||
)
|
||||
iv
|
||||
}
|
||||
|
||||
# работа с числовыми значениями ------------------
|
||||
## проверка является ли значение числом ----------
|
||||
val_is_a_number = function(x) {
|
||||
|
||||
# exit if empty
|
||||
if (is_this_empty_value(x)) return(NULL)
|
||||
# хак для пропуска значений
|
||||
if (x == "NA") return(NULL)
|
||||
|
||||
# check for numeric
|
||||
# if (grepl("^[-]?(\\d*\\,\\d+|\\d+\\,\\d*|\\d+)$", x)) NULL else "Значение должно быть числом."
|
||||
if (grepl("^[+-]?\\d*[\\.|\\,]?\\d+$", x)) NULL else "Значение должно быть числом."
|
||||
|
||||
}
|
||||
|
||||
## находится ли число в заданном диапазоне значений -------
|
||||
val_number_within_a_range = function(x, ranges) {
|
||||
|
||||
# exit if empty
|
||||
if (is_this_empty_value(x)) return(NULL)
|
||||
if (x == "NA") return(NULL)
|
||||
|
||||
# замена разделителя десятичных цифр
|
||||
x <- stringr::str_replace(x, ",", ".")
|
||||
|
||||
# check for currect value
|
||||
if (dplyr::between(as.double(x), ranges[1], ranges[2])) {
|
||||
NULL
|
||||
} else {
|
||||
glue::glue("Значение должно быть между {ranges[1]} и {ranges[2]}.")
|
||||
}
|
||||
}
|
||||
|
||||
# списки ---------------------------------------------------------
|
||||
## являются ли выбранные значения допустимы (согласно файлу схемы)
|
||||
val_choice_within_a_dict = function(x, choices) {
|
||||
|
||||
if (length(x) == 1) {
|
||||
if (is_this_empty_value(x)) return(NULL)
|
||||
}
|
||||
|
||||
# проверка на соответствие вариантов схеме ---------
|
||||
compare_to_dict <- (x %in% choices)
|
||||
if (!all(compare_to_dict)) {
|
||||
|
||||
text <- paste0("'",x[!compare_to_dict],"'", collapse = ", ")
|
||||
glue::glue("варианты, не соответствующие схеме: {text}")
|
||||
}
|
||||
}
|
||||
26
renv.lock
26
renv.lock
@@ -1,6 +1,6 @@
|
||||
{
|
||||
"R": {
|
||||
"Version": "4.3.1",
|
||||
"Version": "4.3.2",
|
||||
"Repositories": [
|
||||
{
|
||||
"Name": "CRAN",
|
||||
@@ -717,6 +717,19 @@
|
||||
],
|
||||
"Hash": "b8552d117e1b808b09a832f589b79035"
|
||||
},
|
||||
"lubridate": {
|
||||
"Package": "lubridate",
|
||||
"Version": "1.9.5",
|
||||
"Source": "Repository",
|
||||
"Repository": "CRAN",
|
||||
"Requirements": [
|
||||
"R",
|
||||
"generics",
|
||||
"methods",
|
||||
"timechange"
|
||||
],
|
||||
"Hash": "07061b348d057e8ac86771e0eff36b62"
|
||||
},
|
||||
"magrittr": {
|
||||
"Package": "magrittr",
|
||||
"Version": "2.0.3",
|
||||
@@ -1203,6 +1216,17 @@
|
||||
],
|
||||
"Hash": "79540e5fcd9e0435af547d885f184fd5"
|
||||
},
|
||||
"timechange": {
|
||||
"Package": "timechange",
|
||||
"Version": "0.4.0",
|
||||
"Source": "Repository",
|
||||
"Repository": "CRAN",
|
||||
"Requirements": [
|
||||
"R",
|
||||
"cpp11"
|
||||
],
|
||||
"Hash": "39c40cb1ad47a4cc384a34a22a29463f"
|
||||
},
|
||||
"tinytex": {
|
||||
"Package": "tinytex",
|
||||
"Version": "0.46",
|
||||
|
||||
BIN
www/favicon.ico
Normal file
BIN
www/favicon.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 295 KiB |
Reference in New Issue
Block a user