/
mod_database_setup.R
148 lines (137 loc) · 5.03 KB
/
mod_database_setup.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
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
# Module Documentation ----
#' Database Module Selector
#'
#' @description
#'
#' This module allows the user to select an available ReviewR database module
#' from a dropdown list. It dynamically returns the database setup UI and user
#' configured database connection information from the selected module.
#'
#' See \code{vignette("customize_support_new_rdbms", package = "ReviewR")} for more
#' information on database modules and how to add support for additional databases.
#'
#' This module consists of the following components:
#'
#' ## Module UI function
#'
#' \itemize{
#' \item{`database_setup_ui`}: A tagList with a dropdown selector containing
#' available database modules.
#' }
#' ## Module Server function
#' \itemize{
#' \item{`database_setup_server`}: Processes user selection and dynamically returns
#' a uiOutput for the selected database module's setup UI. Any returns from the
#' configured database connection module are captured and returned.
#' }
#'
#' @param id The Module namespace
#' @name mod_database_setup
#'
#' @return
#' *database_setup_ui*:
#' \item{tagList}{A tagList containing a selectInput that allows for selection of
#' available database setup modules and the setup UI for the selected database
#' module.}
#' *database_setup_server*:
#' \item{reactiveValues}{This module has no returns of its own, but will pass on
#' the `reactiveValues` returns from the user selected database module.}
#'
NULL
#> NULL
# UI ----
#' @rdname mod_database_setup
#'
#' @keywords internal
#'
#' @importFrom shiny NS tagList
database_setup_ui <- function(id) {
ns <- NS(id)
tagList(
h4('Connect to Patient Database'),
HTML(glue::glue('To begin, please select a ReviewR database module:')),
br(),
br(),
selectInput(inputId = ns('database_modules'), label = 'Database Module:', choices = NULL),
uiOutput(ns('database_module_ui'))
)
}
# Server ----
#' @rdname mod_database_setup
#'
#' @keywords internal
#'
#' @import dbplyr
#' @importFrom magrittr %>% extract2
#' @importFrom purrr map
#' @importFrom rlang exec
#' @importFrom shinyjs disable enable
#'
database_setup_server <- function(id){
moduleServer(
id,
function(input, output, session) {
ns <- session$ns
# Database Module Setup ----
namespace <- 'db-selector-ns'
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Add Database Setup Modules Here!!! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #
## Add Database Setup Modules Here
database_setup_vars <- reactiveValues(bigquery = bigquery_setup_server(id = namespace ),
demo_sqlite = demo_sqlite_setup_server(id = namespace),
postgres = postgresql_setup_server(id = namespace)
)
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #
selector_vals <- reactiveValues(
module_names = '<empty>'
)
# Identify Database Modules ----
## Parse module names from reactive values object
observe({
req(database_setup_vars)
values <- database_setup_vars %>% names()
names <- map(values, ~extract2(database_setup_vars[[.x]], 'moduleName'))
names(values) <- names
selector_vals$module_names <- values
})
# Update selectInput ----
## Add Module names as choices for selectInput
observeEvent(selector_vals$module_names, {
req(selector_vals$module_names != '<empty>')
updateSelectInput(session = session,
inputId = 'database_modules',
choices = selector_vals$module_names %>% sort()
)
})
# Extract Module UI Function ----
## Render the UI function from the selected module
selected_module_ui <- reactive({
req(input$database_modules)
### Nested modules need ns() wrapper around UI so
### they inherit the outer module namespace
module_ui_args <- list(id = ns(namespace))
### Execute selected DB Module UI function
### with ns() wrapped namespace
rlang::exec(database_setup_vars[[input$database_modules]]$setup_ui,
!!!module_ui_args)
})
# Disable Selector on Successful Database Connection ----
## Prevent multiple modules from being used simultaneously
observeEvent(database_module_vars()$is_connected, {
if(database_module_vars()$is_connected == 'yes') {
shinyjs::disable('database_modules')
} else {
shinyjs::enable('database_modules')
}
})
# UI Outputs ----
output$database_module_ui <- renderUI({ selected_module_ui() })
# Return ----
## Return setup variables from the selected module
database_module_vars <- reactive({
req(input$database_modules)
database_setup_vars %>% extract2(input$database_modules)
})
return(database_module_vars)
}
)
}