R/date_range.R

In HarryRosen/hrimodules: Harry Rosen Inc Shiny Modules

#' Date Range module UI
#'
#' @description A date range module UI that can accept dynamic inputs on the server-side
#' declaration
#' @param id is unique ID associated with the date range for the UI namespace
#'
#' @return HTML UI code for a shiny application
#'
#' @importFrom shiny uiOutput
#' @export
date_range_ui <- function(id) {
  ns <- NS(id)
  uiOutput(ns("date_range"))
}



#' Date range module Server
#'
#' @description A date range 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{dateRangeInput} function. Converted to reactive later for enabling encapsulation
#' @param start The default start date of the \code{dateRangeInput} function.
#' @param end The default end date of the \code{dateRangeInput} function.
#' @param min The minimum of numbers that can be used by the \code{dateRangeInput} function.
#' @param max The maximum of numbers that can be used by the \code{dateRangeInput} function.
#' @param width The width of the UI component
#' @param updateVal reactive function used to parameterize the start and end date for \code{updateDateRangeInput} function.
#' @param disable logical to disable the UI component when the \code{trig} parameter is found to be true
#' @param trig logical reactive function that determines whether or not the update value should be triggered
#'
#' @return Numeric. Date Range
#' @importFrom shiny dateRangeInput
#' @importFrom shiny updateDateRangeInput
#' @export

date_range_server <-
  function(input,
           output,
           session,
           label = "Select Dates:",
           start = Sys.Date() - 5 * 7,
           end = Sys.Date(),
           min = Sys.Date() - 365 * 3.5,
           max = Sys.Date(),
           width = "100%",
           updateVal = NA,
           disable = F,
           trig) {
    ns <- session$ns

    output[["date_range"]] <- renderUI(dateRangeInput(
      ns("dates"),
      label,
      start =  start,
      end = end,
      min =  min,
      max = max,
      width = width
    ))

    if (!missing("trig"))
      observeEvent(trig(), ignoreInit = TRUE, {
        updateDateRangeInput(session, "dates", start = updateVal()[1], end = updateVal()[2])
        if (disable & trig())
          shinyjs::disable(id = "dates")
        if (disable & !trig())
          shinyjs::enable(id = "dates")
      })


    return(list(selected = reactive(input$dates)))
  }