Merge pull request #1 from r-multiverse/staging-freeze-update

use calendar month for staging period

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: multiverse.internals
 Title: Internal Infrastructure for R-multiverse
-Description: R-multiverse requires this internal internal infrastructure
-  package to automate contribution reviews and populate universes.
+Description: R-multiverse requires this internal infrastructure package to
+  automate contribution reviews and populate universes.
 Version: 0.2.10
 License: MIT + file LICENSE
 URL: https://github.com/r-multiverse/multiverse.internals
@@ -26,7 +26,7 @@ Authors@R: c(
     role = "cph"
   ))
 Depends:
-  R (>= 3.5.0)
+  R (>= 3.6)
 Imports:
   gh,
   igraph,

R/staging_is_active.R

@@ -3,29 +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
-#'   staging universe becomes active.
-#' @param duration Positive integer, number of days that the staging
-#'   universe remains active after each threshold.
-#' @param today Character string with today's date in `"%Y-%m-%d"` format.
+#' @param start Character vector of `"%m-%d"` dates that the
+#'   staging universe becomes active. Staging will then last for a full calendar
+#'   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"),
-  duration = 30L,
-  today = format(Sys.Date(), "%Y-%m-%d")
+  start = c("01-15", "04-15", "07-15", "10-15"),
+  today = Sys.Date()
 ) {
-  year <- format(as.Date(today), "%Y")
-  thresholds <- paste0(year, "-", thresholds)
-  spec <- "%Y-%m-%d"
-  spans <- lapply(
-    thresholds,
-    function(first) {
-      format(
-        seq(from = as.Date(first), by = "day", length.out = duration),
-        spec
-      )
-    }
-  )
-  today %in% unlist(spans)
+   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(start$mday <= 28L)
+  (month == start[1L] && day >= start[2L]) ||
+    (month == start[1L] + 1L && day < start[2L])
 }

tests/testthat/test-staging_is_active.R

@@ -1,6 +1,5 @@
 test_that("staging_is_active()", {
-  thresholds <- c("01-15", "04-15", "07-15", "10-15")
-  duration <- 30L
+  start <- c("01-15", "04-15", "07-15", "10-15")
   active <- c(
     "2024-01-15",
     "2024-01-16",
@@ -18,27 +17,25 @@ test_that("staging_is_active()", {
   for (today in active) {
     expect_true(
       staging_is_active(
-        thresholds = thresholds,
-        duration = duration,
+        start = start,
         today = today
       )
     )
   }
   inactive <- c(
     "2024-01-12",
-    "2024-02-14",
+    "2024-02-15",
     "2024-04-14",
     "2024-05-15",
     "2024-07-12",
-    "2024-08-14",
+    "2024-08-15",
     "2024-10-14",
-    "2024-11-14"
+    "2024-11-15"
   )
   for (today in inactive) {
     expect_false(
       staging_is_active(
-        thresholds = thresholds,
-        duration = duration,
+        start = start,
         today = today
       )
     )