Some tweaks + add Olivier to DESCRIPTION

DESCRIPTION

@@ -12,10 +12,11 @@ Description: Format dates and times flexibly and to whichever locales
     formatting patterns based on date/time skeleton formats and standardized
     date/time formats with varying specificity.
 Authors@R: c(
-    person("Richard", "Iannone", , "rich@posit.co", c("aut", "cre"),
+    person("Richard", "Iannone", , "rich@posit.co", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-3925-190X")),
+    person("Olivier", "Roy", role = "ctb"),
     person("Posit Software, PBC", role = c("cph", "fnd"))
-    )
+  )
 License: MIT + file LICENSE
 URL: https://rstudio.github.io/bigD/, https://github.com/rstudio/bigD
 BugReports: https://github.com/rstudio/bigD/issues

R/dt_formatters.R

@@ -1,4 +1,3 @@
-
 zero_pad_to_width <- function(value, width) {
   formatC(value, width = width, flag = "0", format = "d")
 }
@@ -238,11 +237,9 @@ get_flexible_day_period <- function(input, locale) {
   # table (use the base locale if necessary); return NA if not found
   if (!locale_in_day_periods_tbl) {
 
-    base_locale <- sub("^([a-z]*).*", "\\1", locale)
+    locale <- sub("^([a-z]*).*", "\\1", locale)
 
-    if (base_locale %in% day_periods[["locale"]]) {
-      locale <- base_locale
-    } else {
+    if (!locale %in% day_periods[["locale"]]) {
       return(NA_character_)
     }
   }
@@ -321,11 +318,10 @@ get_noon_midnight_period <- function(input, locale) {
   # table (use the base locale if necessary); return NA if not found
   if (!locale_in_day_periods_tbl) {
 
-    base_locale <- sub("^([a-z]*).*", "\\1", locale)
+    # Modify locale
+    locale <- sub("^([a-z]*).*", "\\1", locale)
 
-    if (base_locale %in% day_periods[["locale"]]) {
-      locale <- base_locale
-    } else {
+    if (!locale %in% day_periods[["locale"]]) {
       return(NA_character_)
     }
   }

R/utils-date_time_parse.R

@@ -99,8 +99,7 @@ normalize_long_tzid <- function(long_tzid) {
   if (long_tzid %in% tz_name_resolution$tz_alt) {
 
     long_tzid <-
-      tz_name_resolution[
-        tz_name_resolution$tz_alt == long_tzid, "tz_canonical"]
+      tz_name_resolution$tz_canonical[tz_name_resolution$tz_alt == long_tzid]
   }
 
   long_tzid
@@ -118,17 +117,18 @@ long_tzid_to_tz_str <- function(long_tzid, input_dt) {
     return("+0000")
   }
 
-  tzdb_entries_tzid <- tzdb[tzdb$zone_name == long_tzid, ]
+  tzdb_entries_tzid <- tzdb[
+    tzdb$zone_name == long_tzid, c("date_start", "gmt_offset_h")]
 
   if (nrow(tzdb_entries_tzid) == 0L) {
     return(NA_character_)
   }
 
   input_date <- as.Date(input_dt)
 
-  tzdb_idx <- rle(!(tzdb_entries_tzid$date_start < input_date))$lengths[1]
+  tzdb_idx <- rle(tzdb_entries_tzid$date_start >= input_date)$lengths[1]
 
-  tz_offset <- tzdb_entries_tzid[tzdb_idx, ]$gmt_offset_h
+  tz_offset <- tzdb_entries_tzid[[tzdb_idx, "gmt_offset_h"]]
 
   minutes <- formatC(round((abs(tz_offset) %% 1) * 60, 0), width = 2, flag = "0")
   hours <- formatC(trunc(abs(tz_offset)), width = 2, flag = "0")
@@ -251,9 +251,8 @@ which_iana_pattern <- function(input) {
     return("wrapped")
   } else if (grepl(paste0(get_tz_pattern(), get_attached_iana_pattern()), input)) {
     return("attached")
-  } else {
-    return(NA_character_)
   }
+  NA_character_
 }
 
 get_tz_offset <- function(input) {
@@ -331,7 +330,7 @@ get_tz_short_specific <- function(long_tzid, input_dt) {
     return(NA_character_)
   }
 
-  tzdb_idx <- rle(!(tzdb_entries_tzid$date_start < input_date))$lengths[1]
+  tzdb_idx <- rle(tzdb_entries_tzid$date_start >= input_date)$lengths[1]
 
   tz_short_specific <- tzdb_entries_tzid[tzdb_idx, "abbrev"]
 
@@ -353,7 +352,7 @@ get_tz_long_specific <- function(long_tzid, input_dt, locale) {
     return(NA_character_)
   }
 
-  tzdb_idx <- rle(!(tzdb_entries_tzid$date_start < input_date))$lengths[1]
+  tzdb_idx <- rle(tzdb_entries_tzid$date_start >= input_date)$lengths[1]
 
   tzdb_entries_tzid_ln <- tzdb_entries_tzid[tzdb_idx, ]
 
@@ -485,32 +484,30 @@ long_tz_id_to_metazone_long_id <- function(long_tzid) {
     if (long_tzid %in% unique(tz_name_resolution$tz_canonical)) {
 
       alt_names <-
-        tz_name_resolution[tz_name_resolution$tz_canonical == long_tzid, "tz_alt"]
-
-      if (any(alt_names %in% tz_metazone_users$canonical_tz_name)) {
-
-        long_tzid <- alt_names[1]
+        tz_name_resolution$tz_alt[tz_name_resolution$tz_canonical == long_tzid]
 
-      } else {
+      if (!any(alt_names %in% tz_metazone_users$canonical_tz_name)) {
         return(NA_character_)
       }
+      long_tzid <- alt_names[1]
 
     } else {
       return(NA_character_)
     }
   }
 
+  rows <- which(tz_metazone_users$canonical_tz_name == long_tzid)
   tz_metazone_users_rows <-
-    tz_metazone_users[tz_metazone_users$canonical_tz_name == long_tzid, ]
+    tz_metazone_users[[rows, "metazone_long_id"]]
 
   # Return NA if number of rows in `tz_metazone_users_rows` is zero
-  if (nrow(tz_metazone_users_rows) == 0) {
+  if (length(tz_metazone_users_rows) == 0) {
     return(NA_character_)
   }
 
   # TODO: develop routine to further filter multirow `tz_metazone_users_rows`
   # to a single row based on `locale`; for now, obtain the first metazone
-  metazone <- tz_metazone_users_rows[1, "metazone_long_id"]
+  metazone <- tz_metazone_users_rows[1]
 
   metazone
 }

R/utils.R

@@ -56,7 +56,7 @@ dates_elements_bigd <-
 #
 cldr_dates_bigd <- function(locale = "en", element) {
 
-  values <- dates[dates$locale == locale, element]
+  values <- dates[[element]][dates$locale == locale]
   values <- unlist(values, use.names = TRUE)
 
   names(values) <- sub("^value\\.", "", names(values))

tests/testthat/test-dt_replace.R

@@ -3,7 +3,7 @@ test_that("dt_replace() works", {
   skip_on_cran() # not sure how robust this is.
   result <- dt_replace(
     dt = "{yyyy}-{MM}-{dd}'1'{HH}:{mm}:{ss}{XXX}",
-    input_dt =as.POSIXct("2015-06-28 20:49:46", tz = "UTC"),
+    input_dt = as.POSIXct("2015-06-28 20:49:46", tz = "UTC"),
     dt_lett = c("y", "M", "d", "H", "m", "s", "X"),
     locale = "en",
     tz_info = list(

tests/testthat/test-fdf_ftf.R

@@ -193,3 +193,11 @@ test_that("`flex_*_lst` can be used in `fdt()`", {
     )
   )
 })
+
+test_that("fdt() works in all contexts", {
+  expect_equal(
+    bigD::fdt("2024-03-01", format = "GyMMMEd", use_tz = "America/Toronto"),
+    "AD2024MarFri1"
+  )
+
+})