R/mod_site_date.R

In arestrom/BaselineData: Puget Sound Baseline Data

#' site_date UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
mod_site_date_ui <- function(id){
  tagList(
    uiOutput(NS(id, "date_select")),
    br()
  )
}
    
#' site_date Server Function
#'
#' @noRd 
mod_site_date_server <- function(id, yrmn, site) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    # Get available survey dates for years and sites
    site_date_list = reactive({
      req(site()$ss)
      chosen_sites = gsub("'", "''", site()$ss)
      chosen_sites = paste0(paste0("'", chosen_sites, "'"), collapse = ", ")
      chosen_years = paste0(yrmn()$yr, collapse = ", ")
      chosen_months = paste0(match(yrmn()$mn, month.name), collapse = ", ")
      survey_dates = get_site_dates(chosen_sites, chosen_years, chosen_months)
      return(survey_dates)
    })
    
    # Creel site select
    output$date_select = renderUI({
      pickerInput(inputId = ns("date_select"),
                  label = "Select the survey date(s)",
                  multiple = TRUE,
                  choices = site_date_list(),
                  selected = site_date_list()[1],
                  width = "100%",
                  options = pickerOptions(actionsBox = TRUE))
    })
    
    # Output reactive list
    reactive({
      list(
        ds = input$date_select )
    })
  })
}
    
## To be copied in the UI
# mod_site_date_ui("site_date_ui")
    
## To be copied in the server
# callModule(mod_site_date_server, "site_date_ui")