app_utils.R 22.1 KB
Newer Older
1
2
# DQAgui - A graphical user interface (GUI) to the functions implemented in the
# R package 'DQAstats'.
3
# Copyright (C) 2019-2022 Universitätsklinikum Erlangen
Lorenz Kapsner's avatar
Lorenz Kapsner committed
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

kapsner's avatar
kapsner committed
18

19
20
#' @title get_db_settings
#'
21
#' @param input Shiny server input object.
22
#' @param target A boolean (default: TRUE).
23
24
#' @param db_type (String) "postgres" or "oracle".
#'
25
26
27
28
#' @return This functions returns a data table of key-value pairs for the
#'   database settings, which are parsed from the respective config tab
#'   from the shiny application.
#'
29
30
31
32
33
34
35
36
#' @examples
#' if (interactive()) {
#'  get_db_settings(
#'   input = input,
#'   target = TRUE,
#'   db_type = "postgres"
#'  )
#' }
37
38
39
#'
#' @export
#'
40
get_db_settings <- function(input, target = TRUE, db_type) {
kapsner's avatar
kapsner committed
41
42
  # create description of column selections
  vec <- c("dbname", "host", "port", "user", "password")
Jonathan Mang's avatar
Jonathan Mang committed
43
  source_target <- ifelse(target, "target", "source")
44
  if (db_type == "oracle") {
Jonathan Mang's avatar
Jonathan Mang committed
45
46
    vec <- c(vec, "sid")
  }
kapsner's avatar
kapsner committed
47
48

  tab <- lapply(vec, function(g) {
49
50
    input_label_tmp <-
      paste0("config_", source_target, "_", db_type, "_", g)
Jonathan Mang's avatar
Jonathan Mang committed
51
    data.table::data.table("keys" = g, "value" = input[[input_label_tmp]])
kapsner's avatar
kapsner committed
52
53
54
55
56
  })

  tab <- do.call(rbind, tab)

  # if one column is selected multiple times
57
58
59
60
  if ("" %in% tab[, get("value")] ||
      any(tab[, grepl("\\s", get("value"))])) {
    shiny::showModal(
      modalDialog(
61
        title = "Invalid database configuration",
62
63
64
        "No empty strings or spaces allowed in database configurations."
      )
    )
kapsner's avatar
kapsner committed
65
66
67
    return(NULL)

  } else {
68
69
    outlist <- lapply(stats::setNames(vec, vec), function(g) {
      tab[get("keys") == g, get("value")]
kapsner's avatar
kapsner committed
70
71
72
73
    })
    return(outlist)
  }
}
74

75
76
#' @title This function is used in the config-tab and displays the selected
#'   system to the user.
77
78
#' @param system (String) e.g. "i2b2", "OMOP" or "CSV"
#' @param type (String) "source" or "target"
79
#' @return String containing the input params in a propper manner
80
81
#'
#'
82
83
84
feedback_txt <- function(system, type) {
  result <- paste0(
    "\U2714 ",
85
    tags$b(system),
86
    " will be used as ",
Jonathan Mang's avatar
Jonathan Mang committed
87
    DIZutils::firstup(type),
88
89
90
91
92
93
94
95
    " system.",
    "\n\n",
    "To change, simply select and save another one."
  )
  return(result)
}


96
97
98
#' @title This function is called when the user clicks on the button
#' @description "Set target == source". It sets target settings = source
#'   settings.
99
100
#'
#' @inheritParams module_dashboard_server
101
102
#'
#'
103
set_target_equal_to_source <- function(rv) {
Jonathan Mang's avatar
Jonathan Mang committed
104
  rv$target <- rv$source
105
106
  return(rv)
}
107

108
109
#' @title This function checks if all necessary input parameters
#'   for source and target exist and are valid.
110
111
#'
#' @inheritParams module_dashboard_server
112
113
#'
#'
114
validate_inputs <- function(rv, input, output, session) {
115
  error_tmp <- FALSE
116
117
  if (!is.null(rv$source$system_type) &&
      !is.null(rv$target$system_type)) {
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
    for (source_target in c("source", "target")) {
      # Only start computing if there is no error yet:
      if (!error_tmp) {
        if (rv[[source_target]]$system_type == "csv") {
          # Check if -path is valid:
          if (typeof(rv[[source_target]]$settings$path) == "character" &&
              !is.null(rv[[source_target]]$settings$path) &&
              length(rv[[source_target]]$settings$path) > 0) {
            DIZutils::feedback(
              print_this = paste0(source_target, " settings seem valid."),
              findme = "c0bcc9aa31",
              logfile_dir = rv$log$logfile_dir,
              headless = rv$headless
            )
            # valid path, so check if files exist:
            test_csv_tmp <- DQAstats::test_csv(
              settings = rv[[source_target]]$settings,
              source_db = rv[[source_target]]$system_name,
              mdr = rv$mdr,
              logfile_dir = rv$log$logfile_dir,
              headless = rv$headless
            )
            if (isTRUE(test_csv_tmp)) {
              DIZutils::feedback(
                print_this = paste0("All ",
                                    source_target,
                                    " csv-files were found."),
                findme = "794c6f3160",
                logfile_dir = rv$log$logfile_dir,
                headless = rv$headless
              )
            } else{
              DIZutils::feedback(
                print_this = paste0("Some ",
                                    source_target,
                                    " csv-files are MISSING."),
                type = "Error",
                findme = "926b0c567c",
                logfile_dir = rv$log$logfile_dir,
                headless = rv$headless
              )
159
              error_tmp <- TRUE
160
161
162
163
164
165
166
            }
          } else {
            # invalid path:
            DIZutils::feedback(
              print_this = paste0(source_target, " settings not valid."),
              type = "warning",
              findme = "10d5e79d44",
Lorenz Kapsner's avatar
Lorenz Kapsner committed
167
              ui = TRUE,
168
169
170
171
              logfile_dir = rv$log$logfile_dir,
              headless = rv$headless
            )
            DIZutils::feedback(
172
173
174
175
176
177
              print_this = paste0(
                "rv$",
                source_target,
                "$settings$path = ",
                rv[[source_target]]$settings$path
              ),
178
179
180
181
              findme = "d9b43110bb",
              logfile_dir = rv$log$logfile_dir,
              headless = rv$headless
            )
182
            error_tmp <- TRUE
183
          }
Jonathan Mang's avatar
Jonathan Mang committed
184
        } else if (rv[[source_target]]$system_type == "postgres") {
185
186
187
188
189
190
191
          error_tmp <- test_connection_button_clicked(
            rv = rv,
            source_target = source_target,
            db_type = "postgres",
            input = input,
            output = output,
            session = session
192
          )
Jonathan Mang's avatar
Jonathan Mang committed
193
        } else if (rv[[source_target]]$system_type == "oracle") {
194
195
196
197
198
199
200
          error_tmp <- test_connection_button_clicked(
            rv = rv,
            source_target = source_target,
            db_type = "oracle",
            input = input,
            output = output,
            session = session
Lorenz Kapsner's avatar
Lorenz Kapsner committed
201
          )
202
        } else {
203
          ## This system name is not known/implemented here:
Jonathan Mang's avatar
Jonathan Mang committed
204
          DIZutils::feedback(
205
206
207
208
209
210
211
212
            print_this = paste0(
              source_target,
              " system ",
              rv[[source_target]]$system_name,
              " not yet implemented."
            ),
            type = "Error",
            findme = "d0f0bfa2f3",
213
214
215
            ui = T,
            logfile_dir = rv$log$logfile_dir,
            headless = rv$headless
216
          )
217
          error_tmp <- TRUE
218
219
220
221
        }
      }
    }
  } else {
Jonathan Mang's avatar
Jonathan Mang committed
222
    DIZutils::feedback(
223
224
225
      print_this = "Either source or target system is not set.",
      type = "Warning",
      findme = "4e9400f8c9",
226
227
228
      ui = T,
      logfile_dir = rv$log$logfile_dir,
      headless = rv$headless
229
    )
230
    error_tmp <- TRUE
231
  }
232
  return(!error_tmp)
233
}
Jonathan Mang's avatar
Jonathan Mang committed
234

235
236
237
238
239
240
fix_sql_display <- function(text) {
  t <- text
  t <- gsub("\\\n", "<br>\n", t)
  t <- gsub("\\\t", "&nbsp;&nbsp;&nbsp;&nbsp;", t)
  return(t)
}
241
242


243

244
245
246
247
248
#' @title Evaluates whether the load-data button needs to be shown or not.
#' @description If there is a valid source system and a valid target system
#'   (this is also the case if the user set target == source), the result
#'   of this function will be TRUE and the button will be displayed via
#'   shinyjs. Otherwise the result is FALSE and the button will be hidden.
249
250
#'   This function also displays (or hides) the variables which can be
#'   assessed.
251
252
253
254
#'
#' @inheritParams module_config_server
#'
#'
255
check_load_data_button <- function(rv, session) {
256
  debugging <- TRUE
Jonathan Mang's avatar
Jonathan Mang committed
257
258
259
260
261
  if (debugging) {
    systems <- c("csv", "postgres", "oracle")
  } else {
    systems <- tolower(rv$system_types)
  }
262
263
264
265
266
267

  res <- ""
  if (!is.null(rv$source$system_type)) {
    if (rv$source$system_type %in% systems &&
        isTRUE(rv$target_is_source)) {
      # Source is set and target is not necessary:
Lorenz Kapsner's avatar
Lorenz Kapsner committed
268
      res <- TRUE
269
270
271
272
273
274
275

      # Catch the case where target should be source but rv$target
      # is not set yet (so assign it):
      if (is.null(rv$target$system_type) ||
          (rv$source$system_type != rv$target$system_type)) {
        rv$target <- rv$source
      }
276
277
278
279
    } else if (rv$source$system_type %in% systems &&
               !is.null(rv$target$system_type) &&
               rv$target$system_type %in% systems) {
      # Source and target are set:
280
      res <- TRUE
281
    } else {
282
      res <- FALSE
283
284
    }
  } else {
285
    res <- FALSE
286
287
288
  }

  if (res) {
289
290
291
292
293
294
295
296
297
    # Determine the different dataelements:
    helper_vars_tmp <- DQAstats::create_helper_vars(
      mdr = rv$mdr,
      target_db = rv$target$system_name,
      source_db = rv$source$system_name
    )
    rv$dqa_assessment <- helper_vars_tmp$dqa_assessment

    # Update the checkboxgroup to the determined dataelemets:
298
299
300
301
302
303
    updateCheckboxGroupInput(
      session = session,
      inputId = "select_dqa_assessment_variables",
      choices = sort(rv$dqa_assessment[["designation"]]),
      selected = rv$dqa_assessment[["designation"]]
    )
304
305
306
307

    # Show the checkboxgroup:
    shinyjs::show("config_select_dqa_assessment_box")

308
309
310
311
312
    ## Determine if time filtering is available for the source and the target
    ## system:
    time_filtering_possible <- DQAstats::check_date_restriction_requirements(
      mdr = rv$mdr,
      system_names = c(rv$source$system_name, rv$target$system_name),
313
      # restricting_date = rv$restricting_date,
314
315
316
317
      logfile_dir = rv$log$logfile_dir,
      headless = rv$headless,
      enable_stop = FALSE
    )
Jonathan Mang's avatar
Jonathan Mang committed
318
319

    if (debugging) {
Lorenz Kapsner's avatar
Lorenz Kapsner committed
320
321
322
323
      message(time_filtering_possible)
      message(rv$source$system_name)
      message(rv$target$system_name)
      message(rv$restricting_date)
Jonathan Mang's avatar
Jonathan Mang committed
324
325
    }

326
327
328
329
330
331
332
333
334
335
    if (time_filtering_possible) {
      ## Time filtering is possible, so enable the elements in the GUI:
      DIZutils::feedback(
        print_this = paste0(
          "Date restriction is possible.",
          " Showing date-picking elements in the GUI now."
        ),
        findme = "794ca3f55e",
        logfile_dir = rv$log$logfile_dir
      )
Jonathan Mang's avatar
Jonathan Mang committed
336

337
      # do not use "inputId" with moduleConfig here. doesn't work.
338
339
      shinyWidgets::updateSwitchInput(
        session = session,
340
        inputId = "date_restriction_slider",
341
342
343
344
345
346
        label = "Apply time-filtering?",
        disabled = FALSE,
        value = FALSE,
        onLabel = "Yes",
        offLabel = "No"
      )
Lorenz Kapsner's avatar
Lorenz Kapsner committed
347

348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
    } else {
      ## Time filtering is NOT possible, so disable the elements in the GUI:
      DIZutils::feedback(
        print_this = paste0(
          "Date restriction is NOT possible or needed.",
          " Hiding date-picking elements in the GUI now."
        ),
        findme = "adda589187",
        logfile_dir = rv$log$logfile_dir
      )
      shinyWidgets::updateSwitchInput(
        session = session,
        inputId = "date_restriction_slider",
        label = "No time-filtering possible",
        disabled = TRUE,
        value = FALSE
      )
      rv$restricting_date$use_it <- FALSE
Jonathan Mang's avatar
Jonathan Mang committed
366
      if (debugging) {
Lorenz Kapsner's avatar
Lorenz Kapsner committed
367
        message(rv$restricting_date)
Jonathan Mang's avatar
Jonathan Mang committed
368
      }
369
370
    }

371
    # Show load-data button:
372
    shinyjs::show("dash_load_btn")
Jonathan Mang's avatar
Jonathan Mang committed
373
374
375

    # Show sitename-configuration:
    shinyjs::show("config_sitename")
376
  } else {
377
    shinyjs::hide("config_select_dqa_assessment_box", anim = TRUE)
378
    shinyjs::hide("dash_load_btn")
379
    shinyjs::hide("datetime_picker")
Jonathan Mang's avatar
Jonathan Mang committed
380
381
382

    # Hide sitename-configuration:
    shinyjs::hide("config_sitename")
383
384
385
  }
  return(res)
}
Jonathan Mang's avatar
Jonathan Mang committed
386
387
388
389
390
391
392
393
394
395

#' @title Checks if an connection can be established to the system.
#' @description After the button "Check connection" is pressed in the GUI,
#'   this function will be called and tries to connect to this system
#'   and feedbacks the result to the user.
#'   If the connection is successfully established, the button will be
#'   disabled and this connection will be stored as valid for the given
#'   source/target system.
#'
#' @param source_target (String) "source" or "target"
396
397
398
#' @param db_type (String) "postgres" or "oracle"
#' @inheritParams module_config_server
#'
399
400
#' @return true if the connection could be established and false otherwise
#'   (also if an error occurred)
Jonathan Mang's avatar
Jonathan Mang committed
401
402
403
404
405
406
407
408
#'
test_connection_button_clicked <-
  function(rv,
           source_target,
           db_type,
           input,
           output,
           session) {
409
    error <- TRUE
Jonathan Mang's avatar
Jonathan Mang committed
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
    DIZutils::feedback(
      print_this = paste0(
        "Trying to connect to ",
        db_type,
        " as ",
        source_target,
        " system ..."
      ),
      findme = "7218f2e0fb",
      logfile_dir = rv$log$logfile_dir,
      headless = rv$headless
    )
    source_target <- tolower(source_target)
    db_type <- tolower(db_type)
    target <- ifelse(source_target == "target", TRUE, FALSE)

Jonathan Mang's avatar
Jonathan Mang committed
426
427
428
429
430
431
432
433
434
435
436
437
438
    ## If the button "set target to source" is clicked, all the gui elements
    ## are invisible for the target system but his function is also called
    ## before the final data-loading process starts to make sure that there
    ## are valid connections for source and target. So in this case
    ## (target == source is clicked), the (invisible prefilled) settings
    ## from the target gui elements are incorrectly loaded instead of the
    ## source elements. So we need to check if source == target is set and
    ## load all the source data if so:
    if (target && isTRUE(rv$target_is_source)) {
      source_target <- "source"
      target <- FALSE
    }

Jonathan Mang's avatar
Jonathan Mang committed
439
440
441
442
443
444
445
    # If we don't assign (= copy) it (input$source_oracle_presettings_list)
    # here, the value will stay reactive and change every time we
    # select another system. But it should only change if
    # we also successfully tested the connection:
    system_name_tmp <-
      paste0(source_target, "_", db_type, "_presettings_list")
    input_system <- input[[system_name_tmp]]
Jonathan Mang's avatar
Jonathan Mang committed
446
447
448
449

    rv[[source_target]]$settings <- DQAgui::get_db_settings(input = input,
                                                            target = target,
                                                            db_type = db_type)
Jonathan Mang's avatar
Jonathan Mang committed
450

451
    if (db_type == "oracle") {
Jonathan Mang's avatar
Jonathan Mang committed
452
453
454
455
      lib_path_tmp <- Sys.getenv("KDB_DRIVER")
    } else{
      lib_path_tmp <- NULL
    }
456

Jonathan Mang's avatar
Jonathan Mang committed
457
458
    if (!is.null(rv[[source_target]]$settings)) {
      rv[[source_target]]$db_con <- DIZutils::db_connection(
Jonathan Mang's avatar
Jonathan Mang committed
459
        ## db_name = rv[[source_target]]$settings$dbname,
Jonathan Mang's avatar
Jonathan Mang committed
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
        db_type = db_type,
        headless = rv$headless,
        timeout = 2,
        logfile_dir = rv$log$logfile_dir,
        from_env = FALSE,
        settings = rv[[source_target]]$settings,
        lib_path = lib_path_tmp
      )


      if (!is.null(rv[[source_target]]$db_con)) {
        DIZutils::feedback(
          paste0(
            "Connection to ",
            input_system,
            " successfully established."
          ),
          findme = "4cec24dc1b",
          logfile_dir = rv$log$logfile_dir,
          headless = rv$headless
        )
        shiny::showNotification(paste0(
          "\U2714 Connection to ",
          input_system,
          " successfully established"
        ))
        button_label <-
          paste0(source_target, "_", db_type, "_test_connection")
        shiny::updateActionButton(
          session = session,
          inputId = button_label,
          label = paste0("Connection to ",
                         input_system,
                         " established"),
          icon = shiny::icon("check")
        )
        shinyjs::disable(button_label)
497
        rv[[source_target]]$system_name <-
Jonathan Mang's avatar
Jonathan Mang committed
498
499
          rv$displaynames[get("displayname") == input_system,
                          get("source_system_name")]
Jonathan Mang's avatar
Jonathan Mang committed
500
501
502
503
504
        rv[[source_target]]$system_type <- db_type
        label_feedback_txt <-
          paste0(source_target, "_system_feedback_txt")
        output[[label_feedback_txt]] <-
          shiny::renderText({
505
            feedback_txt(system = input_system,
506
                         type = source_target)
Jonathan Mang's avatar
Jonathan Mang committed
507
          })
508
        error <- FALSE
Jonathan Mang's avatar
Jonathan Mang committed
509
510
      } else {
        shiny::showNotification(paste0("\U2718 Connection to ",
511
512
                                       input_system,
                                       " failed"))
Jonathan Mang's avatar
Jonathan Mang committed
513
514
515
        rv[[source_target]]$system <- ""
      }
    }
516
    check_load_data_button(rv, session)
517
    return(error)
Jonathan Mang's avatar
Jonathan Mang committed
518
  }
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534

#' @title Sjows an error alert modal with the hint to look into the logfile.
#'
#' @description See title.
#'
#' @param what_failed Short description of what failed.Like:
#'   "Getting the data failed."
#' '
#' @return Nothing - Just shows the alert modal.
#'
show_failure_alert <- function(what_failed) {
  text <- paste0(
    what_failed,
    ".",
    "\n\nYou can check the logfile (in the main menu) to ",
    " get more information about the cause of this error.",
535
    "\nSorry for that!\n\nYou can try again by reloading this page."
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
  )
  shinyalert::shinyalert(
    title = "Oops - This shouldn't happen!",
    text = text,
    closeOnEsc = TRUE,
    closeOnClickOutside = TRUE,
    html = FALSE,
    type = "error",
    showConfirmButton = TRUE,
    showCancelButton = FALSE,
    confirmButtonText = "OK",
    confirmButtonCol = "#AEDEF4",
    timer = 0,
    imageUrl = "",
    animation = TRUE
  )
}

print_runtime <-
  function(start_time,
           name = "",
           logfile_dir = NULL) {
    if (name == "") {
      text <- "Execution took "
    } else {
      text <- paste0("Execution of ", name, " took ")
    }
    DIZutils::feedback(
      print_this = paste0(
        text,
        format(Sys.time() - start_time),
        " using ",
        data.table::getDTthreads(),
        " threads."
      ),
      findme = "8c9db99829",
      logfile_dir = logfile_dir
    )
  }

576

577
578
579
580
datepicker_get_list_of_ranges <- function() {
  res <- list(
    "Today" = c(Sys.Date(), Sys.Date()),
    "Yesterday" = c(Sys.Date() - 1, Sys.Date()),
581
    # "Last 3 days" = c(Sys.Date() - 2, Sys.Date()),
582
    "Last 7 days" = c(Sys.Date() - 6, Sys.Date()),
583
584
585
586
587
    "Last 45 days" = c(Sys.Date() - 44, Sys.Date()),
    "Current month" = c(as.Date(format(
      Sys.Date(), "%Y-%m-01"
    )), as.Date(format(
      Sys.Date(), paste0("%Y-%m-", lubridate::days_in_month(Sys.Date())[[1]])
588
589
    ))),
    "Everything" = c(as.Date("1970-01-01"), Sys.Date())
590
  )
591

592
593
594
  ## Get list of years:
  for (i in 0:4) {
    if (i == 0) {
Jonathan Mang's avatar
Jonathan Mang committed
595
596
      ## end, today:
      end <- Sys.Date()
597
    } else {
Jonathan Mang's avatar
Jonathan Mang committed
598
      end <- as.Date(paste0(as.numeric(format(
599
600
        Sys.Date(), format = "%Y"
      )) - i, "-12-31"))
601
    }
602
603
    year <-
      as.character(as.numeric(format(Sys.Date(), format = "%Y")) - i)
604
605
606
607
608
    start <- as.Date(paste0(year, "-01-01"))
    res[[year]] <- c(start, end)
  }
  return(res)
}
609
610


611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
get_display_name_from_settings <-
  function(settings,
           inner_name = NULL,
           prefilter = NULL) {
    if (!is.null(prefilter)) {
      settings <- settings[names(settings) %in% prefilter]
    }
    return(unlist(lapply(seq_along(settings), function(i) {
      if (!is.null(settings[[i]]$nested) && settings[[i]]$nested) {
        settings[[i]]$nested <- NULL
        ## Since there is no information left of where we are now in the
        ## next recursive step, we need to provide the name of the current
        ## system as `inner_name`:
        return(get_display_name_from_settings(settings = settings[[i]],
                                              inner_name = inner_name))
      } else {
        if (is.null(settings[[i]]$displayname)) {
          if (is.null(inner_name)) {
            return(names(settings)[[i]])
          } else {
            return(inner_name)
          }
633
        } else {
634
          return(settings[[i]]$displayname)
635
        }
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
      }
    })))
  }

get_settings_from_displayname <-
  function(displayname, settings, inner_name = NULL) {
    res <- lapply(seq_along(settings), function(i) {
      if (!is.null(settings[[i]]$nested) && settings[[i]]$nested) {
        settings[[i]]$nested <- NULL
        return(
          get_settings_from_displayname(
            displayname = displayname,
            settings = settings[[i]],
            inner_name = inner_name
          )
        )
652
      } else {
653
654
655
656
657
658
659
660
661
662
663
664
665
666
        if (is.null(settings[[i]]$displayname)) {
          if (is.null(inner_name)) {
            name_to_check <- names(settings)[[i]]
          } else {
            name_to_check <- inner_name
          }
        } else {
          name_to_check <- settings[[i]]$displayname
        }
        if (DIZutils::equals2(name_to_check, displayname)) {
          return(settings[[i]])
        } else {
          return(NA)
        }
667
      }
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
    })

    ## Remove empty elements of the list:
    res <-
      res[lapply(res, function(x) {
        return(all(is.null(x)) || all(is.na(x)))
      }) == FALSE]

    if (length(res) > 1) {
      DIZutils::feedback(
        print_this = paste0(
          "Found more than one setting-list while searching for '",
          displayname,
          "'. Returning NA now."
        ),
        type = "Warning",
        findme = "f035f4923c"
      )
    } else if (length(res) == 1) {
      return(res[[1]])
    } else {
      return(NULL)
690
    }
691
  }
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732



# create summary tables
summary_table <- function() {
  return(
    data.table::data.table(
      "variable" = character(),
      "distinct" = integer(),
      "valids" = integer(),
      "missings" = integer()
    )
  )
}

# render quick check tables
render_quick_checks <- function(dat_table) {
  out <-
    DT::datatable(
      dat_table,
      options = list(
        dom = "t",
        scrollY = "30vh",
        pageLength = nrow(dat_table)
      ),
      rownames = FALSE
    ) %>%
    DT::formatStyle(columns = 2,
                    backgroundColor = DT::styleEqual(
                      c("passed", "failed"),
                      c("lightgreen", "red"))) %>%
    DT::formatStyle(columns = 3,
                    backgroundColor = DT::styleEqual(
                      c("passed", "failed"),
                      c("lightgreen", "red"))) %>%
    DT::formatStyle(columns = 4,
                    backgroundColor = DT::styleEqual(
                      c("passed", "failed"),
                      c("lightgreen", "red")))
  return(out)
}