diff --git a/R/staging_is_active.R b/R/staging_is_active.R index 4d07c66..904490f 100644 --- a/R/staging_is_active.R +++ b/R/staging_is_active.R @@ -3,25 +3,30 @@ #' @family staging #' @description Check if the stating universe is active. #' @return `TRUE` if the staging universe is active, `FALSE` otherwise. -#' @param thresholds Character vector of `"%m-%d"` dates that the +#' @param start Character vector of `"%m-%d"` dates that the #' staging universe becomes active. Staging will then last for a full calendar -#' month until, but not including, the same date a month later. +#' month. For example, if you supply a start date of `"01-15"`, +#' then the staging period will include all days from `"01-15"` through `"02-14"` +#' and not include `"02-15"`. #' @param today Character string with today's date in `"%Y-%m-%d"` format or an #' object convertible to POSIXlt format. #' @examples #' staging_is_active() staging_is_active <- function( - thresholds = c("01-15", "04-15", "07-15", "10-15"), + start = c("01-15", "04-15", "07-15", "10-15"), today = Sys.Date() ) { - today <- as.POSIXlt(today, tz = "UTC") - within_freeze <- function(x, today) { - mon <- today$mon + 1L - day <- today$mday - mon == x[1L] && day >= x[2L] || mon == x[1L] + 1L && day < x[2L] - } - thresholds <- strsplit(thresholds, split = "-", fixed = TRUE) - thresholds <- lapply(thresholds, as.integer) - within <- lapply(thresholds, within_freeze, today = today) - any(as.logical(within)) + today <- as.POSIXlt(today, tz = "UTC") + start <- strsplit(start, split = "-", fixed = TRUE) + start <- lapply(start, as.integer) + within <- lapply(start, within_staging, today = today) + any(as.logical(within)) +} + +within_staging <- function(start, today) { + month <- today$mon + 1L + day <- today$mday + stopifnot(day <= 28L) + (month == start[1L] && day >= start[2L]) || + (month == start[1L] + 1L && day < start[2L]) }