Add vec-ptype methods

DESCRIPTION

@@ -43,7 +43,7 @@ VignetteBuilder:
     knitr
 Remotes:
     r-lib/tzdb,
-    r-lib/vctrs
+    r-lib/vctrs#1322
 Config/testthat/edition: 3
 Encoding: UTF-8
 LazyData: true

NAMESPACE

@@ -477,6 +477,15 @@ S3method(vec_proxy,clock_year_quarter_day)
 S3method(vec_proxy,clock_zoned_time)
 S3method(vec_proxy_compare,clock_weekday)
 S3method(vec_proxy_compare,clock_year_month_weekday)
+S3method(vec_ptype,clock_iso_year_week_day)
+S3method(vec_ptype,clock_naive_time)
+S3method(vec_ptype,clock_sys_time)
+S3method(vec_ptype,clock_weekday)
+S3method(vec_ptype,clock_year_day)
+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/gregorian-year-day.R

@@ -137,6 +137,25 @@ is_year_day <- function(x) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_ptype.clock_year_day <- function(x, ...) {
+  switch(
+    calendar_precision(x) + 1L,
+    clock_empty_year_day_year,
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    clock_empty_year_day_day,
+    clock_empty_year_day_hour,
+    clock_empty_year_day_minute,
+    clock_empty_year_day_second,
+    clock_empty_year_day_millisecond,
+    clock_empty_year_day_microsecond,
+    clock_empty_year_day_nanosecond,
+    abort("Internal error: Invalid precision.")
+  )
+}
+
 #' @export
 vec_ptype2.clock_year_day.clock_year_day <- function(x, y, ...) {
   ptype2_calendar_and_calendar(x, y, ...)
@@ -903,3 +922,20 @@ seq.clock_year_day <- function(from,
     ...
   )
 }
+
+# ------------------------------------------------------------------------------
+
+clock_init_year_day_utils <- function(env) {
+  year <- year_day(integer())
+
+  assign("clock_empty_year_day_year", year, envir = env)
+  assign("clock_empty_year_day_day", calendar_widen(year, "day"), envir = env)
+  assign("clock_empty_year_day_hour", calendar_widen(year, "hour"), envir = env)
+  assign("clock_empty_year_day_minute", calendar_widen(year, "minute"), envir = env)
+  assign("clock_empty_year_day_second", calendar_widen(year, "second"), envir = env)
+  assign("clock_empty_year_day_millisecond", calendar_widen(year, "millisecond"), envir = env)
+  assign("clock_empty_year_day_microsecond", calendar_widen(year, "microsecond"), envir = env)
+  assign("clock_empty_year_day_nanosecond", calendar_widen(year, "nanosecond"), envir = env)
+
+  invisible(NULL)
+}

R/gregorian-year-month-day.R

@@ -323,6 +323,25 @@ is_year_month_day <- function(x) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_ptype.clock_year_month_day <- function(x, ...) {
+  switch(
+    calendar_precision(x) + 1L,
+    clock_empty_year_month_day_year,
+    abort("Internal error: Invalid precision"),
+    clock_empty_year_month_day_month,
+    abort("Internal error: Invalid precision"),
+    clock_empty_year_month_day_day,
+    clock_empty_year_month_day_hour,
+    clock_empty_year_month_day_minute,
+    clock_empty_year_month_day_second,
+    clock_empty_year_month_day_millisecond,
+    clock_empty_year_month_day_microsecond,
+    clock_empty_year_month_day_nanosecond,
+    abort("Internal error: Invalid precision.")
+  )
+}
+
 #' @export
 vec_ptype2.clock_year_month_day.clock_year_month_day <- function(x, y, ...) {
   ptype2_calendar_and_calendar(x, y, ...)
@@ -1183,3 +1202,21 @@ seq.clock_year_month_day <- function(from,
     ...
   )
 }
+
+# ------------------------------------------------------------------------------
+
+clock_init_year_month_day_utils <- function(env) {
+  year <- year_month_day(integer())
+
+  assign("clock_empty_year_month_day_year", year, envir = env)
+  assign("clock_empty_year_month_day_month", calendar_widen(year, "month"), envir = env)
+  assign("clock_empty_year_month_day_day", calendar_widen(year, "day"), envir = env)
+  assign("clock_empty_year_month_day_hour", calendar_widen(year, "hour"), envir = env)
+  assign("clock_empty_year_month_day_minute", calendar_widen(year, "minute"), envir = env)
+  assign("clock_empty_year_month_day_second", calendar_widen(year, "second"), envir = env)
+  assign("clock_empty_year_month_day_millisecond", calendar_widen(year, "millisecond"), envir = env)
+  assign("clock_empty_year_month_day_microsecond", calendar_widen(year, "microsecond"), envir = env)
+  assign("clock_empty_year_month_day_nanosecond", calendar_widen(year, "nanosecond"), envir = env)
+
+  invisible(NULL)
+}

R/gregorian-year-month-weekday.R

@@ -175,6 +175,25 @@ is_year_month_weekday <- function(x) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_ptype.clock_year_month_weekday <- function(x, ...) {
+  switch(
+    calendar_precision(x) + 1L,
+    clock_empty_year_month_weekday_year,
+    abort("Internal error: Invalid precision"),
+    clock_empty_year_month_weekday_month,
+    abort("Internal error: Invalid precision"),
+    clock_empty_year_month_weekday_day,
+    clock_empty_year_month_weekday_hour,
+    clock_empty_year_month_weekday_minute,
+    clock_empty_year_month_weekday_second,
+    clock_empty_year_month_weekday_millisecond,
+    clock_empty_year_month_weekday_microsecond,
+    clock_empty_year_month_weekday_nanosecond,
+    abort("Internal error: Invalid precision.")
+  )
+}
+
 #' @export
 vec_ptype2.clock_year_month_weekday.clock_year_month_weekday <- function(x, y, ...) {
   ptype2_calendar_and_calendar(x, y, ...)
@@ -1050,3 +1069,21 @@ seq.clock_year_month_weekday <- function(from,
                                          ...) {
   seq.clock_year_month_day(from, to, by, length.out, along.with, ...)
 }
+
+# ------------------------------------------------------------------------------
+
+clock_init_year_month_weekday_utils <- function(env) {
+  year <- year_month_weekday(integer())
+
+  assign("clock_empty_year_month_weekday_year", year, envir = env)
+  assign("clock_empty_year_month_weekday_month", calendar_widen(year, "month"), envir = env)
+  assign("clock_empty_year_month_weekday_day", calendar_widen(year, "day"), envir = env)
+  assign("clock_empty_year_month_weekday_hour", calendar_widen(year, "hour"), envir = env)
+  assign("clock_empty_year_month_weekday_minute", calendar_widen(year, "minute"), envir = env)
+  assign("clock_empty_year_month_weekday_second", calendar_widen(year, "second"), envir = env)
+  assign("clock_empty_year_month_weekday_millisecond", calendar_widen(year, "millisecond"), envir = env)
+  assign("clock_empty_year_month_weekday_microsecond", calendar_widen(year, "microsecond"), envir = env)
+  assign("clock_empty_year_month_weekday_nanosecond", calendar_widen(year, "nanosecond"), envir = env)
+
+  invisible(NULL)
+}

R/iso-year-week-day.R

@@ -152,6 +152,25 @@ is_iso_year_week_day <- function(x) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_ptype.clock_iso_year_week_day <- function(x, ...) {
+  switch(
+    calendar_precision(x) + 1L,
+    clock_empty_iso_year_week_day_year,
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    clock_empty_iso_year_week_day_week,
+    clock_empty_iso_year_week_day_day,
+    clock_empty_iso_year_week_day_hour,
+    clock_empty_iso_year_week_day_minute,
+    clock_empty_iso_year_week_day_second,
+    clock_empty_iso_year_week_day_millisecond,
+    clock_empty_iso_year_week_day_microsecond,
+    clock_empty_iso_year_week_day_nanosecond,
+    abort("Internal error: Invalid precision.")
+  )
+}
+
 #' @export
 vec_ptype2.clock_iso_year_week_day.clock_iso_year_week_day <- function(x, y, ...) {
   ptype2_calendar_and_calendar(x, y, ...)
@@ -916,3 +935,21 @@ seq.clock_iso_year_week_day <- function(from,
     ...
   )
 }
+
+# ------------------------------------------------------------------------------
+
+clock_init_iso_year_week_day_utils <- function(env) {
+  year <- iso_year_week_day(integer())
+
+  assign("clock_empty_iso_year_week_day_year", year, envir = env)
+  assign("clock_empty_iso_year_week_day_week", calendar_widen(year, "week"), envir = env)
+  assign("clock_empty_iso_year_week_day_day", calendar_widen(year, "day"), envir = env)
+  assign("clock_empty_iso_year_week_day_hour", calendar_widen(year, "hour"), envir = env)
+  assign("clock_empty_iso_year_week_day_minute", calendar_widen(year, "minute"), envir = env)
+  assign("clock_empty_iso_year_week_day_second", calendar_widen(year, "second"), envir = env)
+  assign("clock_empty_iso_year_week_day_millisecond", calendar_widen(year, "millisecond"), envir = env)
+  assign("clock_empty_iso_year_week_day_microsecond", calendar_widen(year, "microsecond"), envir = env)
+  assign("clock_empty_iso_year_week_day_nanosecond", calendar_widen(year, "nanosecond"), envir = env)
+
+  invisible(NULL)
+}

R/naive-time.R

@@ -697,6 +697,25 @@ new_naive_info_from_fields <- function(fields) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_ptype.clock_naive_time <- function(x, ...) {
+  switch(
+    time_point_precision(x) + 1L,
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    clock_empty_naive_time_day,
+    clock_empty_naive_time_hour,
+    clock_empty_naive_time_minute,
+    clock_empty_naive_time_second,
+    clock_empty_naive_time_millisecond,
+    clock_empty_naive_time_microsecond,
+    clock_empty_naive_time_nanosecond,
+    abort("Internal error: Invalid precision.")
+  )
+}
+
 #' @export
 vec_ptype2.clock_naive_time.clock_naive_time <- function(x, y, ...) {
   ptype2_time_point_and_time_point(x, y, ...)
@@ -751,3 +770,19 @@ vec_arith.clock_naive_time.numeric <- function(op, x, y, ...) {
 vec_arith.numeric.clock_naive_time <- function(op, x, y, ...) {
   arith_numeric_and_time_point(op, x, y, ...)
 }
+
+# ------------------------------------------------------------------------------
+
+clock_init_naive_time_utils <- function(env) {
+  day <- as_naive(year_month_day(integer(), integer(), integer()))
+
+  assign("clock_empty_naive_time_day", day, envir = env)
+  assign("clock_empty_naive_time_hour", time_point_cast(day, "hour"), envir = env)
+  assign("clock_empty_naive_time_minute", time_point_cast(day, "minute"), envir = env)
+  assign("clock_empty_naive_time_second", time_point_cast(day, "second"), envir = env)
+  assign("clock_empty_naive_time_millisecond", time_point_cast(day, "millisecond"), envir = env)
+  assign("clock_empty_naive_time_microsecond", time_point_cast(day, "microsecond"), envir = env)
+  assign("clock_empty_naive_time_nanosecond", time_point_cast(day, "nanosecond"), envir = env)
+
+  invisible(NULL)
+}

R/precision.R

@@ -62,3 +62,19 @@ precision_common2 <- function(x, y) {
     y
   }
 }
+
+precision_names <- function() {
+  c(
+    "year",
+    "quarter",
+    "month",
+    "week",
+    "day",
+    "hour",
+    "minute",
+    "second",
+    "millisecond",
+    "microsecond",
+    "nanosecond"
+  )
+}

R/quarterly-year-quarter-day.R

@@ -175,6 +175,33 @@ is_year_quarter_day <- function(x) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_ptype.clock_year_quarter_day <- function(x, ...) {
+  names <- NULL
+  precision <- calendar_precision(x)
+  start <- quarterly_start(x)
+
+  f <- integer()
+
+  fields <- switch(
+    precision + 1L,
+    list(year = f),
+    list(year = f, quarter = f),
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    list(year = f, quarter = f, day = f),
+    list(year = f, quarter = f, day = f, hour = f),
+    list(year = f, quarter = f, day = f, hour = f, minute = f),
+    list(year = f, quarter = f, day = f, hour = f, minute = f, second = f),
+    list(year = f, quarter = f, day = f, hour = f, minute = f, second = f, subsecond = f),
+    list(year = f, quarter = f, day = f, hour = f, minute = f, second = f, subsecond = f),
+    list(year = f, quarter = f, day = f, hour = f, minute = f, second = f, subsecond = f),
+    abort("Internal error: Invalid precision.")
+  )
+
+  new_year_quarter_day_from_fields(fields, precision, start, names)
+}
+
 #' @export
 vec_ptype2.clock_year_quarter_day.clock_year_quarter_day <- function(x, y, ...) {
   if (quarterly_start(x) != quarterly_start(y)) {

R/sys-time.R

@@ -416,6 +416,25 @@ new_sys_info_from_fields <- function(fields) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_ptype.clock_sys_time <- function(x, ...) {
+  switch(
+    time_point_precision(x) + 1L,
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    clock_empty_sys_time_day,
+    clock_empty_sys_time_hour,
+    clock_empty_sys_time_minute,
+    clock_empty_sys_time_second,
+    clock_empty_sys_time_millisecond,
+    clock_empty_sys_time_microsecond,
+    clock_empty_sys_time_nanosecond,
+    abort("Internal error: Invalid precision.")
+  )
+}
+
 #' @export
 vec_ptype2.clock_sys_time.clock_sys_time <- function(x, y, ...) {
   ptype2_time_point_and_time_point(x, y, ...)
@@ -471,3 +490,18 @@ vec_arith.numeric.clock_sys_time <- function(op, x, y, ...) {
   arith_numeric_and_time_point(op, x, y, ...)
 }
 
+# ------------------------------------------------------------------------------
+
+clock_init_sys_time_utils <- function(env) {
+  day <- as_sys(year_month_day(integer(), integer(), integer()))
+
+  assign("clock_empty_sys_time_day", day, envir = env)
+  assign("clock_empty_sys_time_hour", time_point_cast(day, "hour"), envir = env)
+  assign("clock_empty_sys_time_minute", time_point_cast(day, "minute"), envir = env)
+  assign("clock_empty_sys_time_second", time_point_cast(day, "second"), envir = env)
+  assign("clock_empty_sys_time_millisecond", time_point_cast(day, "millisecond"), envir = env)
+  assign("clock_empty_sys_time_microsecond", time_point_cast(day, "microsecond"), envir = env)
+  assign("clock_empty_sys_time_nanosecond", time_point_cast(day, "nanosecond"), envir = env)
+
+  invisible(NULL)
+}

R/weekday.R

@@ -157,6 +157,11 @@ vec_ptype_abbr.clock_weekday <- function(x, ...) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_ptype.clock_weekday <- function(x, ...) {
+  clock_empty_weekday
+}
+
 #' @export
 vec_ptype2.clock_weekday.clock_weekday <- function(x, y, ...) {
   x
@@ -506,3 +511,11 @@ reencode_western_to_iso <- function(code) {
   code[code == 0L] <- 7L
   code
 }
+
+# ------------------------------------------------------------------------------
+
+clock_init_weekday_utils <- function(env) {
+  assign("clock_empty_weekday", weekday(integer()), envir = env)
+
+  invisible(NULL)
+}