R/lab_submission_module.R

In xec-cm/metaChecker:

#' Title
#'
#' @param id
#'
#' @return
#' @import dplyr
#' @import shiny
#' @import DT
#' @import readxl
#' @export
lab_submission_module_ui <- function(id) {
    shiny::pageWithSidebar(
        shiny::headerPanel(""),

        # sidebar
        shiny::sidebarPanel(
            width = 3,
            shiny::fileInput(
                inputId = shiny::NS(id, "target_load"),
                label = "Choose excel template",
                accept = c(".xls", ".xlsx"),
                placeholder = "No file selected",
                buttonLabel = "Browse...",
                width = 300
            ),
            shiny::actionButton(
                inputId = shiny::NS(id, "sql_submit"),
                label = "Submmit data",
                icon = shiny::icon("table"),
                width = 150
            )
        ),

        # main
        shiny::mainPanel(
            shiny::fluidRow(
                shiny::column(
                    width = 6,
                    h3("Samples data checks", .noWS = ),
                    DT::dataTableOutput(shiny::NS(id, "samples_table"))
                ),
                shiny::column(
                    width = 6,
                    h3("Patients data checks"),
                    DT::dataTableOutput(shiny::NS(id, "patients_table"))
                )
            )
        )
    )
}

#' @param id
#'
#' @export
lab_submission_module_server <- function(id) {
    shiny::moduleServer(id, function(input, output, session) {

        # Load data file reactivity
        df_load <- shiny::reactive({
            inFile <- input$target_load
            if (is.null(inFile)) { return(NULL) }
            df <- readxl::read_excel(inFile$datapath, col_names = TRUE, skip = 1)

            smp_df <- df %>%
                dplyr::select(all_of(samples_names)) %>%
                check_samples_names()

            pat_df <- df %>%
                dplyr::select(all_of(patients_names)) %>%
                check_patient_names()

            list(df = df, smp_df = smp_df, pat_df = pat_df)
        })

        # Print sample data information
        output$samples_table <- DT::renderDataTable({
            if (!is.null(df_load())) {
                df_load()$smp_df %>%
                    DT::datatable(escape = FALSE,
                                  rownames = FALSE,
                                  options = list(
                                      pageLength = -1
                                  ))
            }
        })

        # Print patient data information
        output$patients_table <- DT::renderDataTable({
            if (!is.null(df_load())) {
                df_load()$pat_df %>%
                    DT::datatable(escape = FALSE,
                                  rownames = FALSE,
                                  options = list(
                                      pageLength = -1
                                  ))
            }
        })

        # Enable/disable data upload if checks are all ok
        observe({
            if (is.null(df_load())) {
                shinyjs::disable("sql_submit")
            } else {
                check_1 <- nrow(df_load()$pat_df) == nrow(dplyr::filter(df_load()$pat_df, stringr::str_detect(icon, "ok")))
                check_2 <- nrow(df_load()$smp_df) == nrow(dplyr::filter(df_load()$smp_df, stringr::str_detect(icon, "ok")))

                if (all(c(check_1, check_2))) {
                    shinyjs::enable("sql_submit")
                } else {
                    shinyjs::disable("sql_submit")
                }
            }
        })

        # Upload data
        shiny::observeEvent(input$sql_submit, {

            # upload to s3
            df_load()$df %>% export_to_s3()

            # upload to sql
            df_load()$df %>% dplyr::select(patients_names) %>% ingest_db("patients")
            df_load()$df %>% dplyr::select(samples_names) %>% ingest_db("samples")

            shinyjs::disable("sql_submit")
        })
    })
}