feat: обновление справочника значений для форм (select_one, select_multiple), проверка на соответствие схеме (валидация)

app.R

@@ -165,10 +165,15 @@ server <- function(input, output, session) {
   # ==========================================
 
   ## перенос данных из датафрейма в форму -----------------------
-  load_data_to_form <- function(df, id_and_types_list, ns) {
+  load_data_to_form <- function(
+    df,
+    table_name = "main",
+    schm,
+    ns
+  ) {
 
-    input_types <- unname(id_and_types_list)
+    input_types <- unname(schm$get_id_type_list(table_name))
-    input_ids   <- names(id_and_types_list)
+    input_ids   <- names(schm$get_id_type_list(table_name))
     if (missing(ns)) ns <- NULL
 
     # transform df to list
@@ -186,6 +191,7 @@ server <- function(input, output, session) {
           form_id = x_id,
           form_type = x_type,
           value = df[[x_id]],
+          scheme = schm$get_schema(table_name),
           ns = ns
         )
       }
@@ -524,7 +530,8 @@ server <- function(input, output, session) {
       # загрузка данных в формы
       load_data_to_form(
         df                = df,
-        id_and_types_list = values$nested_id_and_types,
+        table_name = values$nested_form_id,
+        schm,
         ns                = NS(values$nested_form_id)
       )
     }
@@ -640,7 +647,6 @@ server <- function(input, output, session) {
     on.exit(db$close_db_connection(con, "confirm_create_new_key"), add = TRUE)
 
     existed_key <- db$get_keys_from_table("main", schm, con)
-    print(existed_key)
 
     # если введенный ключ уже есть в базе
     if (input[[schm$get_main_key_id]] %in% existed_key) {
@@ -760,7 +766,8 @@ server <- function(input, output, session) {
 
     load_data_to_form(
       df = df,
-      id_and_types_list = schm$get_id_type_list("main")
+      table_name = "main",
+      schm
     )
   
     values$main_key <- input$load_data_key_selector

modules/data_validation.R

@@ -44,6 +44,7 @@ init_val <- function(scheme, ns) {
           }
           # хак для пропуска значений
           if (x == "NA") return(NULL)
+
           # check for numeric
           # if (grepl("^[-]?(\\d*\\,\\d+|\\d+\\,\\d*|\\d+)$", x)) NULL else "Значение должно быть числом."
           if (grepl("^[+-]?\\d*[\\.|\\,]?\\d+$", x)) NULL else "Значение должно быть числом."
@@ -84,6 +85,21 @@ init_val <- function(scheme, ns) {
         }
       }
 
+      if (form_type %in% c("select_multiple", "select_one")) {
+        iv$add_rule(x_input_id, function(x) {
+
+          # проверка на соответствие вариантов схеме ---------
+          compare_to_dict <- (x %in% choices)
+          if (!all(compare_to_dict)) {
+
+            text <- paste0("'",x[!compare_to_dict],"'", collapse = ", ")
+            glue::glue("Данные варианты, не соответствуют схеме: {text}")
+          }
+        })
+        
+      }
+
+
       # if in `required` column value is `1` apply standart validation
       if (!is.na(val_required) && val_required == 1) {
         iv$add_rule(x_input_id, shinyvalidate::sv_required(message = "Необходимо заполнить."))

modules/utils.R

@@ -27,10 +27,11 @@ make_panels <- function(scheme) {
   )
 
   # make page wrap
-  page_wrap <- bslib::layout_column_wrap(
+  bslib::layout_column_wrap(
     # width = "350px", height = NULL, #was 800
     width = 1 / 4, height = NULL, # was 800
     fixed_width = TRUE,
+    heights_equal = "row",
     # unpack list of cards
     !!!cards
   )
@@ -235,10 +236,14 @@ update_forms_with_data <- function(
   form_id,
   form_type,
   value,
+  scheme,
   local_delimeter = getOption("SYMBOL_DELIM"),
   ns
 ) {
 
+  filterd_line <- scheme |>
+    dplyr::filter(form_id == {{form_id}})
+
   # если передана ns() функция то подмеяем id для каждой формы в соответствии с пространством имен
   if (!missing(ns) & !is.null(ns)) {
     form_id <- ns(form_id)
@@ -262,12 +267,13 @@ update_forms_with_data <- function(
   # select_one
   if (form_type == "select_one") {
     # update choices
-    # old_choices <- subset(scheme, form_id == form_id, choices) |> dplyr::pull()
+    old_choices <- filterd_line$choices
-    # new_choices <- unique(c(old_choices, value))
+    new_choices <- unique(c(old_choices, value))
-    # new_choices <- new_choices[!is.na(new_choices)]
+    new_choices <- new_choices[!is.na(new_choices)]
 
-    # shiny::updateSelectizeInput(inputId = form_id, selected = value, choices = new_choices)
+
-    shiny::updateSelectizeInput(inputId = form_id, selected = value)
+    shiny::updateSelectizeInput(inputId = form_id, selected = value, choices = new_choices)
+    # shiny::updateSelectizeInput(inputId = form_id, selected = value)
   }
 
   # select_multiple
@@ -276,12 +282,12 @@ update_forms_with_data <- function(
     vars <- stringr::str_split_1(value, local_delimeter)
 
     # update choices
-    # old_choices <- subset(scheme, form_id == form_id, choices) |> dplyr::pull()
+    old_choices <- filterd_line$choices
-    # new_choices <- unique(c(old_choices, vars))
+    new_choices <- unique(c(old_choices, vars))
-    # new_choices <- new_choices[!is.na(new_choices)]
+    new_choices <- new_choices[!is.na(new_choices)]
 
-    # shiny::updateSelectizeInput(inputId = form_id, selected = vars, choices = new_choices)
+    shiny::updateSelectizeInput(inputId = form_id, selected = vars, choices = new_choices)
-    shiny::updateSelectizeInput(inputId = form_id, selected = vars)
+    # shiny::updateSelectizeInput(inputId = form_id, selected = vars)
   }
 
   # in other case fill with `character(0)` to proper reseting form