R/mod_colored_table.R

In MehdiChelh/triangle.tlbx: An Amazing Shiny App

# Module UI
  
#' @title   mod_colored_table_ui and mod_colored_table_server
#' @description  A shiny Module.
#'
#' @param id shiny id
#' @param input internal
#' @param output internal
#' @param session internal
#'
#' @rdname mod_colored_table
#'
#' @keywords internal
#' @export 
#' @importFrom shiny NS tagList 
mod_colored_table_ui <- function(id){
  ns <- NS(id)
  
  tagList(
    selectInput(ns('color_type'),'Choix de visualisation',
                c('Sans' = 'none',
                  'Nivellation' = 'bar',
                  'Gradient de couleurs'='gradient')),
    DT::dataTableOutput(ns("colored_table"))
  )
}
    
# Module Server
    
#' @rdname mod_colored_table
#' @export
#' @keywords internal
    
mod_colored_table_server <- function(input, output, session, data){
  ns <- session$ns
  
  
  output[["colored_table"]] <- DT::renderDataTable({
    
    dt <- data()
    
    req(dt)
    
    n_col <- if (is.null(ncol(data()))) 0 else ncol(data())
    
    session$sendCustomMessage("bind-dataVisSelection",
                              list("dataTableId" = ns("colored_table"),
                                   "selectInputId" = ns("color_type")))
    
    # session$sendCustomMessage("send-selectedCells",
    #                           list("dataTableId" = session$ns("colored_table"),
    #                                "onePerColumn" = TRUE))
    # datatableWrapper(dt, format = "thousands", triangle = TRUE)
    datatableWrapper(dt, triangle = TRUE)
  })
}

    
## To be copied in the UI
# mod_colored_table_ui("colored_table_ui_1")
    
## To be copied in the server
# callModule(mod_colored_table_server, "colored_table_ui_1")