R/select.R

In HarryRosen/hrimodules: Harry Rosen Inc Shiny Modules

#' Select module UI
#'
#' @description A select list module UI that can accept dynamic inputs on the server-side
#' declaration
#' @param id is unique ID associated with the button for the UI namespace
#'
#' @return HTML UI code for a shiny application
#'
#' @importFrom shiny uiOutput
#' @export

select_ui <- function(id) {
  ns <- NS(id)
  uiOutput(ns("select"))
}


#' Select module Server
#'
#' @description A select list module UI that can accept dynamic inputs on the server-side
#' declaration
#' @param input list of inputs used in the shiny application session
#' @param output list of outputs used the shiny application session
#' @param session The shiny app session object
#' @param label The label of the \code{selectInput} function. Converted to reactive later for enabling encapsulation
#' @param choices The choices of the \code{selectInput} function. Converted to reactive later for enabling encapsulation
#' @param updateVal The reactive function used to update the value of the select UI
#' @param trig The function used to trigger the value update
#' @param idx The index of which choice should be selected.
#' @param multiple The multiple option of the \code{selectInput} function. Converted to reactive later for enabling encapsulation
#'
#' @return Character. Select list value
#'
#' @importFrom shiny updateSelectInput
#' @importFrom shiny observeEvent
#' @export


select_server <-
  function(input,
           output,
           session,
           label = "Choose a metric:",
           choices = c("Test Selection",
                       "Test Selection 1",
                       "Test Selection 2",
                       "Test Selection 3"),
           updateVal = NA,
           trig,
           idx = 5,
           multiple = F) {
    ns <- session$ns

    #Are the input values a reactive function?
    opts <- to_reactive(choices)
    #Are the input values a reactive function?
    idx <- to_reactive(idx)
    #Is the label a reactive function?
    label_ <- to_reactive(label)
    #Is the multiple a reactive function?
    multi_ <- to_reactive(multiple)

    #Generate the output select based on the inputs supplied
    output[["select"]] <- renderUI({
      req(exists("opts"), exists("label_"), exists("multi_"))
      selectInput(
        ns("select"),
        label_(),
        multiple = multi_(),
        choices = opts(),
        selected = opts()[isolate(idx())]
      )
    })

    if (!missing("trig"))
      observeEvent(trig(), ignoreInit = F, {
        updateSelectInput(session, "select", selected = updateVal())
        # if (disable & trig())
        #   shinyjs::disable(id = "select")
        # if(disable & !trig())
        #   shinyjs::enable(id = "select")

      })


    return(list(selected = reactive(input[['select']])))
  }