mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 18:09:39 +02:00
more improvements to the REDCap module
This commit is contained in:
parent
5dd872f254
commit
984f383171
5 changed files with 358 additions and 172 deletions
|
|
@ -1 +1 @@
|
|||
app_version <- function()'250226_2108'
|
||||
app_version <- function()'250227_1333'
|
||||
|
|
|
|||
|
|
@ -12,26 +12,38 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
|
|||
|
||||
server_ui <- shiny::tagList(
|
||||
# width = 6,
|
||||
shiny::tags$h4("REDCap server information"),
|
||||
shiny::tags$h4("REDCap server"),
|
||||
shiny::textInput(
|
||||
inputId = ns("uri"),
|
||||
label = "URI/Address",
|
||||
value = "https://redcap.your.institution/api/"
|
||||
label = "Web address",
|
||||
value = "https://redcap.your.institution/"
|
||||
),
|
||||
shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"),
|
||||
shiny::textInput(
|
||||
inputId = ns("api"),
|
||||
label = "API token",
|
||||
value = ""
|
||||
),
|
||||
shiny::helpText("The token is a string of 32 numbers and letters."),
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_connect"),
|
||||
label = "Connect",
|
||||
icon = shiny::icon("link", lib = "glyphicon"),
|
||||
# width = NULL,
|
||||
disabled = TRUE
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
tags$div(
|
||||
id = ns("connect-placeholder"),
|
||||
shinyWidgets::alert(
|
||||
id = ns("connect-result"),
|
||||
status = "info",
|
||||
tags$p(phosphoricons::ph("info", weight = "bold"),"Please fill in server address (URI) and API token.")
|
||||
tags$p(phosphoricons::ph("info", weight = "bold"), "Please fill in server address (URI) and API token, then press 'Connect'.")
|
||||
),
|
||||
dismissible = TRUE
|
||||
)
|
||||
),
|
||||
shiny::br()
|
||||
)
|
||||
|
||||
|
||||
|
|
@ -74,27 +86,35 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
|
|||
width = 12,
|
||||
# shiny::actionButton(inputId = ns("import"), label = "Import"),
|
||||
## TODO: Use busy indicator like on download to have button activate/deactivate
|
||||
bslib::input_task_button(
|
||||
id = ns("data_import"),
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_import"),
|
||||
label = "Import",
|
||||
icon = shiny::icon("download", lib = "glyphicon"),
|
||||
label_busy = "Just a minute...",
|
||||
icon_busy = fontawesome::fa_i("arrows-rotate",
|
||||
class = "fa-spin",
|
||||
"aria-hidden" = "true"
|
||||
),
|
||||
type = "primary",
|
||||
auto_reset = TRUE#,state="busy"
|
||||
width = "100%",
|
||||
disabled = TRUE
|
||||
),
|
||||
# bslib::input_task_button(
|
||||
# id = ns("data_import"),
|
||||
# label = "Import",
|
||||
# icon = shiny::icon("download", lib = "glyphicon"),
|
||||
# label_busy = "Just a minute...",
|
||||
# icon_busy = fontawesome::fa_i("arrows-rotate",
|
||||
# class = "fa-spin",
|
||||
# "aria-hidden" = "true"
|
||||
# ),
|
||||
# type = "primary",
|
||||
# auto_reset = TRUE#,state="busy"
|
||||
# ),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::helpText("Press 'Import' after having specified API token and URI to export data from the REDCap server. A preview will show below the DataDictionary."),
|
||||
shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding."),
|
||||
shiny::br(),
|
||||
shiny::br()
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
#' @rdname redcap_read_shiny_module
|
||||
#'
|
||||
#' @return shiny server module
|
||||
|
|
@ -107,25 +127,38 @@ m_redcap_readServer <- function(id) {
|
|||
data_rv <- shiny::reactiveValues(
|
||||
dd_status = NULL,
|
||||
data_status = NULL,
|
||||
uri = NULL,
|
||||
project_name = NULL,
|
||||
info = NULL,
|
||||
arms = NULL,
|
||||
dd_list = NULL,
|
||||
data = NULL
|
||||
)
|
||||
|
||||
# tryCatch(
|
||||
# {
|
||||
shiny::observeEvent(list(input$api, input$uri), {
|
||||
uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/")
|
||||
|
||||
if (is_valid_redcap_url(uri) & is_valid_token(input$api)) {
|
||||
data_rv$uri <- uri
|
||||
shiny::updateActionButton(inputId = "data_connect", disabled = FALSE)
|
||||
} else {
|
||||
shiny::updateActionButton(inputId = "data_connect", disabled = TRUE)
|
||||
}
|
||||
})
|
||||
|
||||
|
||||
tryCatch(
|
||||
{
|
||||
shiny::observeEvent(
|
||||
list(
|
||||
input$api,
|
||||
input$uri
|
||||
input$data_connect
|
||||
),
|
||||
{
|
||||
shiny::req(input$api)
|
||||
shiny::req(input$uri)
|
||||
shiny::req(data_rv$uri)
|
||||
|
||||
parameters <- list(
|
||||
redcap_uri = input$uri,
|
||||
redcap_uri = data_rv$uri,
|
||||
token = input$api
|
||||
)
|
||||
|
||||
|
|
@ -134,42 +167,46 @@ m_redcap_readServer <- function(id) {
|
|||
|
||||
## TODO: Simplify error messages
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
|
||||
|
||||
if (ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
|
||||
mssg <- imported$raw_text
|
||||
} else {
|
||||
mssg <- attr(imported, "condition")$message
|
||||
}
|
||||
|
||||
datamods:::insert_error(mssg = mssg,selector = "connect")
|
||||
datamods:::insert_error(mssg = mssg, selector = "connect")
|
||||
data_rv$dd_status <- "error"
|
||||
data_rv$dd_list <- NULL
|
||||
} else if (isTRUE(imported$success)) {
|
||||
data_rv$dd_status <- "success"
|
||||
|
||||
data_rv$project_name <- REDCapR::redcap_project_info_read(
|
||||
redcap_uri = data_rv$uri,
|
||||
token = input$api
|
||||
)$data$project_title
|
||||
|
||||
datamods:::insert_alert(
|
||||
selector = ns("connect"),
|
||||
status = "success",
|
||||
make_success_alert(
|
||||
dataIdName = "see_data",
|
||||
extra = tags$b(phosphoricons::ph("check", weight = "bold"),"Connected to server! Project data loaded."),
|
||||
extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$project_name, " loaded."))),
|
||||
btn_show_data = TRUE
|
||||
)
|
||||
)
|
||||
|
||||
data_rv$dd_status <- "success"
|
||||
data_rv$dd_list <- imported
|
||||
}
|
||||
},
|
||||
ignoreInit = TRUE
|
||||
)
|
||||
# },
|
||||
# warning = function(warn) {
|
||||
# showNotification(paste0(warn), type = "warning")
|
||||
# },
|
||||
# error = function(err) {
|
||||
# showNotification(paste0(err), type = "err")
|
||||
# }
|
||||
# )
|
||||
},
|
||||
warning = function(warn) {
|
||||
showNotification(paste0(warn), type = "warning")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0(err), type = "err")
|
||||
}
|
||||
)
|
||||
|
||||
shiny::observeEvent(input$see_data, {
|
||||
datamods::show_data(
|
||||
|
|
@ -178,15 +215,15 @@ m_redcap_readServer <- function(id) {
|
|||
type = "modal",
|
||||
show_classes = FALSE,
|
||||
tags$b("Preview:")
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
arms <- shiny::reactive({
|
||||
shiny::req(input$api)
|
||||
shiny::req(input$uri)
|
||||
shiny::req(data_rv$uri)
|
||||
|
||||
REDCapR::redcap_event_read(
|
||||
redcap_uri = input$uri,
|
||||
redcap_uri = data_rv$uri,
|
||||
token = input$api
|
||||
)$data
|
||||
})
|
||||
|
|
@ -195,31 +232,26 @@ m_redcap_readServer <- function(id) {
|
|||
shiny::req(data_rv$dd_list)
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = ns("fields"),
|
||||
label = "Select fields/variables to import:",
|
||||
label = "Select variables to import:",
|
||||
choices = purrr::pluck(data_rv$dd_list, "data") |>
|
||||
dplyr::select(field_name, form_name) |>
|
||||
(\(.x){
|
||||
split(.x$field_name, .x$form_name)
|
||||
})()
|
||||
,
|
||||
updateOn = "close",
|
||||
})(),
|
||||
updateOn = "change",
|
||||
multiple = TRUE,
|
||||
search = TRUE,
|
||||
showValueAsTags = TRUE
|
||||
)
|
||||
})
|
||||
|
||||
## TODO: Get activate/inactivate action button to work
|
||||
# shiny::observeEvent(input$fields,
|
||||
# {
|
||||
# if (is.null(input$fields) | length(input$fields)==1){
|
||||
# bslib::update_task_button(id= "data_import", state = "busy")
|
||||
# # datamods:::toggle_widget(inputId = "data_import", enable = FALSE)
|
||||
# } else {
|
||||
# bslib::update_task_button(id= "data_import", state = "ready")
|
||||
# # datamods:::toggle_widget(inputId = "data_import", enable = TRUE)
|
||||
# }
|
||||
# })
|
||||
shiny::observeEvent(input$fields, {
|
||||
if (is.null(input$fields) | length(input$fields) == 0) {
|
||||
shiny::updateActionButton(inputId = "data_import", disabled = TRUE)
|
||||
} else {
|
||||
shiny::updateActionButton(inputId = "data_import", disabled = FALSE)
|
||||
}
|
||||
})
|
||||
|
||||
output$arms <- shiny::renderUI({
|
||||
shiny::selectizeInput(
|
||||
|
|
@ -231,24 +263,12 @@ m_redcap_readServer <- function(id) {
|
|||
)
|
||||
})
|
||||
|
||||
## Merge project name in success meassage
|
||||
## Generate Codebook link
|
||||
name <- shiny::reactive({
|
||||
if (data_rv$dd_status=="success"){
|
||||
# browser()
|
||||
REDCapR::redcap_project_info_read(
|
||||
redcap_uri = input$uri,
|
||||
token = input$api
|
||||
)$data$project_title}
|
||||
})
|
||||
|
||||
|
||||
shiny::observeEvent(input$data_import, {
|
||||
shiny::req(input$fields)
|
||||
record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
|
||||
|
||||
parameters <- list(
|
||||
uri = input$uri,
|
||||
uri = data_rv$uri,
|
||||
token = input$api,
|
||||
fields = unique(c(record_id, input$fields)),
|
||||
events = input$arms,
|
||||
|
|
@ -256,12 +276,13 @@ m_redcap_readServer <- function(id) {
|
|||
filter_logic = input$filter
|
||||
)
|
||||
|
||||
imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
|
||||
shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
|
||||
imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
|
||||
})
|
||||
code <- rlang::call2(REDCapCAST::read_redcap_tables, !!!parameters)
|
||||
|
||||
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
||||
|
||||
data_rv$data_status <- "error"
|
||||
data_rv$data_list <- NULL
|
||||
} else {
|
||||
|
|
@ -287,7 +308,7 @@ m_redcap_readServer <- function(id) {
|
|||
#' @importFrom shiny icon getDefaultReactiveDomain
|
||||
make_success_alert <- function(dataIdName = "see_data",
|
||||
btn_show_data,
|
||||
see_data_text="Click to see data",
|
||||
see_data_text = "Click to see data",
|
||||
extra = NULL,
|
||||
session = shiny::getDefaultReactiveDomain()) {
|
||||
if (isTRUE(btn_show_data)) {
|
||||
|
|
@ -318,6 +339,67 @@ make_success_alert <- function(dataIdName = "see_data",
|
|||
# )
|
||||
|
||||
|
||||
#' Title
|
||||
#'
|
||||
#' @param url
|
||||
#'
|
||||
#' @returns
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' url <- c(
|
||||
#' "www.example.com",
|
||||
#' "http://example.com",
|
||||
#' "https://redcap.your.inst/api/"
|
||||
#' )
|
||||
#' is_valid_redcap_url(url)
|
||||
is_valid_redcap_url <- function(url) {
|
||||
pattern <- "https://[^ /$.?#].[^\\s]*/api/$"
|
||||
stringr::str_detect(url, pattern)
|
||||
}
|
||||
|
||||
#' Validate REDCap token
|
||||
#'
|
||||
#' @param token token
|
||||
#' @param pattern_env pattern
|
||||
#'
|
||||
#' @returns
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' token <- paste(sample(c(1:9, LETTERS[1:6]), 32, TRUE), collapse = "")
|
||||
#' is_valid_token(token)
|
||||
is_valid_token <- function(token, pattern_env = NULL, nchar = 32) {
|
||||
checkmate::assert_character(token, any.missing = TRUE, len = 1)
|
||||
|
||||
if (!is.null(pattern_env)) {
|
||||
checkmate::assert_character(pattern_env,
|
||||
any.missing = FALSE,
|
||||
len = 1
|
||||
)
|
||||
pattern <- pattern_env
|
||||
} else {
|
||||
pattern <- glue::glue("^([0-9A-Fa-f]{<nchar>})(?:\\n)?$",
|
||||
.open = "<",
|
||||
.close = ">"
|
||||
)
|
||||
}
|
||||
|
||||
if (is.na(token)) {
|
||||
out <- FALSE
|
||||
} else if (is.null(token)) {
|
||||
out <- FALSE
|
||||
} else if (nchar(token) == 0L) {
|
||||
out <- FALSE
|
||||
} else if (!grepl(pattern, token, perl = TRUE)) {
|
||||
out <- FALSE
|
||||
} else {
|
||||
out <- TRUE
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
|
||||
#' Test app for the redcap_read_shiny_module
|
||||
#'
|
||||
#' @rdname redcap_read_shiny_module
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
#### Current file: R//app_version.R
|
||||
########
|
||||
|
||||
app_version <- function()'250226_2108'
|
||||
app_version <- function()'250227_1333'
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -2356,26 +2356,38 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
|
|||
|
||||
server_ui <- shiny::tagList(
|
||||
# width = 6,
|
||||
shiny::tags$h4("REDCap server information"),
|
||||
shiny::tags$h4("REDCap server"),
|
||||
shiny::textInput(
|
||||
inputId = ns("uri"),
|
||||
label = "URI/Address",
|
||||
value = "https://redcap.your.institution/api/"
|
||||
label = "Web address",
|
||||
value = "https://redcap.your.institution/"
|
||||
),
|
||||
shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"),
|
||||
shiny::textInput(
|
||||
inputId = ns("api"),
|
||||
label = "API token",
|
||||
value = ""
|
||||
),
|
||||
shiny::helpText("The token is a string of 32 numbers and letters."),
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_connect"),
|
||||
label = "Connect",
|
||||
icon = shiny::icon("link", lib = "glyphicon"),
|
||||
# width = NULL,
|
||||
disabled = TRUE
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
tags$div(
|
||||
id = ns("connect-placeholder"),
|
||||
shinyWidgets::alert(
|
||||
id = ns("connect-result"),
|
||||
status = "info",
|
||||
tags$p(phosphoricons::ph("info", weight = "bold"),"Please fill in server address (URI) and API token.")
|
||||
tags$p(phosphoricons::ph("info", weight = "bold"), "Please fill in server address (URI) and API token, then press 'Connect'.")
|
||||
),
|
||||
dismissible = TRUE
|
||||
)
|
||||
),
|
||||
shiny::br()
|
||||
)
|
||||
|
||||
|
||||
|
|
@ -2418,27 +2430,35 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
|
|||
width = 12,
|
||||
# shiny::actionButton(inputId = ns("import"), label = "Import"),
|
||||
## TODO: Use busy indicator like on download to have button activate/deactivate
|
||||
bslib::input_task_button(
|
||||
id = ns("data_import"),
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_import"),
|
||||
label = "Import",
|
||||
icon = shiny::icon("download", lib = "glyphicon"),
|
||||
label_busy = "Just a minute...",
|
||||
icon_busy = fontawesome::fa_i("arrows-rotate",
|
||||
class = "fa-spin",
|
||||
"aria-hidden" = "true"
|
||||
),
|
||||
type = "primary",
|
||||
auto_reset = TRUE#,state="busy"
|
||||
width = "100%",
|
||||
disabled = TRUE
|
||||
),
|
||||
# bslib::input_task_button(
|
||||
# id = ns("data_import"),
|
||||
# label = "Import",
|
||||
# icon = shiny::icon("download", lib = "glyphicon"),
|
||||
# label_busy = "Just a minute...",
|
||||
# icon_busy = fontawesome::fa_i("arrows-rotate",
|
||||
# class = "fa-spin",
|
||||
# "aria-hidden" = "true"
|
||||
# ),
|
||||
# type = "primary",
|
||||
# auto_reset = TRUE#,state="busy"
|
||||
# ),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::helpText("Press 'Import' after having specified API token and URI to export data from the REDCap server. A preview will show below the DataDictionary."),
|
||||
shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding."),
|
||||
shiny::br(),
|
||||
shiny::br()
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
#' @rdname redcap_read_shiny_module
|
||||
#'
|
||||
#' @return shiny server module
|
||||
|
|
@ -2451,25 +2471,38 @@ m_redcap_readServer <- function(id) {
|
|||
data_rv <- shiny::reactiveValues(
|
||||
dd_status = NULL,
|
||||
data_status = NULL,
|
||||
uri = NULL,
|
||||
project_name = NULL,
|
||||
info = NULL,
|
||||
arms = NULL,
|
||||
dd_list = NULL,
|
||||
data = NULL
|
||||
)
|
||||
|
||||
# tryCatch(
|
||||
# {
|
||||
shiny::observeEvent(list(input$api, input$uri), {
|
||||
uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/")
|
||||
|
||||
if (is_valid_redcap_url(uri) & is_valid_token(input$api)) {
|
||||
data_rv$uri <- uri
|
||||
shiny::updateActionButton(inputId = "data_connect", disabled = FALSE)
|
||||
} else {
|
||||
shiny::updateActionButton(inputId = "data_connect", disabled = TRUE)
|
||||
}
|
||||
})
|
||||
|
||||
|
||||
tryCatch(
|
||||
{
|
||||
shiny::observeEvent(
|
||||
list(
|
||||
input$api,
|
||||
input$uri
|
||||
input$data_connect
|
||||
),
|
||||
{
|
||||
shiny::req(input$api)
|
||||
shiny::req(input$uri)
|
||||
shiny::req(data_rv$uri)
|
||||
|
||||
parameters <- list(
|
||||
redcap_uri = input$uri,
|
||||
redcap_uri = data_rv$uri,
|
||||
token = input$api
|
||||
)
|
||||
|
||||
|
|
@ -2478,42 +2511,46 @@ m_redcap_readServer <- function(id) {
|
|||
|
||||
## TODO: Simplify error messages
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
|
||||
|
||||
if (ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
|
||||
mssg <- imported$raw_text
|
||||
} else {
|
||||
mssg <- attr(imported, "condition")$message
|
||||
}
|
||||
|
||||
datamods:::insert_error(mssg = mssg,selector = "connect")
|
||||
datamods:::insert_error(mssg = mssg, selector = "connect")
|
||||
data_rv$dd_status <- "error"
|
||||
data_rv$dd_list <- NULL
|
||||
} else if (isTRUE(imported$success)) {
|
||||
data_rv$dd_status <- "success"
|
||||
|
||||
data_rv$project_name <- REDCapR::redcap_project_info_read(
|
||||
redcap_uri = data_rv$uri,
|
||||
token = input$api
|
||||
)$data$project_title
|
||||
|
||||
datamods:::insert_alert(
|
||||
selector = ns("connect"),
|
||||
status = "success",
|
||||
make_success_alert(
|
||||
dataIdName = "see_data",
|
||||
extra = tags$b(phosphoricons::ph("check", weight = "bold"),"Connected to server! Project data loaded."),
|
||||
extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$project_name, " loaded."))),
|
||||
btn_show_data = TRUE
|
||||
)
|
||||
)
|
||||
|
||||
data_rv$dd_status <- "success"
|
||||
data_rv$dd_list <- imported
|
||||
}
|
||||
},
|
||||
ignoreInit = TRUE
|
||||
)
|
||||
# },
|
||||
# warning = function(warn) {
|
||||
# showNotification(paste0(warn), type = "warning")
|
||||
# },
|
||||
# error = function(err) {
|
||||
# showNotification(paste0(err), type = "err")
|
||||
# }
|
||||
# )
|
||||
},
|
||||
warning = function(warn) {
|
||||
showNotification(paste0(warn), type = "warning")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0(err), type = "err")
|
||||
}
|
||||
)
|
||||
|
||||
shiny::observeEvent(input$see_data, {
|
||||
datamods::show_data(
|
||||
|
|
@ -2522,15 +2559,15 @@ m_redcap_readServer <- function(id) {
|
|||
type = "modal",
|
||||
show_classes = FALSE,
|
||||
tags$b("Preview:")
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
arms <- shiny::reactive({
|
||||
shiny::req(input$api)
|
||||
shiny::req(input$uri)
|
||||
shiny::req(data_rv$uri)
|
||||
|
||||
REDCapR::redcap_event_read(
|
||||
redcap_uri = input$uri,
|
||||
redcap_uri = data_rv$uri,
|
||||
token = input$api
|
||||
)$data
|
||||
})
|
||||
|
|
@ -2539,31 +2576,26 @@ m_redcap_readServer <- function(id) {
|
|||
shiny::req(data_rv$dd_list)
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = ns("fields"),
|
||||
label = "Select fields/variables to import:",
|
||||
label = "Select variables to import:",
|
||||
choices = purrr::pluck(data_rv$dd_list, "data") |>
|
||||
dplyr::select(field_name, form_name) |>
|
||||
(\(.x){
|
||||
split(.x$field_name, .x$form_name)
|
||||
})()
|
||||
,
|
||||
updateOn = "close",
|
||||
})(),
|
||||
updateOn = "change",
|
||||
multiple = TRUE,
|
||||
search = TRUE,
|
||||
showValueAsTags = TRUE
|
||||
)
|
||||
})
|
||||
|
||||
## TODO: Get activate/inactivate action button to work
|
||||
# shiny::observeEvent(input$fields,
|
||||
# {
|
||||
# if (is.null(input$fields) | length(input$fields)==1){
|
||||
# bslib::update_task_button(id= "data_import", state = "busy")
|
||||
# # datamods:::toggle_widget(inputId = "data_import", enable = FALSE)
|
||||
# } else {
|
||||
# bslib::update_task_button(id= "data_import", state = "ready")
|
||||
# # datamods:::toggle_widget(inputId = "data_import", enable = TRUE)
|
||||
# }
|
||||
# })
|
||||
shiny::observeEvent(input$fields, {
|
||||
if (is.null(input$fields) | length(input$fields) == 0) {
|
||||
shiny::updateActionButton(inputId = "data_import", disabled = TRUE)
|
||||
} else {
|
||||
shiny::updateActionButton(inputId = "data_import", disabled = FALSE)
|
||||
}
|
||||
})
|
||||
|
||||
output$arms <- shiny::renderUI({
|
||||
shiny::selectizeInput(
|
||||
|
|
@ -2575,24 +2607,12 @@ m_redcap_readServer <- function(id) {
|
|||
)
|
||||
})
|
||||
|
||||
## Merge project name in success meassage
|
||||
## Generate Codebook link
|
||||
name <- shiny::reactive({
|
||||
if (data_rv$dd_status=="success"){
|
||||
# browser()
|
||||
REDCapR::redcap_project_info_read(
|
||||
redcap_uri = input$uri,
|
||||
token = input$api
|
||||
)$data$project_title}
|
||||
})
|
||||
|
||||
|
||||
shiny::observeEvent(input$data_import, {
|
||||
shiny::req(input$fields)
|
||||
record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
|
||||
|
||||
parameters <- list(
|
||||
uri = input$uri,
|
||||
uri = data_rv$uri,
|
||||
token = input$api,
|
||||
fields = unique(c(record_id, input$fields)),
|
||||
events = input$arms,
|
||||
|
|
@ -2600,12 +2620,13 @@ m_redcap_readServer <- function(id) {
|
|||
filter_logic = input$filter
|
||||
)
|
||||
|
||||
imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
|
||||
shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
|
||||
imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
|
||||
})
|
||||
code <- rlang::call2(REDCapCAST::read_redcap_tables, !!!parameters)
|
||||
|
||||
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
||||
|
||||
data_rv$data_status <- "error"
|
||||
data_rv$data_list <- NULL
|
||||
} else {
|
||||
|
|
@ -2631,7 +2652,7 @@ m_redcap_readServer <- function(id) {
|
|||
#' @importFrom shiny icon getDefaultReactiveDomain
|
||||
make_success_alert <- function(dataIdName = "see_data",
|
||||
btn_show_data,
|
||||
see_data_text="Click to see data",
|
||||
see_data_text = "Click to see data",
|
||||
extra = NULL,
|
||||
session = shiny::getDefaultReactiveDomain()) {
|
||||
if (isTRUE(btn_show_data)) {
|
||||
|
|
@ -2662,6 +2683,67 @@ make_success_alert <- function(dataIdName = "see_data",
|
|||
# )
|
||||
|
||||
|
||||
#' Title
|
||||
#'
|
||||
#' @param url
|
||||
#'
|
||||
#' @returns
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' url <- c(
|
||||
#' "www.example.com",
|
||||
#' "http://example.com",
|
||||
#' "https://redcap.your.inst/api/"
|
||||
#' )
|
||||
#' is_valid_redcap_url(url)
|
||||
is_valid_redcap_url <- function(url) {
|
||||
pattern <- "https://[^ /$.?#].[^\\s]*/api/$"
|
||||
stringr::str_detect(url, pattern)
|
||||
}
|
||||
|
||||
#' Validate REDCap token
|
||||
#'
|
||||
#' @param token token
|
||||
#' @param pattern_env pattern
|
||||
#'
|
||||
#' @returns
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' token <- paste(sample(c(1:9, LETTERS[1:6]), 32, TRUE), collapse = "")
|
||||
#' is_valid_token(token)
|
||||
is_valid_token <- function(token, pattern_env = NULL, nchar = 32) {
|
||||
checkmate::assert_character(token, any.missing = TRUE, len = 1)
|
||||
|
||||
if (!is.null(pattern_env)) {
|
||||
checkmate::assert_character(pattern_env,
|
||||
any.missing = FALSE,
|
||||
len = 1
|
||||
)
|
||||
pattern <- pattern_env
|
||||
} else {
|
||||
pattern <- glue::glue("^([0-9A-Fa-f]{<nchar>})(?:\\n)?$",
|
||||
.open = "<",
|
||||
.close = ">"
|
||||
)
|
||||
}
|
||||
|
||||
if (is.na(token)) {
|
||||
out <- FALSE
|
||||
} else if (is.null(token)) {
|
||||
out <- FALSE
|
||||
} else if (nchar(token) == 0L) {
|
||||
out <- FALSE
|
||||
} else if (!grepl(pattern, token, perl = TRUE)) {
|
||||
out <- FALSE
|
||||
} else {
|
||||
out <- TRUE
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
|
||||
#' Test app for the redcap_read_shiny_module
|
||||
#'
|
||||
#' @rdname redcap_read_shiny_module
|
||||
|
|
@ -4968,26 +5050,35 @@ ui_elements <- list(
|
|||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::h5("Exclude in-complete variables"),
|
||||
shiny::p("Before going further, you can exclude variables with a low degree of completeness."),
|
||||
shiny::br(),
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = "complete_cutoff",
|
||||
label = "Choose completeness threshold (%)",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 10,
|
||||
value = 70,
|
||||
format = shinyWidgets::wNumbFormat(decimals = 0),
|
||||
color = datamods:::get_primary_color()
|
||||
shiny::fluidRow(
|
||||
shiny::column(width=6,
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::p("Filter incomplete variables, by setting a completeness threshold:"),
|
||||
shiny::br()
|
||||
),
|
||||
shiny::column(width=6,
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = "complete_cutoff",
|
||||
label = NULL,
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 10,
|
||||
value = 70,
|
||||
format = shinyWidgets::wNumbFormat(decimals = 0),
|
||||
color = datamods:::get_primary_color()
|
||||
),
|
||||
shiny::helpText("Include variables with completeness above the specified percentage.")
|
||||
)
|
||||
),
|
||||
shiny::helpText("Only include variables with completeness above a specified percentage."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = "act_start",
|
||||
label = "Start",
|
||||
width = "100%",
|
||||
icon = shiny::icon("play")
|
||||
icon = shiny::icon("play"),
|
||||
disabled = TRUE
|
||||
),
|
||||
shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'),
|
||||
shiny::br(),
|
||||
|
|
@ -5704,6 +5795,13 @@ server <- function(input, output, session) {
|
|||
# rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import")
|
||||
})
|
||||
|
||||
shiny::observeEvent(rv$data_original, {
|
||||
if (is.null(rv$data_original) | NROW(rv$data_original) == 0) {
|
||||
shiny::updateActionButton(inputId = "act_start", disabled = TRUE)
|
||||
} else {
|
||||
shiny::updateActionButton(inputId = "act_start", disabled = FALSE)
|
||||
}
|
||||
})
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
|
|
@ -6387,11 +6485,6 @@ server <- function(input, output, session) {
|
|||
condition = "output.uploaded == 'yes'",
|
||||
)
|
||||
|
||||
# observeEvent(input$act_start, {
|
||||
# nav_show(id = "overview",target = "Import"
|
||||
# )
|
||||
# })
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Page navigation
|
||||
|
|
|
|||
|
|
@ -186,6 +186,13 @@ server <- function(input, output, session) {
|
|||
# rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import")
|
||||
})
|
||||
|
||||
shiny::observeEvent(rv$data_original, {
|
||||
if (is.null(rv$data_original) | NROW(rv$data_original) == 0) {
|
||||
shiny::updateActionButton(inputId = "act_start", disabled = TRUE)
|
||||
} else {
|
||||
shiny::updateActionButton(inputId = "act_start", disabled = FALSE)
|
||||
}
|
||||
})
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
|
|
@ -869,11 +876,6 @@ server <- function(input, output, session) {
|
|||
condition = "output.uploaded == 'yes'",
|
||||
)
|
||||
|
||||
# observeEvent(input$act_start, {
|
||||
# nav_show(id = "overview",target = "Import"
|
||||
# )
|
||||
# })
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Page navigation
|
||||
|
|
|
|||
|
|
@ -66,26 +66,35 @@ ui_elements <- list(
|
|||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::h5("Exclude in-complete variables"),
|
||||
shiny::p("Before going further, you can exclude variables with a low degree of completeness."),
|
||||
shiny::br(),
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = "complete_cutoff",
|
||||
label = "Choose completeness threshold (%)",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 10,
|
||||
value = 70,
|
||||
format = shinyWidgets::wNumbFormat(decimals = 0),
|
||||
color = datamods:::get_primary_color()
|
||||
shiny::fluidRow(
|
||||
shiny::column(width=6,
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::p("Filter incomplete variables, by setting a completeness threshold:"),
|
||||
shiny::br()
|
||||
),
|
||||
shiny::column(width=6,
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = "complete_cutoff",
|
||||
label = NULL,
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 5,
|
||||
value = 70,
|
||||
format = shinyWidgets::wNumbFormat(decimals = 0),
|
||||
color = datamods:::get_primary_color()
|
||||
),
|
||||
shiny::helpText("Include variables with completeness above the specified percentage.")
|
||||
)
|
||||
),
|
||||
shiny::helpText("Only include variables with completeness above a specified percentage."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = "act_start",
|
||||
label = "Start",
|
||||
width = "100%",
|
||||
icon = shiny::icon("play")
|
||||
icon = shiny::icon("play"),
|
||||
disabled = TRUE
|
||||
),
|
||||
shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'),
|
||||
shiny::br(),
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue