feat: валидация данных в виде модулей

app.R

@@ -31,6 +31,7 @@ global_options$set_global_options(
   shiny.host = "0.0.0.0"
   # enabled_schemes = "example_of_scheme"
 )
+global_options$check_and_init_scheme()
 
 # CHECK FOR PANDOC
 # TEMP ! NEED TO HANDLE
@@ -1186,7 +1187,7 @@ server <- function(input, output, session) {
       "exporting data to xlsx",
       "importing data from xlsx"
     ),
-    key = NULL,
+    key = NA,
     con
   ) {
 

modules/data_validation.R

@@ -1,14 +1,13 @@
+options(box.path = here::here())
+box::use(modules/data_manipulations[is_this_empty_value])
 
 #' @export
 init_val = function(scheme, ns) {
 
-  options(box.path = here::here())
-  box::use(modules/data_manipulations[is_this_empty_value])
-
   iv <- shinyvalidate::InputValidator$new()
 
   # если передана функция с пространством имен, то происходит модификация id
-  if(!missing(ns)) {
+  if (!missing(ns)) {
     scheme <- scheme |>
       dplyr::mutate(form_id = ns(form_id))
   }
@@ -37,18 +36,7 @@ init_val = function(scheme, ns) {
       # value `0; 250` -> transform to rule validation value from 0 to 250
       if (form_type == "number") {
 
-        iv$add_rule(x_input_id, function(x) {
+        iv$add_rule(x_input_id, val_is_a_number)
-          # exit if empty
-          if (is_this_empty_value(x)) {
-            return(NULL)
-          }
-          # хак для пропуска значений
-          if (x == "NA") return(NULL)
-
-          # check for numeric
-          # if (grepl("^[-]?(\\d*\\,\\d+|\\d+\\,\\d*|\\d+)$", x)) NULL else "Значение должно быть числом."
-          if (grepl("^[+-]?\\d*[\\.|\\,]?\\d+$", x)) NULL else "Значение должно быть числом."
-        })
 
         # проверка на соответствие диапазону значений
         if (!is.na(choices)) {
@@ -59,9 +47,44 @@ init_val = function(scheme, ns) {
           if (length(ranges) > 3) {
             warning("Количество переданных элементов'", x_input_id, "' > 2")
           } else {
-            iv$add_rule(
+            iv$add_rule(x_input_id, val_number_within_a_range, ranges = ranges)
-              x_input_id,
+          }
-              function(x) {
+        }
+      }
+
+      if (form_type %in% c("select_multiple", "select_one", "radio", "checkbox")) {
+        iv$add_rule(x_input_id, val_choice_within_a_dict, choices = choices)
+      }
+
+      # if in `required` column value is `1` apply standart validation
+      if (!is.na(val_required) && val_required == 1) {
+        iv$add_rule(x_input_id, shinyvalidate::sv_required(message = "Необходимо заполнить."))
+      }
+    }
+  )
+  iv
+}
+
+# работа с числовыми значениями ------------------
+## проверка является ли значение числом ----------
+val_is_a_number = function(x) {
+
+  # exit if empty
+  if (is_this_empty_value(x)) {
+    return(NULL)
+  }
+
+  # хак для пропуска значений
+  if (x == "NA") return(NULL)
+
+  # check for numeric
+  # if (grepl("^[-]?(\\d*\\,\\d+|\\d+\\,\\d*|\\d+)$", x)) NULL else "Значение должно быть числом."
+  if (grepl("^[+-]?\\d*[\\.|\\,]?\\d+$", x)) NULL else "Значение должно быть числом."
+
+}
+
+## находится ли число в заданном диапазоне значений -------
+val_number_within_a_range = function(x, ranges) {
 
   # exit if empty
   if (is_this_empty_value(x)) {
@@ -79,14 +102,11 @@ init_val = function(scheme, ns) {
   } else {
     glue::glue("Значение должно быть между {ranges[1]} и {ranges[2]}.")
   }
-              }
+}
-            )
-          }
-        }
-      }
 
-      if (form_type %in% c("select_multiple", "select_one", "radio", "checkbox")) {
+# списки ---------------------------------------------------------
-        iv$add_rule(x_input_id, function(x) {
+## являются ли выбранные значения допустимы (согласно файлу схемы)
+val_choice_within_a_dict = function(x, choices) {
 
   if (length(x) == 1) {
     if (is_this_empty_value(x)) return(NULL)
@@ -99,16 +119,4 @@ init_val = function(scheme, ns) {
     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 = "Необходимо заполнить."))
-      }
-    }
-  )
-  iv
 }

modules/db.R

@@ -202,9 +202,6 @@ write_df_to_db = function(
       dplyr::across(tidyselect::all_of({{other_cols}}), as.character),
     )
 
-  df |>
-    dplyr::glimpse()
-
   if (table_name == "main") {
     del_query <- glue::glue("DELETE FROM main WHERE {main_key_id} = '{main_key_value}'")
   }

modules/global_options.R

@@ -23,6 +23,9 @@ check_and_init_scheme = function() {
 
   cli::cli_inform(c("*" = "проверка схемы..."))
 
+  options(box.path = here::here())
+  box::use(configs/enabled_schemes[enabled_schemes])
+
   files_to_watch <- c(
     "configs/enabled_schemes.R",
     "modules/scheme_generator.R",
@@ -68,7 +71,6 @@ check_and_init_scheme = function() {
   saveRDS(exist_hash, hash_file)
 }
 
-
 init_scheme = function(scheme_file) {
 
   options(box.path = here::here())