R/check-utils.R

In rstac: Client Library for SpatioTemporal Asset Catalog

#' @title Utility functions
#'
#' @description Auxiliary function to check that the provided date time follows
#' the standards of RFC 3339
#'
#' @param datetime Either a date-time or an interval, open or closed.
#' Date and time expressions adhere to RFC 3339. Open intervals are
#' expressed using double-dots.
#' Examples:
#' \itemize{
#'   \item A date-time: `"2018-02-12T23:20:50Z"`
#'   \item A closed interval: `"2018-02-12T00:00:00Z/2018-03-18T12:31:12Z"`
#'   \item Open intervals: `"2018-02-12T00:00:00Z/.."` or
#'     `"../2018-03-18T12:31:12Z"`
#' }
#'
#' @return A `logical` if TRUE the date time provided is correct,
#' otherwise not.
#'
#' @noRd
.check_rfc_3339 <- function(datetime) {

  # Standard regexp of RFC 3339
  pattern_rfc   <- "^\\d{4}-\\d{2}-\\d{2}?(T\\d{2}:\\d{2}:\\d{2}Z)?$"
  check_pattern <- grepl(pattern_rfc, datetime, perl = TRUE)

  return(check_pattern)
}

#' @title Utility functions
#'
#' @param obj       an `object` to compare.
#'
#' @param expected  a `character` with the expected classes.
#'
#' @noRd
.check_obj <- function(obj, expected) {

  obj_name <- as.character(substitute(obj, env = environment()))

  if (!inherits(obj, expected))
    .error("Invalid %s value in `%s` param.",
           paste0("`", expected, "`", collapse = " or "), obj_name)
}

check_items <- function(items) {
  UseMethod("check_items", items)
}

check_items.STACItem <- function(items) {
  if (!(is.list(items) && "assets" %in% names(items))) {
    .error("Invalid STACItem object.")
  }
}

check_items.STACItemCollection <- function(items) {
  if (!(is.list(items) && "features" %in% names(items))) {
    .error("Invalid STACItemCollection object.")
  }
}

check_items.default <- check_items.STACItem


check_character <- function(x, msg, ...) {
  if (!is.character(x))
    .error(msg, ...)
}