fixed an error in the eqps, but changed API errors and other failures…

… to messages.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: elevatr
 Title: Access Elevation Data from Various APIs
-Version: 0.4.3.9999
+Version: 0.4.3
 Authors@R: c(person("Jeffrey", "Hollister", email = "hollister.jeff@epa.gov", 
                   role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9254-9740")),
              person("Tarak","Shah", role = "ctb"),
@@ -31,7 +31,8 @@ Imports:
     purrr,
     methods,
     units,
-    slippymath
+    slippymath,
+    curl
 License: CC0
 Encoding: UTF-8
 LazyData: true

NEWS.md

@@ -1,8 +1,8 @@
-elevatr 0.4.3 (2023-04-XX)
+elevatr 0.4.3 (2023-05-26)
 =============
 
 # Fixes
-- Changed API ERRORS to warnings and return NA.  Would bomb out runs when this would happen only occasionally.
+- Changed API ERRORS to messages and return NA.  Would bomb out runs when this would happen only occasionally. Also this should meet CRAN policy on failing gracefully.
 - Switched long lat check from my homespun thing to st::sf_is_longlat
 - Fixed EPQS API URL.  Moved to a new one.  Thanks @haas4726 for the catch.
 

R/get_elev_point.R

@@ -78,6 +78,12 @@
 get_elev_point <- function(locations, prj = NULL, src = c("epqs", "aws"), 
                            overwrite = FALSE, ...){
 
+  # First Check for internet
+  if(!curl::has_internet()) {
+    message("Please connect to the internet and try again.")
+    return(NULL)
+  }
+
   src <- match.arg(src)
   sf_check <- ("sf" %in% class(locations)) | ("sfc" %in% class(locations))
 
@@ -185,6 +191,7 @@ get_epqs <- function(locations, units = c("meters","feet"),
   }
 
   base_url <- "https://epqs.nationalmap.gov/v1/json?"
+
   if(match.arg(units) == "meters"){
     units <- "Meters"
   } else if(match.arg(units) == "feet"){
@@ -194,7 +201,7 @@ get_epqs <- function(locations, units = c("meters","feet"),
   locations <- sp::spTransform(locations,
                                    sp::CRS(SRS_string = ll_prj))
   units <- paste0("&units=",units)
-
+  browser()
   get_epqs_resp <- function(coords, base_url, units, progress = FALSE) {
 
     Sys.sleep(0.001) #Getting non-repeateable errors maybe too many hits...
@@ -203,6 +210,7 @@ get_epqs <- function(locations, units = c("meters","feet"),
 
     loc <- paste0("x=",x, "&y=", y)
     url <- paste0(base_url,loc,units,"&output=json")
+
     resp <- tryCatch(httr::GET(url), error = function(e) e)
     n<-1
 
@@ -215,21 +223,21 @@ get_epqs <- function(locations, units = c("meters","feet"),
     }
 
     if(n > 5 & any(class(resp) == "simpleError"))  {
-      warning(paste0("API returned:'", resp$message, 
+      message(paste0("API returned:'", resp$message, 
                      "'. NA returned for elevation"), 
               call. = FALSE)
       return(NA)
     }
 
     if(httr::status_code(resp) == 200 & httr::content(resp, "text", encoding = "UTF-8") == ""){
-      warning("API returned an empty repsonse (e.g. location in ocean or not in U.S.). NA returned for elevation")
+      message("API returned an empty repsonse (e.g. location in ocean or not in U.S.). NA returned for elevation")
       return(NA)
     } else if(httr::status_code(resp) == 200){
 
       resp <- jsonlite::fromJSON(httr::content(resp, "text", encoding = "UTF-8"), 
                                simplifyVector = FALSE)
     } else {
-      warning(paste0("API returned a status code:'", resp$status_code, 
+      message(paste0("API returned a status code:'", resp$status_code, 
                      "'. NA returned for elevation"), 
               call. = FALSE)
       return(NA)

R/get_elev_raster.R

@@ -87,6 +87,11 @@ get_elev_raster <- function(locations, z, prj = NULL,
                             expand = NULL, clip = c("tile", "bbox", "locations"), 
                             verbose = TRUE, neg_to_na = FALSE, 
                             override_size_check = FALSE, ...){
+  # First Check for internet
+  if(!curl::has_internet()) {
+    message("Please connect to the internet and try again.")
+    return(NULL)
+  }
 
   src  <- match.arg(src)
   clip <- match.arg(clip) 
@@ -198,12 +203,18 @@ get_aws_terrain <- function(locations, z, prj, expand=NULL,
 
   base_url <- "https://s3.amazonaws.com/elevation-tiles-prod/geotiff"
 
-  #tiles <- get_tilexy_coords(locations, z)
+
   tiles <- get_tilexy(bbx,z)
 
   urls  <-  sprintf("%s/%s/%s/%s.tif", base_url, z, tiles[,1], tiles[,2])
 
-  #dem_list <- vector("list",length = nrow(tiles))
+  for(i in urls){
+    if(httr::http_error(i)) {
+      message("An AWS URL is invalid.")
+      return(NULL)
+    }
+  }
+
 
   dir <- tempdir()
 
@@ -368,6 +379,11 @@ get_opentopo <- function(locations, src, prj, expand=NULL, ...){
                 "&north=",max(bbx[2,]),
                 "&outputFormat=GTiff",
                 "&API_Key=", api_key)
+
+  if(httr::http_error(url)) {
+    message("The OpenTopography URL is invalid.")
+    return(NULL)
+  }
 
   message("Downloading OpenTopography DEMs")
   resp <- httr::GET(url,httr::write_disk(tmpfile,overwrite=TRUE), 

vignettes/introduction_to_elevatr.Rmd

@@ -9,8 +9,10 @@ output:
     toc_float: yes
 vignette: >
   %\VignetteIndexEntry{Introduction to elevatr} 
-  %\VignetteEngine{knitr::rmarkdown} 
   %\VignetteEncoding{UTF-8}
+  %\VignetteEngine{knitr::rmarkdown} 
+editor_options: 
+  chunk_output_type: console
 ---