Update check functions for clarity and add tests

DESCRIPTION

@@ -20,6 +20,7 @@ Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
 Imports:
+    checkmate,
     cli,
     httr,
     jsonlite,

NAMESPACE

@@ -47,6 +47,15 @@ export(request_url)
 export(wiki)
 export(with_base_url)
 importFrom(MMWRweek,MMWRweek2Date)
+importFrom(checkmate,assert)
+importFrom(checkmate,assert_character)
+importFrom(checkmate,assert_integerish)
+importFrom(checkmate,assert_string)
+importFrom(checkmate,check_character)
+importFrom(checkmate,check_class)
+importFrom(checkmate,check_date)
+importFrom(checkmate,check_integerish)
+importFrom(checkmate,check_list)
 importFrom(httr,RETRY)
 importFrom(httr,content)
 importFrom(httr,http_error)

R/check.R

@@ -1,91 +1,80 @@
+#' Allows string vectors of length 1
+#' @importFrom checkmate assert_string
 check_string_param <- function(name, value, required = TRUE) {
-  # string or string[]
-  if ((required &&
-    !(!is.null(value) &&
-      is.character(value))) ||
-    (!required && !(is.null(value) || is.character(value)))) {
-    rlang::abort(paste0("argument ", name, " is not a string"),
-      name = name, value = value, class = "invalid_argument"
-    )
-  }
+  null.ok <- !required
+  assert_string(value, null.ok = null.ok, .var.name = name)
 }
 
-check_int_param <- function(name, value, required = TRUE) {
-  # numeric or numeric[]
-  if ((required &&
-    !(!is.null(value) &&
-      is.numeric(value))) ||
-    (!required && !(is.null(value) || is.numeric(value)))) {
-    rlang::abort(paste0("argument ", name, " is not a number"),
-      name = name, value = value, class = "invalid_argument"
-    )
-  }
+#' Allows string vectors of length > 1 and lists of string vectors of length 1
+#' @importFrom checkmate assert_character
+check_character_param <- function(name, value, required = TRUE) {
+  null.ok <- !required
+  assert_character(value, null.ok = null.ok, any.missing = FALSE, .var.name = name)
 }
 
-is_epirange_like <- function(value) {
-  # character or numeric or EpiRange or list(from=..., to=...)
-  is.character(value) ||
-    is.numeric(value) ||
-    inherits(value, "EpiRange") ||
-    (is.list(value) &&
-      "from" %in% names(value) && "to" %in% names(value))
+#' Allows a single numeric value
+#' @importFrom checkmate assert_integerish
+check_scalar_integerish_param <- function(name, value, required = TRUE) {
+  null.ok <- !required
+  assert_integerish(value, len = 1, null.ok = null.ok, .var.name = name)
 }
 
-check_single_epirange_param <- function(name, value, required = TRUE) {
-  if ((required &&
-    !(!is.null(value) &&
-      is_epirange_like(value))) ||
-    (!required && !(is.null(value) || is_epirange_like(value)))) {
-    rlang::abort(paste0("argument ", name, " is not a epirange"),
-      name = name, value = value, class = "invalid_argument"
-    )
-  }
+#' Allows a vector of numeric values or a list of numeric values
+#' @importFrom checkmate assert_integerish
+check_integerish_param <- function(name, value, required = TRUE) {
+  null.ok <- !required
+  assert_integerish(value, null.ok = null.ok, any.missing = FALSE, .var.name = name)
 }
 
-check_epirange_param <- function(name, value, required = TRUE) {
-  if (is.null(value)) {
-    if (required) {
-      rlang::abort(paste0("argument ", name, " is not a epirange"),
-        name = name, value = value, class = "invalid_argument"
-      )
-    }
-    return()
-  }
-  if (is_epirange_like(value)) {
-    return()
-  }
-  if (!is.list || !all(sapply(sapply(value, is_epirange_like)))) {
-    rlang::abort(paste0("argument ", name, " is not a epirange"),
-      name = name, value = value, class = "invalid_argument"
-    )
-  }
+#' Allows a scalar date_like param: a single date, character, or integerish
+#' @importFrom checkmate assert check_date check_character check_integerish
+check_scalar_date_param <- function(name, value, required = TRUE) {
+  null.ok <- !required
+  assert(
+    # check_date(value, null.ok = null.ok, len = 1),
+    check_character(value, null.ok = null.ok, len = 1),
+    check_integerish(value, null.ok = null.ok, len = 1),
+    combine = "or",
+    .var.name = name
+  )
 }
 
-check_single_string_param <- function(name, value, required = TRUE) {
-  if ((required &&
-    !(!is.null(value) &&
-      is.character(value) &&
-      length(value) == 1)) ||
-    (!required &&
-      !(is.null(value) ||
-        (
-          is.character(value) && length(value) == 1
-        )))) {
-    rlang::abort(paste0("argument ", name, " is not a single string"),
-      name = name, value = value, class = "invalid_argument"
-    )
-  }
+#' Allows a vector of date_like params: dates, characters, or integerishes
+#' @importFrom checkmate check_date check_character check_integerish
+check_date_param <- function(name, value, required = TRUE) {
+  null.ok <- !required
+  assert(
+    # check_date(value, null.ok = null.ok),
+    check_character(value, null.ok = null.ok),
+    check_integerish(value, null.ok = null.ok),
+    combine = "or",
+    .var.name = name
+  )
 }
 
-check_single_int_param <- function(name, value, required = TRUE) {
-  if ((required &&
-    !(!is.null(value) &&
-      is.numeric(value) &&
-      length(value) == 1)) ||
-    (!required &&
-      !(is.null(value) || (is.numeric(value) && length(value) == 1)))) {
-    rlang::abort(paste0("argument ", name, " is not a single integer"),
-      name = name, value = value, class = "invalid_argument"
-    )
-  }
+#' Allows a scalar timeset param: a character, an integerish, or an EpiRange
+#' @importFrom checkmate assert check_character check_integerish check_class
+check_scalar_timeset_param <- function(name, value, required = TRUE) {
+  null.ok <- !required
+  assert(
+    check_character(value, null.ok = null.ok, len = 1),
+    check_integerish(value, null.ok = null.ok, len = 1),
+    check_class(value, "EpiRange", null.ok = null.ok),
+    combine = "or",
+    .var.name = name
+  )
+}
+
+#' Check if param is a character or numeric or EpiRange
+#' @importFrom checkmate assert check_character check_integerish check_class check_list
+check_timeset_param <- function(name, value, required = TRUE) {
+  null.ok <- !required
+  assert(
+    check_character(value, null.ok = null.ok),
+    check_integerish(value, null.ok = null.ok),
+    check_class(value, "EpiRange", null.ok = null.ok),
+    check_list(value, types = "EpiRange", null.ok = null.ok),
+    combine = "or",
+    .var.name = name
+  )
 }