feat: возможность отражения информации действий по базам данных

Reviewed-on: madeliri/shiny_form#1

.Rprofile

@@ -4,7 +4,6 @@ source("renv/activate.R")
 (function() {
 
   paths <- c(
-    "R_CONFIG_ACTIVE",
     "AUTH_DB_KEY"
   )
 
@@ -18,3 +17,27 @@ 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", "="))
+
+  }
+
+})()
+
+
+# при первом запуске скопировать пример конфига
+(function() {
+
+  if (!file.exists("config.yml")) {
+    file.copy("config_example.yml", "config.yml")
+  }
+
+})()
+

.gitignore

@@ -3,6 +3,8 @@
 /_devel
 
 scheme.rds
+config.yml
+
 .Renviron
 .DS_Store
 .lintr

CHANGELOG.md

@@ -1,3 +1,19 @@
+### 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 таблиц;

README.md

@@ -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
 ```

app.R

@@ -16,71 +16,72 @@ box::use(
   modules/global_options,
   modules/db,
   modules/data_validation,
-  modules/scheme_generator[scheme_R6]
+  app/forms,
+  app/tasks,
+  app/logs,
+  modules/data_manipulations[is_this_empty_value]
 )
 
+# global settings:
 global_options$set_global_options(
-  shiny.host = "0.0.0.0"
+  shiny.host = "0.0.0.0",
-  # APP.DEBUG = TRUE
+  APP.DEBUG = FALSE
 )
+
+# init:
 global_options$check_and_init_scheme()
 
-# global 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)
 
-# MODULES
+# load schemes object:
-box::use(app/forms)
+schms <- readRDS("scheme.rds")
-box::use(app/tasks)
 
-# refactor LATER ---------
+# CHECK FOR PANDOC ----------
-vv <- unlist(config::get()$form_schemes)
+# rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/")
-enabled_schemes <- names(vv)
-vvvv            <- unname(vv)
-names(enabled_schemes) <- vvvv
-# ------------------------
-
-# CHECK FOR PANDOC
-# TEMP ! NEED TO HANDLE
-rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/")
 
 # TODO: dynamic button render depend on pandoc installation
 if (!rmarkdown::pandoc_available()) warning("Can't find pandoc!")
 
-# SCHEME_MAIN UNPACK ==========================
+# web resources ------
-schms <- readRDS("scheme.rds")
+shiny::addResourcePath("www", "www")
+
 
 # UI =======================
 ui <- page_sidebar(
-  # title = config::get("form_name"),
+  title = config::get("form_name"),
-  title = tagList(
-    h4(config::get("form_name"), style = "margin-top: .5rem"),
-    popover(
-      span(
-        config::get("form_app_version"), 
-        fontawesome::fa("circle-info", a11y = "sem", title = "Settings"),
-        style = "color: #9c9c9c"),
-      title = "about",
-      placement = "left",
-      tagList(span("здесь пока ничего нет"), br(), span("вот"))
-    )
-  ),
   theme = bs_theme(version = 5, preset = "bootstrap"),
+  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")),
-    actionButton("tasks-display_task_modal", "Задачи: нет активных"),
+    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 =======================
@@ -127,6 +128,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({
 
@@ -137,9 +155,7 @@ server <- function(input, output, session) {
     if (AUTH_ENABLED) {
       reactiveValuesToList(res_auth)
       if (res_auth$admin) {
-        # print("admin")
       } else {
-        # print("not_admin")
         showing_buttons <- FALSE
       }
     }
@@ -149,43 +165,25 @@ server <- function(input, output, session) {
 
     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"),
           fluid = FALSE 
+        ),
+        strong("Дополнительные опции:"),
+        verticalLayout(
+          actionButton("logs-show_last_actions", "Все действия", icon("scroll", lib = "font-awesome"), style = "width: 250px; margin-top: 10px"),
+          fluid = FALSE
         )
       )
     }
   })
 
-  output$base_data <- renderUI({
+  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-    con <- db$make_db_connection(scheme(),"base_data")
-    on.exit(db$close_db_connection(con, "base_data"), add = TRUE)
-
-    # записей в базе всего
-    query <- glue::glue("SELECT COUNT ({mhcs()$get_main_key_id}) FROM main")
-    records_count <- DBI::dbGetQuery(con, query) |>
-      dplyr::pull()
-
-    # задачи на сегодня
-    if ("tasks" %in% DBI::dbListTables(con)) {
-      query <- glue::glue("SELECT COUNT (task_id) FROM tasks WHERE task_status = 'active'")
-      tasks_count <- DBI::dbGetQuery(con, query) |>
-        dplyr::pull()
-    } else {
-      tasks_count <- 0
-    }
-
-    div(
-      strong("Записей всего:"), records_count, br(),
-      if (tasks_count > 0) p(strong("Задач на сегодня:"), actionLink("tasks-show_dt_today", tasks_count)) else "Задач нет"
-    )
-  })
-
   # REACTIVE VALUES =================================
+  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
   # Create a reactive values object to store the input data
   values <- reactiveValues(
     data             = NULL,
@@ -194,50 +192,146 @@ server <- function(input, output, session) {
     nested_key       = NULL,
     nested_form_id   = NULL,
     tasks_id         = NULL,
-    current_user = NULL
+    current_user     = NULL,
+    user_form_access = enabled_schemes
   )
 
-  scheme <- reactiveVal(enabled_schemes[1]) # наименование выбранной схемы
+  scheme <- reactiveVal(NULL) # наименование выбранной схемы
-  mhcs   <- reactiveVal(schms[[enabled_schemes[1]]]) # объект для выбранной схемы
+  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)
 
-  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  # доступ к схемам
-  # ГЛАВНАЯ СТРАНИЦА ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  observe({
-  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  output$main_ui_navset <- renderUI({
 
-    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("Выбрать базу данных для работы:"),
+          label = NULL,
-          choices = enabled_schemes,
+          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]])
+
   })
 
   # ==========================================
@@ -320,8 +414,10 @@ server <- function(input, output, session) {
   # ====================================
   # NESTED FORMS =======================
   # ====================================
+
   ## кнопки для каждой вложенной таблицы -------------------------------
   observe({
+    req(scheme())
 
     # проверка инициализированы ли для этой схемы наблюдатели для кнопок вложенных таблиц
     is_observer_is_started <- (isolate(scheme()) %in% isolate(observers_started()))
@@ -349,6 +445,7 @@ server <- function(input, output, session) {
     observers_started(c(
       isolate(observers_started()), isolate(scheme())
     ))
+
   })
 
   ## функция отображения вложенной формы для выбранной таблицы --------
@@ -388,6 +485,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) {
@@ -408,7 +506,9 @@ server <- function(input, output, session) {
         }
       )
     } else {
+
       list(bslib::nav_panel("", div("Нет доступных записей.", br(), "Необходимо создать новую запись.")))
+
     }
 
     # ui для всплывающего окна 
@@ -473,7 +573,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"),
@@ -494,7 +594,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
     ))
@@ -508,8 +608,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)
@@ -593,8 +694,8 @@ server <- function(input, output, session) {
 
   observeEvent(values$nested_key, {
 
-    con <- db$make_db_connection(scheme(),"nested_tables")
+    con <- db$make_db_connection(scheme(),"nested_key")
-    on.exit(db$close_db_connection(con, "nested_tables"), add = TRUE)
+    on.exit(db$close_db_connection(con, "nested_key"), add = TRUE)
 
     kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, mhcs(), values$main_key, con)
 
@@ -616,6 +717,7 @@ server <- function(input, output, session) {
         mhcs              = mhcs,
         ns                = NS(values$nested_form_id)
       )
+
     } else {
       utils$clean_forms(values$nested_form_id, mhcs(), NS(values$nested_form_id))
     }
@@ -651,8 +753,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")
+    con <- db$make_db_connection(scheme(),"confirm_create_new_nested_key")
-    on.exit(db$close_db_connection(con, "confirm_create_new_key"), add = TRUE)
+    on.exit(db$close_db_connection(con, "confirm_create_new_nested_key"), add = TRUE)
 
     existed_key <- db$get_nested_keys_from_table(
       table_name = values$nested_form_id,
@@ -707,6 +809,7 @@ server <- function(input, output, session) {
   ## добавить новый главный ключ  ------------------------
   ### modal -------
   observeEvent(input$add_new_main_key_button, {
+    req(main_form_is_empty() != "empty")
 
     # данные для главного ключа
     scheme_for_key_input <- mhcs()$get_scheme("main") |>
@@ -758,6 +861,8 @@ server <- function(input, output, session) {
   ## переход на главный акран -----------------------
   ### show modal  -------
   observeEvent(input$clean_data_button, {
+    req(main_form_is_empty() == "form")
+
     showModal(modalDialog(
       "Данное действие очистит все заполненные данные. Убедитесь, что нужные данные сохранены.",
       title = "Очистить форму?",
@@ -775,7 +880,7 @@ server <- function(input, output, session) {
     # 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")
@@ -805,6 +910,7 @@ 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"))
@@ -856,11 +962,11 @@ server <- function(input, output, session) {
 
   ## логика: смена ключа -------
   observeEvent(values$main_key, {
-    req(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) {
@@ -886,10 +992,11 @@ server <- function(input, output, session) {
 
       }
 
-    # обновление счетичка задач
+      main_form_is_empty("form")
-    tasks$update_task_button_count(con, values, NS("tasks"))
 
-    main_form_is_empty(FALSE)
+    }
+
+    tasks$update_task_button_count(con, values, NS("tasks"))
     removeModal()
 
   })
@@ -900,6 +1007,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)
@@ -917,7 +1025,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(
@@ -925,7 +1034,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))
@@ -969,6 +1078,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(
         "---",
@@ -978,7 +1089,6 @@ server <- function(input, output, session) {
         "---",
         "\n"
       )
-      box::use(modules/data_manipulations[is_this_empty_value])
 
       # iterate by scheme parts
       purrr::walk(
@@ -1134,7 +1244,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) {
@@ -1154,7 +1265,7 @@ 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))))
 
@@ -1191,13 +1302,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()
   })
@@ -1255,6 +1368,9 @@ server <- function(input, output, session) {
   # TASKS ---------------------------------------
   tasks$server("tasks", values, scheme, mhcs)
 
+  # SHOW LOGS -----------------------------------
+  logs$server("logs", values, scheme, mhcs)
+
 }
 
 

app/forms.R

@@ -3,7 +3,6 @@ box::use(
   modules/utils,
 )
 
-
 #' @export
 load_data_to_form <- function(
   df,
@@ -16,10 +15,6 @@ load_data_to_form <- function(
   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,

app/logs.R

@@ -0,0 +1,129 @@
+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) {
+
+    # отображение 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"
+)

app/tasks.R

@@ -1,4 +1,3 @@
-
 box::use(
   shiny[...],
   bslib[...]
@@ -24,12 +23,33 @@ server <- function(id, values, scheme, mhcs) {
     # })
 
     # 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::filter(task_status == "active") |>
           dplyr::pull(task_id)
 
         tasks_selector <- unique(c(values$tasks_id, tasks_selector))
@@ -40,7 +60,9 @@ server <- function(id, values, scheme, mhcs) {
         }
 
       } else {
+
         tasks_selector <- NULL
+
       }
 
       # ui --------------------
@@ -65,9 +87,9 @@ server <- function(id, values, scheme, mhcs) {
       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"), "new_task"),
+          actionButton(ns("tasks_create_new_task"), "Новая задача", icon("plus")),
-          actionButton(ns("tasks_add_autoreview"), "add autotask"),
+          actionButton(ns("tasks_add_autoreview"), "Новая авто-задача (тест)", icon("calendar")),
-          actionButton(ns("tasks_DT_VIEW"), "DT")
+          actionButton(ns("tasks_DT_VIEW"), "DT", icon("table"))
         ),
         tab
       )
@@ -76,44 +98,33 @@ server <- function(id, values, scheme, mhcs) {
         ui,
         size = "l",
         footer = tagList(
-          actionButton(ns("tasks_saving_button"), "сохранить изменения")
+          actionButton(ns("tasks_saving_button"), "Сохранить изменения", icon("floppy-disk"))
         ),
         easyClose = TRUE
       ))
     }
 
-    ## 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
-      )
-    }
-
-    # button logic ---------------------
     ## отображение окна -----------------
     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
@@ -151,6 +162,11 @@ server <- function(id, values, scheme, mhcs) {
       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)
@@ -217,23 +233,41 @@ server <- function(id, values, scheme, mhcs) {
     ## 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 = col_types |> dplyr::pull(form_id, form_label),
+          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
+            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(c("task_datetime_created", "task_datetime_completed", "task_datetime_last_updated", "task_due_date"), "toLocaleDateString", params = list('ru-RU'))
+          DT::formatDate(date_cols, "toLocaleDateString", params = list('ru-RU'))
       )
 
       showModal(modalDialog(
@@ -283,8 +317,9 @@ server <- function(id, values, scheme, mhcs) {
       show_modal_for_tasks()
     })
 
-    ## отображение списка задач для текущего дня ------------
+    # review задач ----------------
-    observeEvent(input$show_dt_today, {
+    ### все активные задачи ------------
+    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)
@@ -293,36 +328,90 @@ server <- function(id, values, scheme, mhcs) {
         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 = col_types |> dplyr::pull(form_id, form_label),
+          colnames = rename_cols,
-          extensions = c('KeyTable', "FixedColumns"),
+          extensions = c("FixedColumns"),
           # editable = 'cell',
+          class = 'cell-border stripe',
           selection = "single",
           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(c("task_datetime_created", "task_datetime_completed", "task_datetime_last_updated", "task_due_date"), "toLocaleDateString", params = list('ru-RU'))
+        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")
+          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)) {
@@ -330,14 +419,11 @@ server <- function(id, values, scheme, mhcs) {
       } else {
 
         # get key
-        new_main_key <- values$tasks_data[input$dt_todays_tasks_rows_selected,]$task_main_key
+        main_key_to_jump <- values$tasks_data[input$dt_todays_tasks_rows_selected,]$task_main_key
-        values$main_key <- new_main_key
+        values$main_key <- main_key_to_jump
 
-        showNotification("TODO: если ключа нет в таблице?!", type = "warning", duration = NULL)
         removeModal()
 
-        # log_action_to_db("loading data", values$main_key, con = con)
-
       }
     })
 
@@ -350,9 +436,19 @@ 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 {
@@ -361,3 +457,18 @@ update_task_button_count <- function(con, values, ns) {
   }
 
 }
+
+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"
+)

config.yml

@@ -1,18 +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
-  form_schemes:
-    example_of_scheme: Тестовая база данных
-    main_register: АВЗ и АМИЛОИОДОЗЫ
-
-devel:
-  form_app_configure_path: _devel/antifib
-  form_auth_enabled: false
-  form_app_version: 0.16.0 dev
-  form_schemes:
-    antifib: антифибротическая

config_example.yml

@@ -0,0 +1,10 @@
+default:
+  form_app_version: !expr config::get("form_app_version", file = "descr.yml")
+  form_id:          !expr config::get("form_id", file = "descr.yml")
+  form_name:        !expr config::get("form_name", file = "descr.yml")
+
+prod:
+  form_app_configure_path: "example_scheme"
+  form_auth_enabled: false
+  form_schemes:
+    example_of_scheme: Тестовая база данных

descr.yml

@@ -0,0 +1,4 @@
+default:
+  form_app_version: 0.18.1
+  form_id: formy
+  form_name: FORMY

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)
 

modules/db.R

@@ -10,6 +10,7 @@ make_db_connection = function(scheme, where = "") {
     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(
@@ -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)
@@ -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} орфанных записей")
+
+  }
+
+}

modules/global_options.R

@@ -10,15 +10,19 @@ set_global_options = function(
   
   config_params_to_check <- c(
     "form_app_version",
+    "form_id",
+    "form_name",
     "form_app_configure_path",
     "form_auth_enabled",
-    "form_id",
+    "form_schemes"
-    "form_name"
   )
   
   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(
@@ -50,8 +54,13 @@ check_and_init_scheme = function() {
     "modules/utils.R"
   )
 
+  # проверка существования отслеживаемых файлов
+  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"), "/configs/schemas/", scheme_names, ".xlsx")
+  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))) {
@@ -110,6 +119,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),
@@ -118,8 +128,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
     }
   )
@@ -129,13 +146,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")

modules/scheme_generator.R

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

modules/utils.R

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

utils/init_login_db.r

@@ -3,10 +3,11 @@
 # SETUP AUTH =============================
 # Init DB using credentials data
 credentials <- data.frame(
-  user     = c("admin", "user"),
+  user     = c("admin", "user", "user2"),
-  password = c("admin", "user"),
+  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
 )