R/utils.R

Defines functions laads_check laads_url laads_query_check laads_get laads_parse

# status check
laads_check <- function(req) {
  if (req$status_code < 400) return(TRUE)

  if (identical(req, "")) {
    stop("No output to parse",
         call. = FALSE)
    Sys.sleep(10)
    return(FALSE)
  }

  stop("HTTP failure: ", req$status_code, "\n", httr::content(req)$detail, call. = FALSE)
}


# URL for access to the services
laads_url <- function() {
  "http://modwebsrv.modaps.eosdis.nasa.gov/axis2/services/MODAPSservices/"
}

# check arguments
laads_query_check <- function(query_par){
  if(!is.null(query_par$product)){
    if(!(query_par$product %in% laads_products()$name)){
      stop(call. = FALSE,
           paste0(query_par$product, " is not a product name for LAADS. See existing Names in laads_products()"))
    }
  }

  if(!is.null(query_par$instrument)){
    if(!(query_par$instrument %in% laads_satellite_instruments()$name)){
      stop(call. = FALSE,
           paste0(query_par$instrument, " is not an instrument name for LAADS. See existing Names in laads_satellite_instruments()"))
    }
  }
}

# get
laads_get <- function(name_service, query_par){
  httr::GET(url = paste0(laads_url(), name_service),
            query = query_par)
}

# parse
laads_parse <- function(req){
  text <- httr::content(req, as = "text")
  text <- xml2::read_xml(text)
  # somehow sometimes with bind_rows I get an error
  # "not compatible with STRSXP"

  text <- do.call(rbind, xml2::as_list(text))
  if(nrow(text) == 1 & ncol(text) == 2){
    text <- data.frame(name = as.character(text[1,1][[1]][[1]]),
                           value = as.character(text[1,2][[1]][[1]]))

  }else{
    text <- tibble::as_tibble(apply(text, 2, unlist))

  }

  if("Name" %in% names(text)){
    text <- dplyr::rename_(text, name = ~Name)
  }

  text <- tibble::as_tibble(text)
  return(text)
}
masalmon/laads documentation built on May 21, 2019, 12:40 p.m.