Add vec-ptype method for zoned-time

Author: DavisVaughan

NAMESPACE

@@ -436,6 +436,7 @@ S3method(vec_ptype,clock_sys_time)
 S3method(vec_ptype,clock_year_month_day)
 S3method(vec_ptype,clock_year_month_weekday)
 S3method(vec_ptype,clock_year_quarter_day)
+S3method(vec_ptype,clock_zoned_time)
 S3method(vec_ptype2,clock_duration.clock_duration)
 S3method(vec_ptype2,clock_iso_year_week_day.clock_iso_year_week_day)
 S3method(vec_ptype2,clock_naive_time.clock_naive_time)

R/zoned-time.R

@@ -675,6 +675,31 @@ zone_pretty <- function(zone) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_ptype.clock_zoned_time <- function(x, ...) {
+  zone <- zoned_time_zone(x)
+
+  ptype_utc <- switch(
+    zoned_time_precision(x) + 1L,
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    clock_empty_zoned_time_utc_second,
+    clock_empty_zoned_time_utc_millisecond,
+    clock_empty_zoned_time_utc_microsecond,
+    clock_empty_zoned_time_utc_nanosecond,
+    abort("Internal error: Invalid precision.")
+  )
+
+  ptype <- zoned_time_set_zone(ptype_utc, zone)
+
+  ptype
+}
+
 #' @export
 vec_ptype2.clock_zoned_time.clock_zoned_time <- function(x, y, ...) {
   x_zone <- zoned_time_zone(x)
@@ -1015,3 +1040,14 @@ validate_zoned_time_precision_string <- function(precision) {
 is_valid_zoned_time_precision <- function(precision) {
   precision >= PRECISION_SECOND
 }
+
+# ------------------------------------------------------------------------------
+
+clock_init_zoned_time_utils <- function(env) {
+  assign("clock_empty_zoned_time_utc_second", as_zoned(as_sys(duration_seconds()), "UTC"), envir = env)
+  assign("clock_empty_zoned_time_utc_millisecond", as_zoned(as_sys(duration_milliseconds()), "UTC"), envir = env)
+  assign("clock_empty_zoned_time_utc_microsecond", as_zoned(as_sys(duration_microseconds()), "UTC"), envir = env)
+  assign("clock_empty_zoned_time_utc_nanosecond", as_zoned(as_sys(duration_nanoseconds()), "UTC"), envir = env)
+
+  invisible(NULL)
+}

R/zzz.R

@@ -14,6 +14,7 @@
   clock_init_iso_year_week_day_utils(clock_ns)
   clock_init_sys_time_utils(clock_ns)
   clock_init_naive_time_utils(clock_ns)
+  clock_init_zoned_time_utils(clock_ns)
 
   vctrs::s3_register("pillar::pillar_shaft", "clock_calendar", pillar_shaft.clock_calendar)
   vctrs::s3_register("pillar::pillar_shaft", "clock_time_point", pillar_shaft.clock_time_point)

tests/testthat/test-zoned-time.R

@@ -407,3 +407,28 @@ test_that("zoned-times don't support arithmetic", {
   expect_snapshot_error(add_microseconds(x, 1))
   expect_snapshot_error(add_nanoseconds(x, 1))
 })
+
+# ------------------------------------------------------------------------------
+# vec_ptype()
+
+test_that("ptype is correct", {
+  zones <- c("UTC", "America/New_York", "")
+
+  for (zone in zones) {
+    for (precision in precision_names()) {
+      precision <- validate_precision_string(precision)
+
+      if (precision < PRECISION_SECOND) {
+        next
+      }
+
+      x <- duration_helper(0L, precision)
+      x <- as_zoned(as_naive(x), zone)
+
+      ptype <- duration_helper(integer(), precision)
+      ptype <- as_zoned(as_naive(ptype), zone)
+
+      expect_identical(vec_ptype(x), ptype)
+    }
+  }
+})