feat: корректная работа с главным экраном

This commit is contained in:
2026-04-13 13:44:12 +03:00
parent 1b7220e647
commit 0db162e12c
4 changed files with 56 additions and 21 deletions

2
.gitignore vendored
View File

@@ -1,6 +1,8 @@
/renv
/temp
scheme.rds
.Renviron
.DS_Store
.lintr

63
app.R
View File

@@ -16,6 +16,7 @@ box::purge_cache()
box::use(
modules/utils,
modules/global_options,
modules/global_options[enabled_schemas],
modules/db,
modules/data_validation,
modules/scheme_generator[scheme_R6]
@@ -28,6 +29,7 @@ HEADER_TEXT <- sprintf("%s (%s)", Sys.getenv("FORM_TITLE", "NA"), Sys.getenv("F
global_options$set_global_options(
shiny.host = "0.0.0.0"
# enabled_schemas = "example_of_scheme"
)
global_options$check_and_init_scheme()
@@ -48,12 +50,11 @@ ui <- page_sidebar(
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("user-plus", 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)"),
textOutput("status_message"),
textOutput("status_message2"),
uiOutput("admin_buttons_panel"),
uiOutput("display_log"),
position = "left",
open = list(mobile = "always")
@@ -93,7 +94,7 @@ if (AUTH_ENABLED) {
# SERVER LOGIC =============================
server <- function(input, output, session) {
# AUTH SETUP ========================================
# AUTH SETUP =============================================
res_auth <- if (AUTH_ENABLED) {
# check_credentials directly on sqlite db
shinymanager::secure_server(
@@ -125,10 +126,14 @@ server <- function(input, output, session) {
}
if (showing_buttons) {
fluidRow(
downloadButton("downloadData", "Экспорт в .xlsx"),
p(""), # separate buttons
actionButton("button_upload_data_from_xlsx", "импорт!", icon("file-import", lib = "font-awesome"))
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"),
fluid = FALSE
)
)
}
})
@@ -141,29 +146,32 @@ server <- function(input, output, session) {
nested_key = NULL,
nested_form_id = NULL
)
scheme <- reactiveVal("schema_example") # наименование выбранной схемы
mhcs <- reactiveVal(schms[["schema_example"]]) # объект для выбранной схемы
scheme <- reactiveVal(enabled_schemas[1]) # наименование выбранной схемы
mhcs <- reactiveVal(schms[[enabled_schemas[1]]]) # объект для выбранной схемы
observers_started <- reactiveVal(NULL)
main_form_is_empty <- reactiveVal(TRUE)
validator_main <- reactiveVal(NULL)
validator_nested <- reactiveVal(NULL)
# динамический рендеринг --------------------------
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# ГЛАВНАЯ СТРАНИЦА ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
output$main_ui_navset <- renderUI({
if (main_form_is_empty()) {
validator_main(NULL)
div(
"Для начала работы нужно создать новую запись или загрузить существующую!",
paste(getOption("enabled_schemas"), collapse = ", "),
shiny::radioButtons(
"schmes_selector",
label = "Выбрать базу данных для работы",
choices = getOption("enabled_schemas"),
label = strong("Выбрать базу данных для работы:"),
choices = enabled_schemas,
selected = scheme()
)
),
"Для начала работы нужно создать новую запись или загрузить существующую!",
# загрузка панели для работы с базой данных
uiOutput("admin_buttons_panel")
)
} else {
@@ -639,6 +647,7 @@ server <- function(input, output, session) {
# STATUSES ===============================
# вывести отображение что что-то не так
output$status_message <- renderText({
scheme()
shiny::validate(
need(values$main_key, "⚠️ Необходимо указать id пациента!")
)
@@ -829,7 +838,27 @@ server <- function(input, output, session) {
})
## export to .xlsx ====
## export to .xlsx ======================
observeEvent(input$export_to_xlsx, {
ui <- shiny::radioButtons(
"export_scheme_selector",
label = strong("Выбрать базу данных для работы:"),
choices = enabled_schemas,
selected = scheme()
)
showModal(modalDialog(
title = "чего учидил",
ui,
footer = tagList(
actionButton("one", "one"),
actionButton("close_modal_button", "Отмена")
)
))
})
output$downloadData <- downloadHandler(
filename = paste0(isolate(scheme()), "_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".xlsx"),
content = function(file) {

View File

@@ -6,7 +6,6 @@ set_global_options = function(
# APP.FILE_DB = fs::path("data.sqlite"),
shiny.host = "127.0.0.1",
shiny.port = 1337,
enabled_schemas = c("schema", "schema_example"),
...
) {
options(
@@ -15,20 +14,23 @@ set_global_options = function(
# APP.FILE_DB = APP.FILE_DB,
shiny.host = shiny.host,
shiny.port = shiny.port,
enabled_schemas = enabled_schemas,
...
)
}
#' @export
enabled_schemas <- c(`Тестовая база данных` = "example_of_scheme")
#' @export
check_and_init_scheme = function() {
cli::cli_inform(c("*" = "проверка схемы..."))
# scheme_file <- fs::path("configs/schemas", "schema.xlsx")
scheme_names <- getOption("enabled_schemas")
scheme_names <- enabled_schemas
scheme_file <- paste0("configs/schemas/", scheme_names, ".xlsx")
scheme_file <- stats::setNames(scheme_file, scheme_names)
if (!all(file.exists(scheme_file))) cli::cli_abort(c("Отсутствуют файлы схем для следующих наименований:", paste("-", names(scheme_file)[!file.exists(scheme_file)])))
db_files <- paste0("db/", scheme_names, ".sqlite")
@@ -71,6 +73,8 @@ init_scheme = function(scheme_file) {
modules/scheme_generator[scheme_R6]
)
if (!dir.exists("db")) dir.create("db")
cli::cli_h1("Инициализация схемы")
schms <- purrr::map2(
.x = scheme_file,