R/mod_connection_to_db.R

In FINNGEN/CohortOperationsShinyApp: CohortOperationsShinyApp

#' connection_to_db UI Function
#'
#' @description A shiny Module for displaying connection statuses generated by cdm_webapi_conn
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList actionButton
#' @importFrom reactable reactableOutput
mod_connection_to_db_ui <- function(id) {
  ns <- shiny::NS(id)
  shiny::tagList(
    reactable::reactableOutput(ns("connection_status_reactable")) %>%
      CohortOperationsShinyApp::ui_load_spinner(),
    shiny::actionButton(ns("connection_status_b"), "Reconnect")
  )
}

#' connection_to_db Server Functions
#'
#' @noRd
#' @importFrom reactable renderReactable reactable colDef
#' @importFrom shiny observeEvent
#' @importFrom dplyr bind_rows
#'
mod_connection_to_db_server <- function(id, r_connection) {
  shiny::moduleServer(id, function(input, output, session) {
    ns <- session$ns



    output$connection_status_reactable <- reactable::renderReactable({

      phewas_conn_status_tibble <- r_connection$phewas_conn %>% unlist(recursive = FALSE)
      phewas_conn_status_tibble <- phewas_conn_status_tibble[str_detect(names(phewas_conn_status_tibble), "conn_status_tibble")]  %>%
        dplyr::bind_rows()

      dplyr::bind_rows(
        r_connection$cdm_webapi_conn$conn_status_tibble,
        phewas_conn_status_tibble,
        r_connection$connection_sandboxAPI$conn_status_tibble
      ) %>%
        dplyr::mutate(step = stringr::str_replace(step, "Test c", "C")) %>%
        dplyr::transmute(Status = error, Connection = step, `Error message` = message) %>%
        reactable::reactable(
          columns = list(
            Status = reactable::colDef(cell = function(value) {
              # Render as an X mark or check mark
              if (value) "\u274c" else "\u2714\ufe0f"
            })
          )
        )
    })

    shiny::observeEvent(input$connection_status_b, {
      r_connection$cdm_webapi_conn <- NULL
      r_connection$cdm_webapi_conn <- CohortOperationsShinyApp::configCDMTools()
    })

  })
}

## To be copied in the UI
# mod_connection_to_db_ui("connection_to_db_ui_1")

## To be copied in the server
# mod_connection_to_db_server("connection_to_db_ui_1")

# r_connection <- reactiveValues(cdm_webapi_conn = configCDMTools())
#
# shinyApp(
#   fluidPage(mod_connection_to_db_ui("test")),
#   function(input,output,session){mod_connection_to_db_server("test", r_connection)}
# )