R/functions.R

In brazil-data-cube/eocubes.R: Web Data Cubes Service client for R

#### general functions ####

.open_json_url <- function(url, ...) {

  if (!is.character(url))
    stop("Invalid `url` value.", call. = TRUE)

  res <- tryCatch({

    req <- curl::curl_fetch_memory(url = url)

    if (req$type != "application/json")
      stop("Invalid `json` content.", call. = TRUE)

    res <- jsonlite::fromJSON(rawToChar(req$content),
                              simplifyDataFrame = FALSE,
                              simplifyMatrix = FALSE)

    if (req$status_code != 200)
      stop(sprintf(paste("HTTP error %s. Message: %s", sep = "\n"),
                   res$code, res$message), call. = FALSE)

    return(res)
  },
  error = function(e) {

    stop(sprintf(paste("Opening %s.",
                       "Reported error: %s",
                       sep = "\n"), url, e$message), call. = TRUE)
  })
}

.ifnull <- function(x, value) {

  if (!is.null(x))
    return(x)
  return(value)
}

.ifnotnull <- function(x, value) {

  if (is.null(x))
    return(NULL)

  res <- value
  return(res)
}

.make_url <- function(base, verb = "", ...) {

  res <- paste(base, verb, sep = "/")

  dots <- Filter(function(x) {
    res <- !(is.null(x) || length(x) == 0 || (length(x) == 1 && x == ""))
  }, list(...))

  if (length(dots) == 0)
    return(res)

  dots <- lapply(dots, function(x) {

    if (length(x) > 1)
      x <- paste0(x, collapse = ",")
    return(x)
  })

  params <- mapply(paste, names(dots), dots,
                   MoreArgs = list(sep = "="),
                   SIMPLIFY = TRUE, USE.NAMES = FALSE)

  res <- paste(res, paste(params, collapse = "&"), sep = "?")

  res <- utils::URLencode(res)

  return(res)
}

##### slices functions #####

.slices <- function(timeline, slices, period) {

  if (!inherits(timeline, "Date") && length(timeline) < 2)
    stop("Invalid `timeline` parameter.", call. = TRUE)

  if (!inherits(slices, "eo_slices"))
    stop("Invalid `eo_slices` parameter.", call. = TRUE)

  if (is.null(slices$from))
    slices$from <- timeline[[1]]

  if (is.null(slices$to))
    slices$to <- timeline[[length(timeline)]]

  interval_period <- slices$to - slices$from

  # set begin to the first valid date spanning the timeline start
  timeline_step <- (timeline[2] - timeline[1])
  begin <- timeline[1] - timeline_step
  end <- timeline[length(timeline)] + timeline_step

  if (slices$from <= begin) {

    from = slices$from
    to = slices$to
  } else if (slices$from > begin) {

    from <- seq.Date(from = slices$from, to = begin, by = paste0("-", slices$by))
    from <- from[length(from)]
    to <- seq.Date(from = slices$to, to = from, by = paste0("-", slices$by))
    if (length(to) > length(from))
      to <- to[length(to) - 1]
    else
      to <- to[length(to)]
  }
  breaks_from <- seq.Date(from = from, to = end, by = slices$by)
  breaks_to <- .Date(sapply(breaks_from, function(from) from + interval_period))

  valid_breaks <- (begin < breaks_from) & (breaks_to < end)
  breaks_from <- breaks_from[valid_breaks]
  breaks_to <- breaks_to[valid_breaks]

  if (length(breaks_from) < 1)
    stop(sprintf(paste("The `timeline = %s` cannot be breaked using",
                       "informed parameters: `slices = %s`",
                       "`period = %s`"),
                 paste(timeline, collapse = ", "),
                 as.character(slices),
                 period),
         call. = TRUE)

  res <- mapply(eo_interval, breaks_from, breaks_to,
                SIMPLIFY = FALSE, USE.NAMES = FALSE)

  return(res)
}