Merge branch 'f-#30-hm'. Closes #30.

- New `parse_hms()` and `parse_hm()` to parse strings in "HH:MM:SS" and "HH:MM" formats (#30).

NAMESPACE

@@ -16,4 +16,6 @@ S3method(print,hms)
 export(as.hms)
 export(hms)
 export(is.hms)
+export(parse_hm)
+export(parse_hms)
 importFrom(methods,setOldClass)

R/args.R

@@ -0,0 +1,28 @@
+check_args <- function(args) {
+  lengths <- vapply(args, length, integer(1L))
+  if (all(lengths == 0L)) {
+    stop("Need to pass at least one entry for seconds, minutes, hours, or days to hms().",
+         call. = FALSE)
+  }
+
+  valid <- vapply(args[lengths > 0], is_numeric_or_na, logical(1L))
+  if (!all(valid)) {
+    stop("All arguments must be numeric or NA", call. = FALSE)
+  }
+
+  if (!all(diff(which(lengths != 0L)) == 1L)) {
+    stop("Can't pass only ", paste(names(lengths)[lengths != 0L], collapse = ", "),
+         " to hms().", call. = FALSE)
+  }
+
+  lengths <- lengths[lengths != 0]
+  if (length(unique(lengths)) > 1L) {
+    stop("All arguments to hms() must have the same length or be NULL. Found ",
+         paste0("length(", names(lengths), ") = ", lengths, collapse = ", "), ".",
+         call. = FALSE)
+  }
+}
+
+is_numeric_or_na <- function(x) {
+  is.numeric(x) || all(is.na(x))
+}

R/hms.R

@@ -43,35 +43,6 @@ hms <- function(seconds = NULL, minutes = NULL, hours = NULL, days = NULL) {
   as.hms(as.difftime(secs, units = "secs"))
 }
 
-check_args <- function(args) {
-  lengths <- vapply(args, length, integer(1L))
-  if (all(lengths == 0L)) {
-    stop("Need to pass at least one entry for seconds, minutes, hours, or days to hms().",
-         call. = FALSE)
-  }
-
-  valid <- vapply(args[lengths > 0], is_numeric_or_na, logical(1L))
-  if (!all(valid)) {
-    stop("All arguments must be numeric or NA", call. = FALSE)
-  }
-
-  if (!all(diff(which(lengths != 0L)) == 1L)) {
-    stop("Can't pass only ", paste(names(lengths)[lengths != 0L], collapse = ", "),
-         " to hms().", call. = FALSE)
-  }
-
-  lengths <- lengths[lengths != 0]
-  if (length(unique(lengths)) > 1L) {
-    stop("All arguments to hms() must have the same length or be NULL. Found ",
-         paste0("length(", names(lengths), ") = ", lengths, collapse = ", "), ".",
-         call. = FALSE)
-  }
-}
-
-is_numeric_or_na <- function(x) {
-  is.numeric(x) || all(is.na(x))
-}
-
 #' @rdname hms
 #' @export
 is.hms <- function(x) inherits(x, "hms")
@@ -105,7 +76,7 @@ as.hms.numeric <- function(x, ...) hms(seconds = x)
 #' @rdname hms
 #' @export
 as.hms.character <- function(x, ...) {
-  as.hms(as.difftime(x))
+  parse_hms(x)
 }
 
 #' @rdname hms

R/parse.R

@@ -0,0 +1,22 @@
+#' Parsing hms values
+#'
+#' These functions convert character vectors to objects of the [hms] class.
+#' `NA` values are supported.
+#'
+#' `parse_hms()` accepts values of the form `"HH:MM:SS"`.
+#' @param x A character vector
+#' @export
+#' @examples
+#' parse_hms("12:34:56")
+parse_hms <- function(x) {
+  as.hms(as.difftime(as.character(x), units = "secs"))
+}
+
+#' @rdname parse_hms
+#' @details `parse_hm()` accepts values of the form `"HH:MM"`.
+#' @export
+#' @examples
+#' parse_hm("12:34")
+parse_hm <- function(x) {
+  as.hms(as.difftime(as.character(x), format = "%H:%M", units = "secs"))
+}

tests/testthat/test-parse.R

@@ -0,0 +1,13 @@
+context("parse")
+
+test_that("parse_hms", {
+  expect_equal(parse_hms("12:34:56"), hms(56, 34, 12))
+  expect_equal(parse_hms(NA), hms(NA))
+  expect_equal(parse_hms(c("12:34:56", NA)), as.hms(c(hms(56, 34, 12), hms(NA))))
+})
+
+test_that("parse_hm", {
+  expect_equal(parse_hm("12:34"), hms(0, 34, 12))
+  expect_equal(parse_hm(NA), hms(NA))
+  expect_equal(parse_hm(c("12:34", NA)), as.hms(c(hms(0, 34, 12), hms(NA))))
+})