feat: вместо встроенных таблиц - вложенные формы, перемещение кода в отдельные модули, инициация таблиц для вложенных форм

modules/data_manipulations.R

@@ -0,0 +1,25 @@
+
+#' @description Function check if variable contains some sort of empty data
+#' (NULL, NA, "", other 0-length data) and return `TRUE` (`FALSE` if data is
+#' not 'empty').
+#'
+#' Needed for proper data validation.
+check_for_empty_data <- function(value_to_check) {
+
+  # for any 0-length
+  if (length(value_to_check) == 0) return(TRUE)
+
+  # for NA
+  if (is.logical(value_to_check) && is.na(value_to_check)) return(TRUE)
+
+  # for NULL
+  if (is.null(value_to_check)) return(TRUE)
+
+  # for non-empty Date (RETURN FALSE)
+  if (inherits(value_to_check, "Date") && length(value_to_check) != 0) return(FALSE)
+
+  # for empty strings (stands before checking non-empty data for avoid mistakes)
+  if (value_to_check == "") return(TRUE)
+
+  FALSE
+}

modules/data_validation.R

@@ -0,0 +1,90 @@
+
+
+init_val <- function(scheme, ns) {
+
+  options(box.path = here::here())
+  box::use(modules/data_manipulations[check_for_empty_data])
+
+  iv <- shinyvalidate::InputValidator$new()
+
+  # если передана функция с пространством имен, то происходит модификация id
+  if(!missing(ns)) {
+    scheme <- scheme |>
+      dplyr::mutate(form_id = ns(form_id))
+  }
+
+  # формируем список id - тип
+  inputs_simple_list <- scheme |>
+    dplyr::filter(!form_type %in% c("inline_table", "inline_table2","description", "description_header")) |>
+    dplyr::distinct(form_id, form_type) |>
+    tibble::deframe()
+
+  # add rules to all inputs
+  purrr::walk(
+    .x = names(inputs_simple_list),
+    .f = \(x_input_id) {
+
+      form_type <- inputs_simple_list[[x_input_id]]
+
+      choices <- dplyr::filter(scheme, form_id == {{x_input_id}}) |>
+        dplyr::pull(choices)
+
+      val_required <- dplyr::filter(scheme, form_id == {{x_input_id}}) |>
+        dplyr::distinct(required) |>
+        dplyr::pull(required)
+
+      # for `number` type: if in `choices` column has values then parsing them to range validation
+      # value `0; 250` -> transform to rule validation value from 0 to 250
+      if (form_type == "number") {
+
+        iv$add_rule(x_input_id, function(x) {
+          # exit if empty
+          if (check_for_empty_data(x)) {
+            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)) {
+          # разделить на несколько елементов
+          ranges <- as.integer(stringr::str_split_1(choices, "; "))
+
+          # проверка на кол-во значений
+          if (length(ranges) > 3) {
+            warning("Количество переданных элементов'", x_input_id, "' > 2")
+          } else {
+            iv$add_rule(
+              x_input_id,
+              function(x) {
+
+                # замена разделителя десятичных цифр
+                x <- stringr::str_replace(x, ",", ".")
+
+                # exit if empty
+                if (check_for_empty_data(x)) {
+                  return(NULL)
+                }
+
+                # check for currect value
+                if (dplyr::between(as.double(x), ranges[1], ranges[2])) {
+                  NULL
+                } else {
+                  glue::glue("Значение должно быть между {ranges[1]} и {ranges[2]}.")
+                }
+              }
+            )
+          }
+        }
+      }
+
+      # 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

@@ -24,4 +24,110 @@ close_db_connection <- function(con, where = "") {
     warning = function(w) if (getOption("APP.DEBUG", FALSE)) message("=!= ALREADY DISCONNECTED ", where),
     finally = if (getOption("APP.DEBUG", FALSE)) message("=/= DB DISCONNECT ", where)
   )
+}
+
+#' @export
+#' проверить если таблица есть в базе данных и инициировать ее, если от
+check_if_table_is_exist_and_init_if_not <- function(
+  table_name,
+  forms_id_type_list,
+  con = rlang::env_get(rlang::caller_env(), nm = "con")
+) {
+
+  if (table_name %in% DBI::dbListTables(con)) {
+
+    cli::cli_inform("таблица есть такая: 'table_name'")
+
+    # если таблица существует, производим проверку структуры таблицы
+    compare_existing_table_with_schema(table_name, forms_id_type_list)
+
+  } else {
+
+    dummy_df <- dplyr::mutate(get_dummy_df(forms_id_type_list), id = "dummy")
+
+    # write dummy df into base, then delete dummy row
+    DBI::dbWriteTable(con, table_name, dummy_df, append = TRUE)
+    DBI::dbExecute(con, "DELETE FROM main WHERE id = 'dummy'")
+
+    cli::cli_alert_success("таблица '{table_name}' успешно создана")
+  }
+
+}
+
+get_dummy_data <- function(type) {
+
+  if (type %in% c("text", "select_one", "select_multiple")) return("dummy")
+  if (type %in% c("radio", "checkbox")) return("dummy")
+  if (type %in% c("date")) return(as.Date("1990-01-01"))
+  if (type %in% c("number")) return(as.double(999))
+
+}
+
+get_dummy_df <- function(forms_id_type_list) {
+
+  options(box.path = here::here())
+  box::use(modules/utils)
+
+  purrr::map(
+    .x = forms_id_type_list,
+    .f = utils$get_empty_data
+  ) |>
+    dplyr::as_tibble()
+
+}
+
+compare_existing_table_with_schema <- function(
+  table_name,
+  forms_id_type_list,
+  con = rlang::env_get(rlang::caller_env(), nm = "con")
+) {
+
+  options(box.path = here::here())
+  box::use(modules/utils)
+
+  # checking if db structure in form compatible with alrady writed data (in case on changig form)
+  if (identical(colnames(DBI::dbReadTable(con, table_name)), names(forms_id_type_list))) {
+    print("identical")
+  } else {
+    df_to_rewrite <- DBI::dbReadTable(con, table_name)
+    form_base_difference <- setdiff(names(forms_id_type_list), colnames(df_to_rewrite))
+    base_form_difference <- setdiff(colnames(df_to_rewrite), names(forms_id_type_list))
+
+    # if lengths are equal
+    if (length(names(forms_id_type_list)) == length(colnames(df_to_rewrite)) &&
+          length(form_base_difference) == 0 &&
+          length(base_form_difference) == 0) {
+      warning("changes in scheme file detected: assuming order changed only")
+    }
+
+    if (length(names(forms_id_type_list)) == length(colnames(df_to_rewrite)) &&
+          length(form_base_difference) != 0 &&
+          length(base_form_difference) != 0) {
+      stop("changes in scheme file detected: structure has been changed")
+    }
+
+    if (length(names(forms_id_type_list)) > length(colnames(df_to_rewrite)) && length(form_base_difference) != 0) {
+      warning("changes in scheme file detected: new inputs form was added")
+      warning("trying to adapt database")
+
+      # add empty data for each new input form
+      for (i in form_base_difference) {
+        df_to_rewrite <- df_to_rewrite |>
+          dplyr::mutate(!!dplyr::sym(i) := utils$get_empty_data(forms_id_type_list[i]))
+      }
+
+      # reorder due to scheme
+      df_to_rewrite <- df_to_rewrite |>
+        dplyr::select(dplyr::all_of(names(forms_id_type_list)))
+
+      DBI::dbWriteTable(con, table_name, df_to_rewrite, overwrite = TRUE)
+      DBI::dbExecute(con, "DELETE FROM main WHERE id = 'dummy'")
+    }
+
+    if (length(names(forms_id_type_list)) < length(colnames(df_to_rewrite))) {
+      stop("changes in scheme file detected: some of inputs form was deleted! it may cause data loss!")
+    }
+    # cleaning
+    rm(df_to_rewrite, form_base_difference)
+  }
 }

modules/utils.R

@@ -50,19 +50,28 @@ render_forms <- function(
   form_id,
   form_label,
   form_type,
-  main_scheme
+  main_scheme,
+  ns
 ) {
 
+  # заготовку для формы (проверка на выходе функции)
   form <- NULL
+
+  # параметры только для этой формы
   filterd_line <- dplyr::filter(main_scheme, form_id == {{form_id}})
 
-  # check if have condition
+  # если передана ns() функция то подмеяем id для каждой формы в соответствии с пространством имен
+  if (!missing(ns)) {
+    form_id <- ns(form_id)
+  }
+
+  # отдельно извлечение параметров условного отображения
   condition <- unique(filterd_line$condition)
 
-  # get choices from schema
+  # элементы выбора 
   choices <- filterd_line$choices
 
-  # get choices from schema
+  # описание 
   description <- unique(filterd_line) |>
     dplyr::filter(!is.na(form_description)) |>
     dplyr::distinct(form_description) |>
@@ -84,12 +93,11 @@ render_forms <- function(
     shiny::tagList(
       if (!is.na(form_label)) {
         shiny::span(form_label, style = "color: #444444; font-weight: 550; line-height: 1.4;")
-        # если в схеме есть поле с описанием - добавлеяем его следующей строчкой
+        # если в схеме есть поле с описанием - добавляем его следующей строчкой
       },
       if (!is.na(description) && !is.na(form_label)) shiny::br(),
       if (!is.na(description)) {
         shiny::span(shiny::markdown(description)) |> htmltools::tagAppendAttributes(style = "color:gray; font-size:small; line-height: 1.4;")
-        # span(description, style = "color:gray; font-size:small;")
       }
     )
   }
@@ -130,7 +138,7 @@ render_forms <- function(
     })
   }
 
-  # еденичный выбор
+  # единичный выбор
   if (form_type == "select_one") {
     form <- shiny::selectizeInput(
       inputId = form_id,
@@ -208,7 +216,8 @@ render_forms <- function(
   if (!is.na(condition)) {
     form <- shiny::conditionalPanel(
       condition = condition,
-      form
+      form,
+      ns = ifelse(missing(ns), shiny::NS(NULL), ns)
     )
   }
 
@@ -228,7 +237,6 @@ get_empty_data <- function(type) {
   if (type %in% c("number")) as.character(NA)
 }
 
-
 #' @export
 #' @description Function to update input forms (default variants only)
 #' @param id - input form id;