R/mod_dateRange.R

In mcanigueral/testapp: A Shiny app test using {golem}

#' dateRange UI Function
#'
#' @description Date range selector with slider
#'
#' @param id
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @importFrom shinyjs hide show disabled
#' @importFrom shinyWidgets radioGroupButtons sliderTextInput
mod_dateRange_ui <- function(id){
  ns <- NS(id)
  div(
    shinyWidgets::radioGroupButtons(inputId = ns("dates"), 
                                    label = icontitle("calendar", "Dates"), 
                                    choices = c("Month", "Season", "Year"),
                                    justified = TRUE
    ),
    shinyWidgets::sliderTextInput(ns("singlemonth"), label = NULL, grid = FALSE,
                                  choices = month.name, selected = month.name[6]),
    shinyjs::hidden(
      shinyWidgets::sliderTextInput(ns("multimonth"), label = NULL, grid = FALSE,
                                    choices = month.name, selected = month.name[c(4, 7)])
    ),
    shinyjs::hidden(
      shinyjs::disabled(
        shinyWidgets::sliderTextInput(ns("wholeyear"), label = NULL, grid = FALSE,
                                      choices = month.name, selected = month.name[c(1, 12)])
      )
    )
  )
}
    
#' dateRange Server Function
#' 
#' @param input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#' 
#' @import shiny dplyr 
#' @importFrom stats setNames
#' @importFrom shinyjs hide show
#' 
mod_dateRange_server <- function(input, output, session){
  ns <- session$ns
  
  month_relation <-  setNames(seq(1:12), month.name)
  selected_months <- reactiveValues()
  
  observeEvent(c(input$dates, input$singlemonth, input$multimonth), {
    if (input$dates == "Month") {
      shinyjs::hide("multimonth")
      shinyjs::hide("wholeyear")
      shinyjs::show("singlemonth")
      current <- month_relation[input$singlemonth] %>% unname()
      selected_months$start <- current
      selected_months$end <- current
      
    } else if (input$dates == "Season") {
      shinyjs::hide("singlemonth")
      shinyjs::hide("wholeyear")
      shinyjs::show("multimonth")
      selected_months$start <-  month_relation[input$multimonth[1]] %>% unname()
      selected_months$end <-  month_relation[input$multimonth[2]] %>% unname()
      
    } else if (input$dates == "Year") {
      shinyjs::hide("singlemonth")
      shinyjs::hide("multimonth")
      shinyjs::show("wholeyear")
      selected_months$start <- 1
      selected_months$end <- 12  
    }
  })
  
  return(selected_months)
 
}
    
## To be copied in the UI
# mod_dateRange_ui("dateRange_ui_1")
    
## To be copied in the server
# callModule(mod_dateRange_server, "dateRange_ui_1")