Merge pull request #581 from ldecicco-USGS/master

Failing gracefully

Merge pull request #581 from ldecicco-USGS/master
Failing gracefully
08ee437d · Laura A DeCicco · GitHub · f62b51b5 · 5f94aff2 · 08ee437d
Unverified Commit 08ee437d authored Sep 10, 2021 by Laura A DeCicco Committed by GitHub Sep 10, 2021
--- a/.github/workflows/R-CMD-check.yaml
+++ b/.github/workflows/R-CMD-check.yaml
@@ -20,9 +20,7 @@ jobs:
        config:
          - {os: macOS-latest,   r: 'release'}
          - {os: windows-latest, r: 'release'}
-          - {os: ubuntu-16.04,   r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest", http-user-agent: "R/4.0.0 (ubuntu-16.04) R (4.0.0 x86_64-pc-linux-gnu x86_64 linux-gnu) on GitHub Actions" }
-          - {os: ubuntu-16.04,   r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
-          - {os: ubuntu-16.04,   r: 'oldrel',  rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
+          - {os: ubuntu-18.04,   r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/bionic/latest"}

    env:
      R_REMOTES_NO_ERRORS_FROM_WARNINGS: true

--- a/DESCRIPTION
+++ b/DESCRIPTION
 Package: dataRetrieval
 Type: Package
 Title: Retrieval Functions for USGS and EPA Hydrologic and Water Quality Data
-Version: 2.7.9.0001
+Version: 2.7.10
 Authors@R: c(
    person("Laura", "DeCicco", role = c("aut","cre"),
            email = "ldecicco@usgs.gov",

--- a/NEWS
+++ b/NEWS
+dataRetrieval 2.8.10
+==================
+* Functions that come back from a server that had and error now return with a message and NULL rather than error.
+
 dataRetrieval 2.7.9
 ===================
 * Fix bug caused by changes in NLDI services

--- a/R/findNLDI.R
+++ b/R/findNLDI.R
--- a/R/getWebServiceData.R
+++ b/R/getWebServiceData.R
@@ -33,13 +33,20 @@ getWebServiceData <- function(obs_url, ...){
    response400 <- httr::content(returnedList, type="text", encoding = "UTF-8")
    statusReport <- xml_text(xml_child(read_xml(response400), 2)) # making assumption that - body is second node
    statusMsg <- gsub(pattern=", server=.*", replacement="", x = statusReport)
-    stop(statusMsg)
+    message(statusMsg)
+    return(invisible(NULL))
  } else if(httr::status_code(returnedList) != 200){
    message("For: ", obs_url,"\n")
-    httr::stop_for_status(returnedList)
+    httr::message_for_status(returnedList)
+    return(invisible(NULL))
  } else {
    headerInfo <- httr::headers(returnedList)
    
+    if(!"content-type" %in% names(headerInfo)){
+      message("Unknown content, returning NULL")
+      return(invisible(NULL))
+    }
+    
    if(headerInfo$`content-type` %in% c("text/tab-separated-values;charset=UTF-8")){
      returnedDoc <- httr::content(returnedList, type="text",encoding = "UTF-8")
    } else if (headerInfo$`content-type` %in% 

--- a/R/importNGWMN_wml2.R
+++ b/R/importNGWMN_wml2.R
@@ -25,7 +25,8 @@
 #' "observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel",
 #' "responseFormat=text/xml",
 #' "featureOfInterest=VW_GWDP_GEOSERVER.USGS.403836085374401",sep="&")
-#' data <- importNGWMN(obs_url)
+#' 
+#'  data_returned <- importNGWMN(obs_url)
 #' 
 #' }
 #' 
@@ -43,7 +44,9 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){
    raw <- TRUE
  } else {
    returnedDoc <- getWebServiceData(input, encoding='gzip')
-    
+    if(is.null(returnedDoc)){
+      return(invisible(NULL))
+    }
    returnedDoc <- xml_root(returnedDoc)
    
  }
@@ -141,7 +144,9 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){
 #'      "statCd=00003",
 #'      "parameterCd=00060",sep="&")
 #' \donttest{
+#' 
 #' timesereies <- importWaterML2(URL, asDateTime=TRUE, tz="UTC")
+#'  
 #' }
 importWaterML2 <- function(input, asDateTime=FALSE, tz="UTC") {
  

--- a/R/importRDB1.r
+++ b/R/importRDB1.r
@@ -54,22 +54,31 @@
 #' \donttest{
 #' data <- importRDB1(obs_url)
 #' 
+#' 
 #' urlMultiPcodes <- constructNWISURL("04085427",c("00060","00010"),
 #'          startDate,endDate,"dv",statCd=c("00003","00001"),"tsv")
+#' 
 #'   multiData <- importRDB1(urlMultiPcodes)
+#' 
 #' unitDataURL <- constructNWISURL(site_id,property,
 #'          "2020-10-30","2020-11-01","uv",format="tsv") #includes timezone switch
+#' 
 #'   unitData <- importRDB1(unitDataURL, asDateTime=TRUE)
+#' 
 #' qwURL <- constructNWISURL(c('04024430','04024000'),
 #'           c('34247','30234','32104','34220'),
 #'          "2010-11-03","","qw",format="rdb")
+#' 
 #' qwData <- importRDB1(qwURL, asDateTime=TRUE, tz="America/Chicago")
+#' 
 #' iceSite <- '04024000'
 #' start <- "2015-11-09"
 #' end <- "2015-11-24"
 #' urlIce <- constructNWISURL(iceSite,"00060",start, end,"uv",format="tsv")
+#' 
 #'   ice <- importRDB1(urlIce, asDateTime=TRUE)
 #'   iceNoConvert <- importRDB1(urlIce, convertType=FALSE)
+#' 
 #' }
 #' # User file:
 #' filePath <- system.file("extdata", package="dataRetrieval")
@@ -94,6 +103,9 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz="UTC"){
    doc <- getWebServiceData(obs_url,
                             httr::write_disk(f),
                             encoding='gzip')
+    if(is.null(doc)){
+      return(invisible(NULL))
+    }
    if("warn" %in% names(attr(doc, "headerInfo"))){
      data <- data.frame()
      attr(data, "headerInfo") <- attr(doc,"headerInfo")

--- a/R/importWQP.R
+++ b/R/importWQP.R
@@ -25,11 +25,14 @@
 #' rawSample <- importWQP(rawSampleURL)
 #' 
 #' rawSampleURL_NoZip <- constructWQPURL('USGS-01594440','01075', '', '', zip=FALSE)
+#' 
 #' rawSample2 <- importWQP(rawSampleURL_NoZip, zip=FALSE)
 #' 
 #' STORETex <- constructWQPURL('WIDNR_WQX-10032762','Specific conductance', '', '')
+#' 
 #'  STORETdata <- importWQP(STORETex)
 #' }
+#' 
 importWQP <- function(obs_url, zip=TRUE, tz="UTC", 
                      csv=FALSE){
  
@@ -49,6 +52,9 @@ importWQP <- function(obs_url, zip=TRUE, tz="UTC",
      doc <- getWebServiceData(obs_url, 
                               httr::write_disk(temp),
                               httr::accept("application/zip"))
+      if(is.null(doc)){
+        return(invisible(NULL))
+      }
      headerInfo <- httr::headers(doc)
      doc <- utils::unzip(temp, exdir=tempdir())
      unlink(temp)
@@ -56,6 +62,9 @@ importWQP <- function(obs_url, zip=TRUE, tz="UTC",
    } else {
      doc <- getWebServiceData(obs_url, 
                               httr::accept("text/tsv"))
+      if(is.null(doc)){
+        return(invisible(NULL))
+      }
      headerInfo <- attr(doc, "headerInfo")
    }


--- a/R/importWaterML1.r
+++ b/R/importWaterML1.r
@@ -115,7 +115,7 @@ importWaterML1 <- function(obs_url,asDateTime=FALSE, tz="UTC"){
  
  timeSeries <- xml_find_all(returnedDoc, ".//ns1:timeSeries") #each parameter/site combo
  
-  #some intial attributes
+  #some initial attributes
  queryNodes <- xml_children(xml_find_all(returnedDoc,".//ns1:queryInfo"))
  notes <- queryNodes[xml_name(queryNodes)=="note"]
  noteTitles <- xml_attrs(notes)
@@ -124,7 +124,10 @@ importWaterML1 <- function(obs_url,asDateTime=FALSE, tz="UTC"){
  names(noteList) <- noteTitles
  
  if(0 == length(timeSeries)){
-    df <- data.frame()
+    df <- data.frame(agency_cd = character(),
+                     site_no = character(),
+                     dateTime = as.POSIXct(character()),
+                     tz_cd = character())
    attr(df, "queryInfo") <- noteList
    if(!raw){
      attr(df, "url") <- obs_url
@@ -410,7 +413,12 @@ check_if_xml <- function(obs_url){
  } else if(inherits(obs_url, c("xml_node", "xml_nodeset"))) {
    returnedDoc <- obs_url
  } else {
-    returnedDoc <- xml_root(getWebServiceData(obs_url, encoding='gzip'))
+    
+    doc <- getWebServiceData(obs_url, encoding='gzip')
+    if(is.null(doc)){
+      return(invisible(NULL))
+    }
+    returnedDoc <- xml_root(doc)
  }
  return(returnedDoc)
 }
\ No newline at end of file
--- a/R/readNGWMNdata.R
+++ b/R/readNGWMNdata.R
--- a/R/readNWISdata.r
+++ b/R/readNWISdata.r
@@ -56,6 +56,7 @@
 #' @examples
 #' \donttest{
 #' # Examples not run for time considerations
+#' 
 #' dataTemp <- readNWISdata(stateCd="OH",parameterCd="00010", service="dv")
 #' instFlow <- readNWISdata(sites="05114000", service="iv", 
 #'                    parameterCd="00060", 
@@ -76,32 +77,35 @@
 #' 
 #' startDate <- as.Date("2013-10-01")
 #' endDate <- as.Date("2014-09-30")
-#' waterYear <- readNWISdata(bBox=c(-83,36.5,-81,38.5), parameterCd="00010", 
+#' waterYear <- readNWISdata(bBox=c(-83,36.5,-82.5,36.75), parameterCd="00010", 
 #'                   service="dv", startDate=startDate, endDate=endDate)
 #' siteInfo <- readNWISdata(stateCd="WI", parameterCd="00010",
 #'                   hasDataTypeCd="iv", service="site")
-#' temp <- readNWISdata(bBox=c(-83,36.5,-81,38.5), parameterCd="00010", service="site", 
+#' temp <- readNWISdata(bBox=c(-83,36.5,-82.5,36.75), parameterCd="00010", service="site", 
 #'                    seriesCatalogOutput=TRUE)
-#' wiGWL <- readNWISdata(stateCd="WI",service="gwlevels")
-#' meas <- readNWISdata(state_cd="WI",service="measurements",format="rdb_expanded")
+#' wiGWL <- readNWISdata(stateCd = "WI", service = "gwlevels")
+#' meas <- readNWISdata(state_cd = "WI", service = "measurements",
+#'                      format = "rdb_expanded")
 #' 
-#' waterYearStat <- readNWISdata(site=c("01646500"),service="stat",statReportType="annual",
-#'                  statYearType="water", missingData="on")
+#' waterYearStat <- readNWISdata(site = c("01646500"), 
+#'                               service = "stat",
+#'                               statReportType="annual",
+#'                               statYearType = "water",
+#'                               missingData = "on")
 #' monthlyStat <- readNWISdata(site=c("01646500"),
 #'                             service="stat",
 #'                             statReportType="monthly")  
-#' dailyStat <- readNWISdata(site=c("01646500"),
-#'                           service="stat",
-#'                           statReportType="daily",
-#'                           statType=c("p25","p50","p75","min","max"),
-#'                           parameterCd="00060")
 #'                                                              
-#' dailyRI <- readNWISdata(stateCd = "Rhode Island", parameterCd = "00060")
+#' dailyStat <- readNWISdata(site = c("01646500"),
+#'                           service = "stat",
+#'                           statReportType = "daily",
+#'                           statType = c("p25","p50","p75","min","max"),
+#'                           parameterCd = "00060")
 #'
-#' arg.list <- list(site="03111548",
-#'                  statReportType="daily",
-#'                  statType=c("p25","p50","p75","min","max"),
-#'                  parameterCd="00060")
+#' arg.list <- list(site = "03111548",
+#'                  statReportType = "daily",
+#'                  statType = c("p25","p50","p75","min","max"),
+#'                  parameterCd = "00060")
 #' allDailyStats_2 <- readNWISdata(arg.list, service="stat")
 #'
 #' #' # use county names to get data
@@ -113,6 +117,7 @@
 #' va_counties <- c("51001","51003","51005","51007","51009","51011","51013","51015")
 #' va_counties_data <- readNWISdata(startDate = "2015-01-01", endDate = "2015-12-31", 
 #' parameterCd = "00060", countycode = va_counties)
+#'  
 #' site_id <- '01594440'
 #' rating_curve <- readNWISdata(service = "rating", site_no = site_id, file_type="base")
 #' all_sites_base <- readNWISdata(service = "rating", file_type="base")
@@ -120,13 +125,11 @@
 #' all_sites_exsa <- readNWISdata(service = "rating", file_type="exsa")
 #' all_sites_24hrs <- readNWISdata(service = "rating", file_type="exsa", period = 24)
 #'                       
-#' today <- readNWISdata(service="iv", startDate = Sys.Date(), 
-#'                       parameterCd = "00060", siteNumber = "05114000")
-#'                       
 #' peak_data <- readNWISdata(service = "peak", 
 #'                           site_no = c("01594440","040851325"),
 #'                           range_selection = "data_range")
 #' 
+#' 
 #' }
 readNWISdata <- function(..., asDateTime=TRUE,convertType=TRUE,tz="UTC"){
  

--- a/R/readNWISpCode.r
+++ b/R/readNWISpCode.r
@@ -21,6 +21,7 @@
 #' @export
 #' @seealso \code{\link{importRDB1}}
 #' @examples
+#' 
 #' paramINFO <- readNWISpCode(c('01075','00060','00931'))
 #' paramINFO <- readNWISpCode(c('01075','00060','00931', NA))
 readNWISpCode <- function(parameterCd){

--- a/R/readNWISsite.r
+++ b/R/readNWISsite.r
@@ -61,8 +61,10 @@
 #' @export
 #' @examples
 #' \donttest{
+#' 
 #' siteINFO <- readNWISsite('05114000')
 #' siteINFOMulti <- readNWISsite(c('05114000','09423350'))
+#' 
 #' }
 readNWISsite <- function(siteNumbers){
  

--- a/R/readNWISunit.r
+++ b/R/readNWISunit.r
@@ -54,6 +54,7 @@
 #' startDate <- "2014-10-10"
 #' endDate <- "2014-10-10"
 #' \donttest{
+#' 
 #' rawData <- readNWISuv(site_id,parameterCd,startDate,endDate)
 #' 
 #' rawData_today <- readNWISuv(site_id, parameterCd, Sys.Date(),Sys.Date())
@@ -68,8 +69,8 @@
 #' # Adding 'Z' to the time indicates to the web service to call the data with UTC time:
 #' GMTdata <- readNWISuv(site_id,parameterCd,
 #'                            "2014-10-10T00:00Z", "2014-10-10T23:59Z")
-#' }
 #' 
+#' }
 readNWISuv <- function (siteNumbers,parameterCd,startDate="",endDate="", tz="UTC"){  
  
  if(as.character(startDate) == "" || (as.Date(startDate) <= Sys.Date()-120)){

--- a/R/whatNWISData.r
+++ b/R/whatNWISData.r
@@ -51,6 +51,7 @@
 #' @export
 #' @examples
 #' \donttest{
+#' 
 #' availableData <- whatNWISdata(siteNumber = '05114000')
 #' # To find just unit value ('instantaneous') data:
 #' uvData <- whatNWISdata(siteNumber = '05114000',service="uv")
@@ -58,6 +59,7 @@
 #' flowAndTemp <- whatNWISdata(stateCd = "WI", service = "uv", 
 #'                              parameterCd = c("00060","00010"),
 #'                              statCd = "00003")
+#' 
 #' }
 whatNWISdata <- function(..., convertType=TRUE){
  

--- a/R/whatNWISsites.R
+++ b/R/whatNWISsites.R
@@ -30,8 +30,10 @@
 #' 
 #' @examples
 #' \donttest{
+#' 
 #' siteListPhos <- whatNWISsites(stateCd="OH",parameterCd="00665")
 #' oneSite <- whatNWISsites(sites="05114000")
+#' 
 #' }
 whatNWISsites <- function(...){
  
@@ -43,7 +45,9 @@ whatNWISsites <- function(...){
  urlCall <- drURL('site',Access=pkg.env$access, arg.list = values)

  rawData <- getWebServiceData(urlCall, encoding='gzip')
-
+  if(is.null(rawData)){
+    return(invisible(NULL))
+  }
  doc <- xml_root(rawData)
  siteCategories <- xml_children(doc)
  retVal <- NULL

--- a/R/whatWQPdata.R
+++ b/R/whatWQPdata.R
@@ -3,10 +3,12 @@
 #' @export
 #' @examples
 #' \donttest{
+#' 
 #' site1 <- whatWQPsamples(siteid="USGS-01594440")
 #' 
 #' type <- "Stream"
 #' sites <- whatWQPsamples(countycode="US:55:025",siteType=type)
+#' 
 #' }
 whatWQPsamples <- function(...){
  
@@ -159,6 +161,9 @@ whatWQPdata <- function(..., saveFile = tempfile()){
  }

  doc <- getWebServiceData(baseURL, httr::write_disk(saveFile_zip))
+  if(is.null(doc)){
+    return(invisible(NULL))
+  }
  headerInfo <- attr(doc, "headerInfo")
  
  if(headerInfo$`total-site-count` == 0){

--- a/R/whatWQPsites.R
+++ b/R/whatWQPsites.R
@@ -58,12 +58,14 @@
 #' @seealso whatNWISdata
 #' @examples
 #' \donttest{
+#' 
 #' site1 <- whatWQPsites(siteid="USGS-01594440")
 #' 
 #' type <- "Stream"
 #' sites <- whatWQPsites(countycode="US:55:025",
 #'                       characteristicName = "Phosphorus",
 #'                       siteType=type)
+#' 
 #' }
 whatWQPsites <- function(...){


--- a/man/findNLDI.Rd
+++ b/man/findNLDI.Rd
--- a/man/getWebServiceData.Rd
+++ b/man/getWebServiceData.Rd
@@ -26,6 +26,6 @@ offering <- '00003'
 property <- '00060'
 obs_url <- constructNWISURL(siteNumber,property,startDate,endDate,'dv')
 \donttest{
-rawData <- getWebServiceData(obs_url)
+  rawData <- getWebServiceData(obs_url)
 }
 }