diff --git a/app.R b/app.R index bd3b55e..d4bc5d7 100644 --- a/app.R +++ b/app.R @@ -16,42 +16,41 @@ box::use( modules/global_options, modules/db, modules/data_validation, - modules/scheme_generator[scheme_R6] + app/forms, + app/tasks ) +# global settings: global_options$set_global_options( - shiny.host = "0.0.0.0" + shiny.host = "0.0.0.0", + APP.DEBUG = FALSE ) +# init: global_options$check_and_init_scheme() -# global vars +# global vars: box::use( modules/global_options[AUTH_ENABLED] ) +enabled_schemes <- unlist(config::get()$form_schemes) +enabled_schemes <- setNames(names(enabled_schemes), enabled_schemes) -# SETTINGS ================================ -HEADER_TEXT <- config::get("form_name") +# load schemes object: +schms <- readRDS("scheme.rds") -# sadasdasdasdasdas -options(box.path = config::get("form_app_configure_path")) -box::use(configs/enabled_schemes[enabled_schemes]) - -# CHECK FOR PANDOC -# TEMP ! NEED TO HANDLE +# CHECK FOR PANDOC ---------- rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/") # TODO: dynamic button render depend on pandoc installation if (!rmarkdown::pandoc_available()) warning("Can't find pandoc!") -# SCHEME_MAIN UNPACK ========================== -schms <- readRDS("scheme.rds") # UI ======================= ui <- page_sidebar( - # title = HEADER_TEXT, + # title = config::get("form_name"), title = tagList( - h4(HEADER_TEXT, style = "margin-top: .5rem"), + h4(config::get("form_name"), style = "margin-top: .5rem"), popover( span( config::get("form_app_version"), @@ -59,7 +58,7 @@ ui <- page_sidebar( style = "color: #9c9c9c"), title = "about", placement = "left", - p("a"), p("b") + tagList(span("здесь пока ничего нет"), br(), span("вот")) ) ), theme = bs_theme(version = 5, preset = "bootstrap"), @@ -72,6 +71,7 @@ ui <- page_sidebar( uiOutput("status_message"), textOutput("status_message2"), uiOutput("display_log"), + actionButton("tasks-display_task_modal", "Задачи: нет активных", icon("list-check")), position = "left", open = list(mobile = "always") ), @@ -80,12 +80,13 @@ ui <- page_sidebar( # init auth ======================= if (AUTH_ENABLED) { + # shinymanager::set_labels("en", "Please authenticate" = "scheme()") ui <- ui |> shinymanager::secure_app( status = "primary", tags_top = tags$div( - tags$h3(HEADER_TEXT, style = "align:center"), + tags$h3(config::get("form_name"), style = "align:center"), # tags$img( # src = "https://www.r-project.org/logo/Rlogo.png", width = 100 # ) @@ -131,13 +132,14 @@ server <- function(input, output, session) { if (AUTH_ENABLED) { reactiveValuesToList(res_auth) if (res_auth$admin) { - # print("admin") } else { - # print("not_admin") showing_buttons <- FALSE } } + # update user name + values$current_user <- ifelse(AUTH_ENABLED, res_auth$user, "anonymous") + if (showing_buttons) { tagList( br(), @@ -151,13 +153,19 @@ server <- function(input, output, session) { } }) + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # REACTIVE VALUES ================================= + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # Create a reactive values object to store the input data values <- reactiveValues( data = NULL, + tasks_data = NULL, main_key = NULL, nested_key = NULL, - nested_form_id = NULL + nested_form_id = NULL, + tasks_id = NULL, + current_user = NULL ) scheme <- reactiveVal(enabled_schemes[1]) # наименование выбранной схемы @@ -169,20 +177,29 @@ server <- function(input, output, session) { validator_nested <- reactiveVal(NULL) # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - # ГЛАВНАЯ СТРАНИЦА ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # reactive ui ------------------------------- # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + ## reactive ui ----------------------------------- + ### main screen ------ output$main_ui_navset <- renderUI({ if (main_form_is_empty()) { validator_main(NULL) div( + h5("Выбрать базу данных для работы:"), shiny::radioButtons( "schmes_selector", - label = strong("Выбрать базу данных для работы:"), + label = NULL, choices = enabled_schemes, selected = scheme() ), + hr(), + uiOutput("base_data"), + hr(), "Для начала работы нужно создать новую запись или загрузить существующую!", + hr(), + # сво # загрузка панели для работы с базой данных uiOutput("admin_buttons_panel") ) @@ -192,52 +209,70 @@ server <- function(input, output, session) { validator_main(data_validation$init_val(mhcs()$get_scheme("main"))) validator_main()$enable() mhcs()$get_main_form_ui + } }) + ### bases info ---------------- + observeEvent(main_form_is_empty(), { + + output$base_data <- renderUI({ + + if (main_form_is_empty() == TRUE) { + con <- db$make_db_connection(scheme(),"base_data") + on.exit(db$close_db_connection(con, "base_data"), add = TRUE) + + tasks$update_task_button_count(con, values, NS("tasks")) + + # записей в базе всего + records_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT ({mhcs()$get_main_key_id}) FROM main")) |> + dplyr::pull() + + # задачи на сегодня + if ("tasks" %in% DBI::dbListTables(con)) { + + tasks_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM tasks WHERE task_status = 'active'")) |> + dplyr::pull() + + tasks_today_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM tasks WHERE task_status = 'active' AND task_due_date = {as.integer(Sys.Date())}")) |> + dplyr::pull() + + tasks_overdue_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM tasks WHERE task_status = 'active' AND task_due_date < {as.integer(Sys.Date())}")) |> + dplyr::pull() + + } else { + + tasks_count <- 0 + tasks_today_count <- 0 + tasks_overdue_count <- 0 + + } + + div( + h5("Общая информация о базе данных:"), + strong("Записей всего:"), records_count, + hr(), + h5("Задачи:"), + span(strong("Активных всего:"), if (tasks_count > 0) actionLink("tasks-show_dt_all", tasks_count) else "0", br()), + span(strong("Активных на сегодня:"), if (tasks_today_count > 0) actionLink("tasks-show_dt_today", tasks_today_count) else "0", br()), + span(strong("Просроченных:"), if (tasks_overdue_count > 0) actionLink("tasks-show_dt_overdue", tasks_overdue_count) else "0", br()) + ) + } + }) + }) + + # обновление данных схем ------ observeEvent(input$schmes_selector, { + scheme(input$schmes_selector) mhcs(schms[[input$schmes_selector]]) + }) # ========================================== # ОБЩИЕ ФУНКЦИИ ============================ # ========================================== - ## перенос данных из датафрейма в форму ----------------------- - load_data_to_form <- function( - df, - table_name = "main", - schm, - ns - ) { - - input_types <- unname(mhcs()$get_id_type_list(table_name)) - input_ids <- names(mhcs()$get_id_type_list(table_name)) - if (missing(ns)) ns <- NULL - - # transform df to list - # loaded_df_for_id <- as.list(df) - # loaded_df_for_id <- df[input_ids] - - # rewrite input forms - purrr::walk2( - .x = input_types, - .y = input_ids, - .f = \(x_type, x_id) { - - # updating forms with loaded data - utils$update_forms_with_data( - form_id = x_id, - form_type = x_type, - value = df[[x_id]], - scheme = mhcs()$get_scheme(table_name), - ns = ns - ) - } - ) - } - ## сохранение данных из форм в базу данных -------- save_inputs_to_db <- function( table_name, @@ -314,6 +349,7 @@ server <- function(input, output, session) { # ==================================== # NESTED FORMS ======================= # ==================================== + ## кнопки для каждой вложенной таблицы ------------------------------- observe({ @@ -343,6 +379,7 @@ server <- function(input, output, session) { observers_started(c( isolate(observers_started()), isolate(scheme()) )) + }) ## функция отображения вложенной формы для выбранной таблицы -------- @@ -382,6 +419,7 @@ server <- function(input, output, session) { # nested ui nested_form_panels <- if (!is.null(values$nested_key)) { + purrr::map( .x = unique(this_nested_form_scheme$subgroup), .f = \(subgroup) { @@ -402,7 +440,9 @@ server <- function(input, output, session) { } ) } else { + list(bslib::nav_panel("", div("Нет доступных записей.", br(), "Необходимо создать новую запись."))) + } # ui для всплывающего окна @@ -467,7 +507,7 @@ server <- function(input, output, session) { output$dt_nested <- DT::renderDataTable( DT::datatable( values$data, - caption = 'Table 1: This is a simple caption for the table.', + caption = 'В данной таблице можно изменять данные', rownames = FALSE, colnames = col_types |> dplyr::pull(form_id, form_label), extensions = c('KeyTable', "FixedColumns"), @@ -488,7 +528,7 @@ server <- function(input, output, session) { DT::dataTableOutput("dt_nested"), size = "xl", footer = tagList( - actionButton("nested_form_dt_save", "сохранить изменения") + actionButton("nested_form_dt_save", "Сохранить изменения", icon("floppy-disk")) ), easyClose = TRUE )) @@ -502,8 +542,9 @@ server <- function(input, output, session) { ### кнопка: отображение DT ----------------------------- observeEvent(input$nested_form_dt_button, { - con <- db$make_db_connection(scheme(),"nested_form_save_button") - on.exit(db$close_db_connection(con, "nested_form_save_button"), add = TRUE) + + con <- db$make_db_connection(scheme(),"nested_form_dt_button") + on.exit(db$close_db_connection(con, "nested_form_dt_button"), add = TRUE) removeModal() show_modal_for_nested_form_dt(con) @@ -587,8 +628,8 @@ server <- function(input, output, session) { observeEvent(values$nested_key, { - con <- db$make_db_connection(scheme(),"nested_tables") - on.exit(db$close_db_connection(con, "nested_tables"), add = TRUE) + con <- db$make_db_connection(scheme(),"nested_key") + on.exit(db$close_db_connection(con, "nested_key"), add = TRUE) kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, mhcs(), values$main_key, con) @@ -604,10 +645,10 @@ server <- function(input, output, session) { ) # загрузка данных в формы - load_data_to_form( + forms$load_data_to_form( df = df, table_name = values$nested_form_id, - mhcs(), + mhcs = mhcs, ns = NS(values$nested_form_id) ) } else { @@ -645,8 +686,8 @@ server <- function(input, output, session) { observeEvent(input$confirm_create_new_nested_key, { req(input[[mhcs()$get_key_id(values$nested_form_id)]]) - con <- db$make_db_connection(scheme(),"confirm_create_new_key") - on.exit(db$close_db_connection(con, "confirm_create_new_key"), add = TRUE) + con <- db$make_db_connection(scheme(),"confirm_create_new_nested_key") + on.exit(db$close_db_connection(con, "confirm_create_new_nested_key"), add = TRUE) existed_key <- db$get_nested_keys_from_table( table_name = values$nested_form_id, @@ -697,7 +738,9 @@ server <- function(input, output, session) { # ========================================= # MAIN BUTTONS LOGIC ====================== # ========================================= + ## добавить новый главный ключ ------------------------ + ### modal ------- observeEvent(input$add_new_main_key_button, { # данные для главного ключа @@ -723,7 +766,7 @@ server <- function(input, output, session) { }) - ## действие при подтверждении (проверка нового создаваемого ключа) ------- + ### подтверждение(проверка нового создаваемого ключа) ------- observeEvent(input$confirm_create_new_main_key, { req(input[[mhcs()$get_main_key_id]]) @@ -731,7 +774,6 @@ server <- function(input, output, session) { on.exit(db$close_db_connection(con, "confirm_create_new_key"), add = TRUE) new_main_key <- trimws(input[[mhcs()$get_main_key_id]]) - existed_key <- db$get_keys_from_table("main", mhcs(), con) # если введенный ключ уже есть в базе @@ -742,17 +784,14 @@ server <- function(input, output, session) { ) return() } - - 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()) + values$main_key <- new_main_key + log_action_to_db("creating new key", values$main_key, con) removeModal() }) - ## очистка всех полей ----------------------- - # show modal on click of button + ## переход на главный акран ----------------------- + ### show modal ------- observeEvent(input$clean_data_button, { showModal(modalDialog( "Данное действие очистит все заполненные данные. Убедитесь, что нужные данные сохранены.", @@ -765,7 +804,7 @@ server <- function(input, output, session) { )) }) - # when action confirm - perform action + ### when action confirm - perform action --- observeEvent(input$clean_all_action, { # rewrite all inputs with empty data @@ -775,6 +814,7 @@ server <- function(input, output, session) { removeModal() showNotification("Данные очищены!", type = "warning") + }) ## сохранение даннных ------------------------------- @@ -797,7 +837,8 @@ server <- function(input, output, session) { ) }) - ## список ключей для загрузки данных ------------------- + ## загрузка данных ------------------- + ### modal with keys ----- observeEvent(input$load_data_button, { con <- db$make_db_connection(scheme(),"load_data_button") @@ -840,30 +881,51 @@ server <- function(input, output, session) { ) }) - ## загрузка данных по главному ключу ------------------ + ### confirm ------------------ observeEvent(input$load_data, { req(input$load_data_key_selector) + values$main_key <- input$load_data_key_selector + + }) + + ## логика: смена ключа ------- + observeEvent(values$main_key, { + con <- db$make_db_connection(scheme(),"load_data") on.exit(db$close_db_connection(con, "load_data"), add = TRUE) - df <- db$read_df_from_db_by_id( - table_name = "main", - schm = mhcs(), - main_key_value = input$load_data_key_selector, - con = con - ) + if (!is.null(values$main_key)) { + existed_main_keys <- db$get_keys_from_table("main", mhcs(), con) - load_data_to_form( - df = df, - table_name = "main", - mhcs() - ) - - values$main_key <- input$load_data_key_selector - main_form_is_empty(FALSE) + if (values$main_key %in% existed_main_keys) { - log_action_to_db("loading data", values$main_key, con = con) + df <- db$read_df_from_db_by_id( + table_name = "main", + schm = mhcs(), + main_key_value = values$main_key, + con = con + ) + + forms$load_data_to_form( + df = df, + table_name = "main", + mhcs + ) + + log_action_to_db("loading data", values$main_key, con = con) + + } else { + + utils$clean_forms("main", mhcs()) + + } + + main_form_is_empty(FALSE) + + } + + tasks$update_task_button_count(con, values, NS("tasks")) removeModal() }) @@ -911,7 +973,7 @@ server <- function(input, output, session) { # добавить мета информацию list_of_df[["meta"]] <- dplyr::tribble( ~`Параметр` , ~`Значение`, - "Пользователь" , ifelse(AUTH_ENABLED, res_auth$user, "anonymous"), + "Пользователь" , values$current_user, "Название базы" , names(enabled_schemes)[enabled_schemes == scheme()], "id базы" , scheme(), "id формы" , config::get("form_id"), @@ -1032,6 +1094,7 @@ server <- function(input, output, session) { ) ## import data from xlsx ---------------------- + ### modal ----- observeEvent(input$button_upload_data_from_xlsx, { showModal(modalDialog( @@ -1055,6 +1118,7 @@ server <- function(input, output, session) { }) + ### confirm -------- observeEvent(input$button_upload_data_from_xlsx_confirm, { req(input$upload_xlsx) @@ -1163,13 +1227,15 @@ server <- function(input, output, session) { append = TRUE ) - message <- glue::glue("Данные таблицы '{table_name}' успешно обновлены (добавлено {nrow(df)} записей)") + message <- glue::glue("Данные таблицы '{table_name}' успешно загружены (добавлено {nrow(df)} записей)") showNotification( message, type = "message" ) cli::cli_alert_success(message) } + + db$db_clean_orphans(mhcs(), con) log_action_to_db("importing data from xlsx", con = con) removeModal() }) @@ -1213,7 +1279,7 @@ server <- function(input, output, session) { action_row <- tibble( date = Sys.time(), - user = ifelse(AUTH_ENABLED, res_auth$user, "anonymous"), + user = values$current_user, app_id = config::get("form_id"), app_ver = config::get("form_app_version"), remote_addr = session$request$REMOTE_ADDR, @@ -1224,58 +1290,9 @@ server <- function(input, output, session) { DBI::dbWriteTable(con, "log", action_row, append = TRUE) } - # КРАТКАЯ СВОДКА ПРО ЛОГГИНГ ------------------ - # observe({ + # TASKS --------------------------------------- + tasks$server("tasks", values, scheme, mhcs) - # output$display_log <- renderUI({ - - # con <- db$make_db_connection(scheme(),"display_log") - # on.exit(db$close_db_connection(con, "display_log"), add = TRUE) - - # query <- if (!is.null(values$main_key)) { - # sprintf("SELECT * FROM log WHERE key = '%s'", values$main_key) - # } else { - # "SELECT * FROM log" - # } - - # log_rows <- DBI::dbGetQuery(con, query) - - # if (nrow(log_rows) > 0) { - - # lines <- log_rows |> - # mutate(date = as.POSIXct(date)) |> - # mutate( - # # date = date + lubridate::hours(3), # fix datetime - # date_day = as.Date(date) - # ) |> - # mutate(cons_actions = dplyr::consecutive_id(action, user)) |> - # mutate(n_actions = row_number(), .by = c(cons_actions, user, action, date_day)) |> - # slice(which.max(n_actions), .by = c(user, action, date_day)) |> - # mutate(string_to_print = sprintf( - # "[%s %s]: %s - %s (%s)", - # format(date, "%d.%m.%y"), - # format(date, "%H:%M"), - # user, - # action, - # n_actions - # )) |> - # pull(string_to_print) |> - # paste(collapse = "
") - - # } else { - # lines <- "" - # } - - # tagList( - # paste0("ID: ", values$main_key), - # br(), - # p( - # HTML(lines), - # style = "font-size:10px;" - # ) - # ) - # }) - # }) } diff --git a/app/forms.R b/app/forms.R new file mode 100644 index 0000000..406efc3 --- /dev/null +++ b/app/forms.R @@ -0,0 +1,34 @@ +options(box.path = here::here()) +box::use( + modules/utils, +) + +#' @export +load_data_to_form <- function( + df, + table_name = "main", + mhcs, + ns +) { + + input_types <- unname(mhcs()$get_id_type_list(table_name)) + input_ids <- names(mhcs()$get_id_type_list(table_name)) + if (missing(ns)) ns <- NULL + + # rewrite input forms + purrr::walk2( + .x = input_types, + .y = input_ids, + .f = \(x_type, x_id) { + + # updating forms with loaded data + utils$update_forms_with_data( + form_id = x_id, + form_type = x_type, + value = df[[x_id]], + scheme = mhcs()$get_scheme(table_name), + ns = ns + ) + } + ) +} \ No newline at end of file diff --git a/app/tasks.R b/app/tasks.R new file mode 100644 index 0000000..4493808 --- /dev/null +++ b/app/tasks.R @@ -0,0 +1,466 @@ + +box::use( + shiny[...], + bslib[...] +) + +options(box.path = here::here()) +box::use( + modules/db, + modules/utils, + app/forms +) + +#' @export +server <- function(id, values, scheme, mhcs) { + + ns <- NS(id) + + moduleServer(id, function(input, output, session) { + + # BOOKMARKS SETUP ======================== + # observe({ + # # print(values$current_user) + # }) + + # functions ------------------- + ## new tasks ---------------- + get_default_task <- function() { + + tibble::tibble( + task_id = paste0(format(Sys.time(), "%Y%m%d%H%M%S"), "_", values$main_key), + task_main_key = values$main_key, + task_status = "active", + task_title = "НОВАЯ ЗАДАЧА", + task_description = "", + task_due_date = NA, + task_user_created = values$current_user, + task_datetime_created = Sys.time(), + task_user_last_updated = NA, + task_datetime_last_updated = NA, + task_user_completed = NA, + task_datetime_completed = NA + ) + } + + # logic --------------------- + ## modal fun ----- + show_modal_for_tasks <- function() { + + if (!is.null(values$tasks_data)) { + + tasks_selector <- values$tasks_data |> + dplyr::filter(task_status != "completed") |> + dplyr::pull(task_id) + + tasks_selector <- unique(c(values$tasks_id, tasks_selector)) + tasks_selector <- sort(tasks_selector) + + if (length(values$tasks_id) == 0) { + values$tasks_id <- if (length(tasks_selector) == 0) NULL else tasks_selector[[1]] + } + + } else { + + tasks_selector <- NULL + + } + + # ui -------------------- + # очень большой костыль + subroup_scheme <- mhcs()$get_scheme("tasks") |> + dplyr::filter(form_id != "dummy") + + tab <- if (length(tasks_selector) > 0) { + bslib::nav_panel( + title = "no name provided", + purrr::pmap( + .l = dplyr::distinct(subroup_scheme, form_id, form_label, form_type), + .f = utils$render_forms, + main_scheme = subroup_scheme, + ns = ns + ) + ) + } else { + bslib::nav_panel("", div("Нет доступных записей.", br(), "Необходимо создать новую запись.")) + } + + ui <- layout_sidebar( + sidebar = tagList( + selectizeInput(ns("tasks_id_selector"), label = "ID задачи:", choices = tasks_selector, selected = values$tasks_id), + actionButton(ns("tasks_create_new_task"), "Новая задача", icon("plus")), + actionButton(ns("tasks_add_autoreview"), "Новая авто-задача (тест)", icon("calendar")), + actionButton(ns("tasks_DT_VIEW"), "DT", icon("table")) + ), + tab + ) + + showModal(modalDialog( + ui, + size = "l", + footer = tagList( + actionButton(ns("tasks_saving_button"), "Сохранить изменения", icon("floppy-disk")) + ), + easyClose = TRUE + )) + } + + ## отображение окна ----------------- + observeEvent(input$display_task_modal, { + + if (is.null(values$main_key)) { + showNotification("необходимо выбрать запись", type = "error") + return() + } + + con <- db$make_db_connection(scheme(),"display_task_modal") + on.exit(db$close_db_connection(con, "display_task_modal"), add = TRUE) + + values$tasks_data <- if ("tasks" %in% DBI::dbListTables(con)) { + DBI::dbGetQuery(con, glue::glue("SELECT * FROM tasks WHERE task_main_key = '{values$main_key}'")) |> + dplyr::mutate(dplyr::across(c("task_datetime_created", "task_datetime_last_updated", "task_datetime_completed"), as.POSIXct)) |> + dplyr::mutate(dplyr::across(c("task_due_date"), as.Date)) + } else { + NULL + } + + values$tasks_id <- NULL + show_modal_for_tasks() + + }) + + ## изменение выбранной задачи ------- + observeEvent(input$tasks_id_selector, { + req(input$tasks_id_selector) + req(values$tasks_id) + + # выбранный ключ в форме - перемещаем в RV + values$tasks_id <- input$tasks_id_selector + + }) + + ## обновление формы при измененнии id ключа ------ + observeEvent(values$tasks_id, { + + df <- values$tasks_data |> + dplyr::filter(task_id == values$tasks_id) + + forms$load_data_to_form( + df = df, + table_name = "tasks", + mhcs + # ns = ns + ) + }) + + ## saving button ------------------------------ + observeEvent(input$tasks_saving_button, { + + con <- db$make_db_connection(scheme(),"tasks_saving_button") + on.exit(db$close_db_connection(con, "tasks_saving_button"), add = TRUE) + + id_and_types_list <- mhcs()$get_id_type_list("tasks") + input_types <- unname(id_and_types_list) + input_ids <- names(id_and_types_list) + + exported_values <- purrr::map2( + .x = input_ids, + .y = input_types, + .f = \(x_id, x_type) { + + input_d <- input[[x_id]] + + # return empty if 0 element + if (length(input_d) == 0) { + return(utils$get_empty_data(x_type)) + } else { + input_d + } + } + ) + + exported_df <- stats::setNames(exported_values, input_ids) |> + dplyr::as_tibble() + + df <- values$tasks_data + + df[df$task_id == values$tasks_id,]$task_status <- exported_df$task_status + df[df$task_id == values$tasks_id,]$task_title <- exported_df$task_title + df[df$task_id == values$tasks_id,]$task_description <- exported_df$task_description + df[df$task_id == values$tasks_id,]$task_due_date <- exported_df$task_due_date + df[df$task_id == values$tasks_id,]$task_user_last_updated <- values$current_user + df[df$task_id == values$tasks_id,]$task_datetime_last_updated <- Sys.time() + + if (exported_df$task_status == "completed") { + df[df$task_id == values$tasks_id,]$task_user_completed <- values$current_user + df[df$task_id == values$tasks_id,]$task_datetime_completed <- Sys.time() + } + + values$tasks_data <- df + + if ("tasks" %in% DBI::dbListTables(con)) { + query <- glue::glue(" + DELETE + FROM tasks + WHERE task_main_key = '{values$main_key}' + ") + DBI::dbExecute(con, query) + } + + DBI::dbWriteTable(con, "tasks", df, append = TRUE) + + update_task_button_count(con, values) + showNotification("Задача успешно создана/обновлена", type = "message") + + tasks_selector <- values$tasks_data |> + dplyr::filter(task_status != "completed") |> + dplyr::pull(task_id) + + selector <- ifelse(!values$tasks_id %in% tasks_selector, tasks_selector[1], values$tasks_id) + + updateSelectInput(inputId = "tasks_id_selector", choices = tasks_selector, selected = selector) + + }) + + ## show DT -------------------------- + observeEvent(input$tasks_DT_VIEW, { + + rename_cols <- tasks_colnames[tasks_colnames %in% colnames(values$tasks_data)] + + date_cols <- c("task_datetime_created", "task_datetime_completed", "task_datetime_last_updated", "task_due_date") + date_cols <- which(colnames(values$tasks_data) %in% date_cols) + + output$dt_tasks <- DT::renderDataTable( + DT::datatable( + values$tasks_data, + caption = 'Table 1: This is a simple caption for the table.', + rownames = FALSE, + colnames = rename_cols, + extensions = c('KeyTable', "FixedColumns"), + # editable = 'cell', + class = 'cell-border stripe', + selection = "none", + options = list( + dom = 'tip', + scrollX = TRUE, + fixedColumns = list(leftColumns = 1), + keys = TRUE, + autoWidth = TRUE, + columnDefs = list( + list( + targets = 3:4, + width = '200px', + render = htmlwidgets::JS( + "function(data, type, row, meta) {", + "return type === 'display' && data.length > 20 ?", + "'' + data.substr(0, 20) + '...' : data;", + "}") + ) + ) + ) + ) |> + DT::formatDate(date_cols, "toLocaleDateString", params = list('ru-RU')) + ) + + showModal(modalDialog( + DT::dataTableOutput(ns("dt_tasks")), + size = "xl", + # footer = tagList( + # actionButton("nested_form_dt_save", "сохранить изменения") + # ), + easyClose = TRUE + )) + + }) + + ## создание новой задачи ------------- + observeEvent(input$tasks_create_new_task, { + new_task <- get_default_task() + + values$tasks_data <- rbind(values$tasks_data, new_task) + values$tasks_id <- new_task$task_id + + tasks_selector <- values$tasks_data |> + dplyr::filter(task_status != "completed") |> + dplyr::pull(task_id) + + updateSelectInput(inputId = "tasks_id_selector", choices = tasks_selector, selected = values$tasks_id) + removeModal() + show_modal_for_tasks() + }) + + ## создание новой авто-задачи ------------- + observeEvent(input$tasks_add_autoreview, { + new_task <- get_default_task() + + new_task$task_title <- "autoreview" + new_task$task_description <- "напоминание об актуализации данных" + new_task$task_due_date <- Sys.Date() + 28 + + values$tasks_data <- rbind(values$tasks_data, new_task) + values$tasks_id <- new_task$task_id + + tasks_selector <- values$tasks_data |> + dplyr::filter(task_status != "completed") |> + dplyr::pull(task_id) + + updateSelectInput(inputId = "tasks_id_selector", choices = tasks_selector, selected = values$tasks_id) + removeModal() + show_modal_for_tasks() + }) + + # review задач ---------------- + ### все активные задачи ------------ + observeEvent(input$show_dt_all, { + + con <- db$make_db_connection(scheme(),"display_task_modal") + on.exit(db$close_db_connection(con, "display_task_modal"), add = TRUE) + + values$tasks_data <- DBI::dbGetQuery(con, glue::glue("SELECT * FROM tasks WHERE task_status = 'active'")) |> + dplyr::mutate(dplyr::across(c("task_datetime_created", "task_datetime_last_updated", "task_datetime_completed"), as.POSIXct)) |> + dplyr::mutate(dplyr::across(c("task_due_date"), as.Date)) + + display_tasks_dt_review() + }) + + ### задачи для текущего дня ------------ + observeEvent(input$show_dt_today, { + + con <- db$make_db_connection(scheme(),"display_task_modal") + on.exit(db$close_db_connection(con, "display_task_modal"), add = TRUE) + + values$tasks_data <- DBI::dbGetQuery(con, glue::glue("SELECT * FROM tasks WHERE task_status = 'active' AND task_due_date = {as.integer(Sys.Date())}")) |> + dplyr::mutate(dplyr::across(c("task_datetime_created", "task_datetime_last_updated", "task_datetime_completed"), as.POSIXct)) |> + dplyr::mutate(dplyr::across(c("task_due_date"), as.Date)) + + display_tasks_dt_review() + }) + + ### просроченные ------------ + observeEvent(input$show_dt_overdue, { + + con <- db$make_db_connection(scheme(),"display_task_modal") + on.exit(db$close_db_connection(con, "display_task_modal"), add = TRUE) + + values$tasks_data <- DBI::dbGetQuery(con, glue::glue("SELECT * FROM tasks WHERE task_status = 'active' AND task_due_date < {as.integer(Sys.Date())}")) |> + dplyr::mutate(dplyr::across(c("task_datetime_created", "task_datetime_last_updated", "task_datetime_completed"), as.POSIXct)) |> + dplyr::mutate(dplyr::across(c("task_due_date"), as.Date)) + + display_tasks_dt_review() + }) + + ### modal ----- + display_tasks_dt_review <- function() { + + values$tasks_data <- values$tasks_data |> + dplyr::select(task_id:task_datetime_last_updated) + + rename_cols <- tasks_colnames[tasks_colnames %in% colnames(values$tasks_data)] + + date_cols <- c("task_datetime_created", "task_datetime_completed", "task_datetime_last_updated", "task_due_date") + date_cols <- which(colnames(values$tasks_data) %in% date_cols) + + output$dt_todays_tasks <- DT::renderDataTable( + DT::datatable( + values$tasks_data, + caption = 'Table 1: This is a simple caption for the table.', + rownames = FALSE, + colnames = rename_cols, + extensions = c("FixedColumns"), + # editable = 'cell', + selection = "single", + options = list( + dom = 'tip', + scrollX = TRUE, + fixedColumns = list(leftColumns = 1), + autoWidth = TRUE, + columnDefs = list( + list( + targets = 3:4, + width = '200px', + render = htmlwidgets::JS( + "function(data, type, row, meta) {", + "return type === 'display' && data.length > 20 ?", + "'' + data.substr(0, 20) + '...' : 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" +) diff --git a/config.yml b/config.yml index 28e3c7d..9acd10a 100644 --- a/config.yml +++ b/config.yml @@ -6,8 +6,15 @@ default: prod: form_app_configure_path: "." form_auth_enabled: false + form_schemes: + example_of_scheme: Тестовая база данных + main_register: АВЗ и АМИЛОИОДОЗЫ devel: - form_app_configure_path: _devel/antifib + form_app_configure_path: _devel/new_bases form_auth_enabled: false - form_app_version: 0.16.0 dev \ No newline at end of file + form_app_version: 0.16.0 dev + form_schemes: + antifib: антифибротическая + d2tra_t: D2TRA_test + \ No newline at end of file diff --git a/configs/enabled_schemes.R b/configs/enabled_schemes.R deleted file mode 100644 index 568ef30..0000000 --- a/configs/enabled_schemes.R +++ /dev/null @@ -1,4 +0,0 @@ -#' @export -enabled_schemes <- c( - `Тестовая база данных` = "example_of_scheme" -) \ No newline at end of file diff --git a/modules/data_validation.R b/modules/data_validation.R index 3314c78..21d15f9 100644 --- a/modules/data_validation.R +++ b/modules/data_validation.R @@ -71,6 +71,7 @@ val_is_a_number = function(x) { # exit if empty if (is_this_empty_value(x)) return(NULL) + # хак для пропуска значений if (x == "NA") return(NULL) @@ -82,7 +83,7 @@ val_is_a_number = function(x) { ## находится ли число в заданном диапазоне значений ------- val_number_within_a_range = function(x, ranges) { - + # exit if empty if (is_this_empty_value(x)) return(NULL) if (x == "NA") return(NULL) diff --git a/modules/db.R b/modules/db.R index ffd4db3..ec5ba1d 100644 --- a/modules/db.R +++ b/modules/db.R @@ -3,7 +3,7 @@ #' @description Function to open connection to db, disigned to easy dubugging. #' @param where text mark to distingiush calss make_db_connection = function(scheme, where = "") { - if (getOption("APP.DEBUG", FALSE)) message("=== DB CONNECT ", where) + DBI::dbConnect(RSQLite::SQLite(), fs::path( config::get("form_app_configure_path"), "db", @@ -46,14 +46,13 @@ check_if_table_is_exist_and_init_if_not = function( if (table_name %in% DBI::dbListTables(con)) { - cli::cli_inform(c("*" = "проверка таблицы в базе данных: '{table_name}'")) - # если таблица существует, производим проверку структуры таблицы compare_existing_table_with_schema( table_name = table_name, schm = schm ) + # инициализируем все таблицы } else { if (table_name == "main") { @@ -63,6 +62,7 @@ check_if_table_is_exist_and_init_if_not = function( .before = 1 ) } + if (table_name != "main") { dummy_df <- get_dummy_df(forms_id_type_list) |> dplyr::mutate( @@ -121,6 +121,8 @@ compare_existing_table_with_schema = function( con = rlang::env_get(rlang::caller_env(), nm = "con") ) { + cli::cli_progress_step("проверка таблицы в базе данных: '{table_name}'") + main_key <- schm$get_main_key_id key_id <- schm$get_key_id(table_name) forms_ids <- schm$get_forms_ids(table_name) @@ -403,3 +405,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} орфанных записей") + + } + +} diff --git a/modules/global_options.R b/modules/global_options.R index 2f06e4a..2e1c798 100644 --- a/modules/global_options.R +++ b/modules/global_options.R @@ -43,19 +43,16 @@ check_and_init_scheme = function() { options(box.path = here::here()) box::use(modules/db[local_db_backup]) - options(box.path = config::get("form_app_configure_path")) - box::use(configs/enabled_schemes[enabled_schemes]) - # список файлов, изменение которых, приведут к переинициализиации схемы files_to_watch <- c( - fs::path(config::get("form_app_configure_path"), "configs", "enabled_schemes.R"), + "config.yml", "modules/scheme_generator.R", "modules/utils.R" ) - scheme_names <- enabled_schemes - scheme_file <- paste0(config::get("form_app_configure_path"), "/configs/schemas/", scheme_names, ".xlsx") - scheme_file <- stats::setNames(scheme_file, scheme_names) + scheme_names <- names(config::get()$form_schemes) + scheme_file <- paste0(config::get("form_app_configure_path"), "/configs/schemas/", scheme_names, ".xlsx") + scheme_file <- stats::setNames(scheme_file, scheme_names) if (!all(file.exists(scheme_file))) { cli::cli_abort(c("Отсутствуют файлы схем для следующих наименований:", paste("-", names(scheme_file)[!file.exists(scheme_file)]))) @@ -113,6 +110,7 @@ init_scheme = function(scheme_file) { if (!dir.exists(db_path)) dir.create(db_path) cli::cli_h1("Инициализация схемы") + schms <- purrr::map2( .x = scheme_file, .y = names(scheme_file), @@ -121,8 +119,15 @@ init_scheme = function(scheme_file) { con <- db$make_db_connection(y) on.exit(db$close_db_connection(con), add = TRUE) + # новый объект schm <- scheme_R6$new(x) + + # проверка схемы с существующей базой данных и инициализация таблиц db$check_if_table_is_exist_and_init_if_not(schm, con) + + # удаление орфанных записей + + db$db_clean_orphans(schm = schm, con = con) schm } ) @@ -132,13 +137,13 @@ init_scheme = function(scheme_file) { names(schms), \(x) schms[[x]]$nested_tables_names ) + nested_tables_ids <- unlist(nested_tables_ids) tab <- table(nested_tables_ids) # если встречается хоть одно значение несколько раз - начать истошно кричать (могут возникнуть пробемы при вызове всплывающих окон в формах) if (!all(!tab > 1)) { cli::cli_abort(c("В одной или нескольких схемах наименования вложенных форм совпадают:", paste("-", names(tab)[tab > 1]))) - } saveRDS(schms, "scheme.rds") diff --git a/modules/scheme_generator.R b/modules/scheme_generator.R index 58a07f9..fd837ac 100644 --- a/modules/scheme_generator.R +++ b/modules/scheme_generator.R @@ -40,6 +40,19 @@ scheme_R6 <- R6::R6Class( } ) + # отдельно для тасков + private$schemes_list[["tasks"]] <- tibble::tribble( + ~ form_id, ~form_type, ~form_label, ~form_description, ~choices, + "dummy", "text", "dummy", "dummy", NA, + "task_status", "select_one", "Статус задачи", NA, "active", + "task_status", "select_one", "Статус задачи", NA, "completed", + "task_status", "select_one", "Статус задачи", NA, "deleted", + "task_title", "text", "Название задачи", NA, NA, + "task_description", "text", "Описание задачи", "краткое описание", "3", + "task_due_date", "date", "Дата выполнения задачи", NA, NA, + ) |> + dplyr::mutate(condition = NA) + # extract main key private$main_key_id <- self$get_key_id("main") @@ -78,6 +91,7 @@ scheme_R6 <- R6::R6Class( get_scheme = function(table_name) { private$schemes_list[[table_name]] }, + ## с полями имеющие значение ------- get_scheme_with_values_forms = function(table_name) { private$schemes_list[[table_name]] |> @@ -117,7 +131,7 @@ scheme_R6 <- R6::R6Class( nested_forms_names = NA, bslib_rendered_ui = NA, excluded_types = c("nested_forms", "description", "description_header"), - reserved_table_names = c("meta", "log", "main"), + reserved_table_names = c("meta", "log", "main", "tasks"), load_scheme_from_xlsx = function(sheet_name) { diff --git a/modules/utils.R b/modules/utils.R index 0efd8fe..6541065 100644 --- a/modules/utils.R +++ b/modules/utils.R @@ -135,7 +135,8 @@ render_forms = function( form <- shiny::textAreaInput( inputId = form_id, label = label, - rows = 1 + rows = 1, + resize = "none" ) } @@ -263,7 +264,7 @@ update_forms_with_data = function( local_delimeter = getOption("SYMBOL_DELIM"), ns ) { - + options(box.path = here::here()) box::use(modules/data_manipulations[is_this_empty_value])