Add time_format() function for time formatting

Closes r-lib#88

NEWS.md

@@ -1,5 +1,7 @@
 # scales 0.5.0.9000
 
+* New function `time_format()` formats `POSIXt` and `hms` objects (@dpseidel, #88).
+
 * `rescale_mid()` now properly handles NAs (@foo-bar-baz-qux, #104).
 
 * `log_breaks()` returns integer multiples of integer powers of base when finer

R/trans-date.r

@@ -34,7 +34,6 @@ from_date <- function(x) {
 #' t$format(t$breaks(range(hours)))
 time_trans <- function(tz = NULL) {
   force(tz)
-
   to_time <- function(x) {
     structure(x, class = c("POSIXt", "POSIXct"), tzone = tz)
   }
@@ -127,3 +126,26 @@ date_format <- function(format = "%Y-%m-%d", tz = "UTC") {
   force_all(format, tz)
   function(x) format(x, format, tz = tz)
 }
+
+#' Formatted times.
+#'
+#' @param format Time format using standard POSIX specification.  See
+#'  [strptime()] for possible formats.
+#' @param tz a time zone name, see [timezones()]. Defaults
+#'  to UTC
+#' @export
+time_format <- function(format = "%H:%M:%S", tz = "UTC") {
+  force_all(format, tz)
+  function(x) {
+    if (inherits(x, "POSIXt")) {
+      format(x, format, tz = tz)
+    } else if (inherits(x, "difftime")) {
+      format(as.POSIXlt(x), format, tz = tz)
+    } else {
+      stop(
+        "Objects of class ", paste(class(x), collapse = "/"),
+        " are not supported by time_format."
+      )
+    }
+  }
+}

tests/testthat/test-trans-date.r

@@ -40,3 +40,9 @@ test_that("tz arugment overrules default time zone", {
   expect_equal(tz(x), "GMT")
   expect_equal(tz2(x), "GMT")
 })
+
+test_that("time_format formats hms objects", {
+  expect_equal(time_format()(a_time), "11:30:00")
+  expect_equal(time_format()(as.hms(a_time, tz = tz(a_time))), "11:30:00")
+  expect_equal(time_format(format = "%H")(as.hms(a_time, tz = tz(a_time))), "11")
+})