app_utils.R 15.8 KB
Newer Older
1
2
# DQAgui - A graphical user interface (GUI) to the functions implemented in the
# R package 'DQAstats'.
Jonathan Mang's avatar
Jonathan Mang committed
3
# Copyright (C) 2019-2020 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

# create summary tables
20
21
22
23
24
25
26
27
28
summary_table <- function() {
  return(
    data.table::data.table(
      "variable" = character(),
      "distinct" = integer(),
      "valids" = integer(),
      "missings" = integer()
    )
  )
kapsner's avatar
kapsner committed
29
30
31
}

# render quick check tables
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
render_quick_checks <- function(dat_table) {
  out <-
    DT::datatable(
      dat_table,
      options = list(
        dom = "t",
        scrollY = "30vh",
        pageLength = nrow(dat_table)
      ),
      rownames = F
    ) %>%
    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")
                    ))
kapsner's avatar
kapsner committed
58
59
60
  return(out)
}

61
62
#' @title get_db_settings
#'
63
#' @param input Shiny server input object
64
#' @param target A boolean (default: TRUE).
Jonathan Mang's avatar
Jonathan Mang committed
65
#' @param db_type (String) "postgres" or "oracle"
66
67
68
#'
#' @export
#'
Jonathan Mang's avatar
Jonathan Mang committed
69
get_db_settings <- function(input, target = T, db_type) {
kapsner's avatar
kapsner committed
70
71
  # create description of column selections
  vec <- c("dbname", "host", "port", "user", "password")
Jonathan Mang's avatar
Jonathan Mang committed
72
73
74
75
  source_target = ifelse(target, "target", "source")
  if(db_type == "oracle") {
    vec <- c(vec, "sid")
  }
kapsner's avatar
kapsner committed
76
77

  tab <- lapply(vec, function(g) {
Jonathan Mang's avatar
Jonathan Mang committed
78
79
    input_label_tmp <- paste0("config_", source_target, "_", db_type, "_", g)
    data.table::data.table("keys" = g, "value" = input[[input_label_tmp]])
kapsner's avatar
kapsner committed
80
81
82
83
84
  })

  tab <- do.call(rbind, tab)

  # if one column is selected multiple times
85
86
87
88
  if ("" %in% tab[, get("value")] ||
      any(tab[, grepl("\\s", get("value"))])) {
    shiny::showModal(
      modalDialog(
89
        title = "Invalid database configuration",
90
91
92
        "No empty strings or spaces allowed in database configurations."
      )
    )
kapsner's avatar
kapsner committed
93
94
95
    return(NULL)

  } else {
96
97
    outlist <- lapply(stats::setNames(vec, vec), function(g) {
      tab[get("keys") == g, get("value")]
kapsner's avatar
kapsner committed
98
99
100
101
    })
    return(outlist)
  }
}
102

103
104
#' @title This function is used in the config-tab and displays the selected
#'   system to the user.
105
106
#' @param system (String) e.g. "i2b2", "OMOP" or "CSV"
#' @param type (String) "source" or "target"
107
#' @return String containing the input params in a propper manner
108
109
#'
#'
110
111
112
feedback_txt <- function(system, type) {
  result <- paste0(
    "\U2714 ",
113
    tags$b(system),
114
    " will be used as ",
Jonathan Mang's avatar
Jonathan Mang committed
115
    DIZutils::firstup(type),
116
117
118
119
120
121
122
123
    " system.",
    "\n\n",
    "To change, simply select and save another one."
  )
  return(result)
}


124
125
126
#' @title This function is called when the user clicks on the button
#' @description "Set target == source". It sets target settings = source
#'   settings.
127
128
#'
#' @inheritParams module_dashboard_server
129
130
#'
#'
131
132
133
134
135
136
set_target_equal_to_source <- function(rv) {
  rv$target$settings <- rv$source$settings
  rv$target$system_type <- rv$source$system_type
  rv$target$system_name <- rv$source$system_name
  return(rv)
}
137

138
139
#' @title This function checks if all necessary input parameters
#'   for source and target exist and are valid.
140
141
#'
#' @inheritParams module_dashboard_server
142
143
#'
#'
144
validate_inputs <- function(rv, input, output, session) {
145
146
147
  error_tmp <- F
  if (!is.null(rv$source$system_type) &&
      !is.null(rv$target$system_type)) {
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
    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
              )
              error_tmp <- T
            }
          } else {
            # invalid path:
            DIZutils::feedback(
              print_this = paste0(source_target, " settings not valid."),
              type = "warning",
              findme = "10d5e79d44",
              ui = T,
              logfile_dir = rv$log$logfile_dir,
              headless = rv$headless
            )
            DIZutils::feedback(
              print_this = paste0("rv$",
                                  source_target,
                                  "$settings$path = ",
                                  rv[[source_target]]$settings$path),
              findme = "d9b43110bb",
              logfile_dir = rv$log$logfile_dir,
              headless = rv$headless
            )
            error_tmp <- T
          }
Jonathan Mang's avatar
Jonathan Mang committed
212
        } else if (rv[[source_target]]$system_type == "postgres") {
213
214
215
216
217
218
219
          error_tmp <- test_connection_button_clicked(
            rv = rv,
            source_target = source_target,
            db_type = "postgres",
            input = input,
            output = output,
            session = session
220
          )
Jonathan Mang's avatar
Jonathan Mang committed
221
        } else if (rv[[source_target]]$system_type == "oracle") {
222
223
224
225
226
227
228
          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
229
          )
230
        } else {
231
          ## This system name is not known/implemented here:
Jonathan Mang's avatar
Jonathan Mang committed
232
          DIZutils::feedback(
233
234
235
236
237
238
239
240
            print_this = paste0(
              source_target,
              " system ",
              rv[[source_target]]$system_name,
              " not yet implemented."
            ),
            type = "Error",
            findme = "d0f0bfa2f3",
241
242
243
            ui = T,
            logfile_dir = rv$log$logfile_dir,
            headless = rv$headless
244
245
246
247
248
249
          )
          error_tmp <- T
        }
      }
    }
  } else {
Jonathan Mang's avatar
Jonathan Mang committed
250
    DIZutils::feedback(
251
252
253
      print_this = "Either source or target system is not set.",
      type = "Warning",
      findme = "4e9400f8c9",
254
255
256
      ui = T,
      logfile_dir = rv$log$logfile_dir,
      headless = rv$headless
257
258
259
    )
    error_tmp <- T
  }
260
  return(!error_tmp)
261
}
Jonathan Mang's avatar
Jonathan Mang committed
262

263
264
265
266
267
268
fix_sql_display <- function(text) {
  t <- text
  t <- gsub("\\\n", "<br>\n", t)
  t <- gsub("\\\t", "&nbsp;&nbsp;&nbsp;&nbsp;", t)
  return(t)
}
269
270


271

272
273
274
275
276
#' @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.
277
278
#'   This function also displays (or hides) the variables which can be
#'   assessed.
279
280
281
282
#'
#' @inheritParams module_config_server
#'
#'
283
check_load_data_button <- function(rv, session) {
284
285
  # systems <- c("csv", "postgres", "oracle")
  systems <- tolower(rv$system_types)
286
287
288
289
290
291
292

  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:
      res <- T
293
294
295
296
297
298
299

      # 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
      }
300
301
302
303
304
305
306
307
308
309
310
311
312
    } 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:
      res <- T
    } else {
      res <- F
    }
  } else {
    res <- F
  }

  if (res) {
313
314
315
316
317
318
    # 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
    )
319
    # print(helper_vars_tmp)
320
321
322
    rv$dqa_assessment <- helper_vars_tmp$dqa_assessment

    # Update the checkboxgroup to the determined dataelemets:
323
324
325
326
327
328
    updateCheckboxGroupInput(
      session = session,
      inputId = "select_dqa_assessment_variables",
      choices = sort(rv$dqa_assessment[["designation"]]),
      selected = rv$dqa_assessment[["designation"]]
    )
329
330
331
332
333

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

    # Show load-data button:
334
    shinyjs::show("dash_load_btn")
Jonathan Mang's avatar
Jonathan Mang committed
335
336
337

    # Show sitename-configuration:
    shinyjs::show("config_sitename")
338
  } else {
339
    shinyjs::hide("config_select_dqa_assessment_box", anim = TRUE)
340
    shinyjs::hide("dash_load_btn")
Jonathan Mang's avatar
Jonathan Mang committed
341
342
343

    # Hide sitename-configuration:
    shinyjs::hide("config_sitename")
344
345
346
  }
  return(res)
}
Jonathan Mang's avatar
Jonathan Mang committed
347
348
349
350
351
352
353
354
355
356

#' @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"
357
358
359
#' @param db_type (String) "postgres" or "oracle"
#' @inheritParams module_config_server
#'
360
361
#' @return true if the connection could be established and false otherwise
#'   (also if an error occurred)
Jonathan Mang's avatar
Jonathan Mang committed
362
363
364
365
366
367
368
369
#'
test_connection_button_clicked <-
  function(rv,
           source_target,
           db_type,
           input,
           output,
           session) {
370
    error <- TRUE
Jonathan Mang's avatar
Jonathan Mang committed
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
    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)

    # 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]]
    rv[[source_target]]$settings <-
      DQAgui::get_db_settings(input = input, target = target, db_type = db_type)
396
397
    # print("Settings for db:")
    # print(rv[[source_target]]$settings)
Jonathan Mang's avatar
Jonathan Mang committed
398

399
    if (db_type == "oracle") {
Jonathan Mang's avatar
Jonathan Mang committed
400
401
402
403
      lib_path_tmp <- Sys.getenv("KDB_DRIVER")
    } else{
      lib_path_tmp <- NULL
    }
404

Jonathan Mang's avatar
Jonathan Mang committed
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
    if (!is.null(rv[[source_target]]$settings)) {
      rv[[source_target]]$db_con <- DIZutils::db_connection(
        db_name = rv[[source_target]]$settings$dbname,
        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)
        rv[[source_target]]$system_name <- input_system
        rv[[source_target]]$system_type <- db_type
        label_feedback_txt <-
          paste0(source_target, "_system_feedback_txt")
        output[[label_feedback_txt]] <-
          shiny::renderText({
451
            feedback_txt(system = input_system,
Jonathan Mang's avatar
Jonathan Mang committed
452
453
                                  type = source_target)
          })
454
        error <- FALSE
Jonathan Mang's avatar
Jonathan Mang committed
455
456
457
458
459
460
461
      } else {
        shiny::showNotification(paste0("\U2718 Connection to ",
                                input_system,
                                " failed"))
        rv[[source_target]]$system <- ""
      }
    }
462
    check_load_data_button(rv, session)
463
    return(error)
Jonathan Mang's avatar
Jonathan Mang committed
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
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522

#' @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.",
    "\nSorry for that!"
  )
  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
    )
  }