refactor download functions. add graceful errors

DESCRIPTION

@@ -13,6 +13,7 @@ LazyData: true
 RoxygenNote: 6.1.1
 Imports:
   crul,
+  fauxpas,
   readr,
   sf
 BugReports: https://github.com/mps9506/wd4tx/isssues

R/download_coastal_geometry.R

@@ -13,7 +13,8 @@ download_coastal_geometry <- function(type) {
   ## extra data in the geojson, need to figure out how to get the data
   ## into the sf
 
-  content <- get_well_meta(url,
-                           path = NULL)
+  content <- get_download(url,
+                          path = NULL,
+                          accept = "json")
   return(content)
 }

R/download_coastal_hydrology.R

@@ -19,7 +19,7 @@ download_coastal_hydrology <- function(geoid, resample = NULL) {
   else args = list(resample = resample)
 
   ## download
-  content <- get_coastal_sites(url, path, args = args)
+  content <- get_download(url, path, args = args, accept = "json")
 
   ## parse the returned json
   content <- jsonlite::fromJSON(content)

R/download_coastal_site_data.R

@@ -29,7 +29,7 @@ download_coastal_site_data <- function(station,
               binning = bin)
 
   ## download
-  content <- get_coastal_sites(url, path, args = args)
+  content <- get_download(url, path, args = args, accept = "json")
 
   ## parse the returned json
   content <- jsonlite::fromJSON(content)

R/download_coastal_site_parameters.R

@@ -15,7 +15,7 @@ download_coastal_site_parameters <- function(station) {
                  station)
   path <- NULL
   ## download
-  content <- get_coastal_sites(url, path)
+  content <- get_download(url, path, accept = "json")
 
   ## parse the returned json
   content <- jsonlite::fromJSON(content)

R/download_coastal_sites.R

@@ -16,7 +16,7 @@ download_coastal_sites <- function(all_stations = FALSE) {
   else args = list(all = "false")
 
   ## download
-  content <- get_coastal_sites(url, path, args)
+  content <- get_download(url, path, args, accept = "json")
 
   ## parse the returned json
   content <- jsonlite::fromJSON(content)
@@ -26,25 +26,3 @@ download_coastal_sites <- function(all_stations = FALSE) {
 
   return(content)
   }
-
-
-get_coastal_sites <-  function(url,
-                               path,
-                               args = list(),
-                               ...) {
-  cli <- crul::HttpClient$new(
-    url = url,
-    headers = list(Accept = "application/json")
-  )
-
-  res <- cli$get(path, query = args)
-  print(res$url)
-
-  if(res$status_code != 200) {
-    stop(paste0("Server returned: "), res$response_headers$status)
-  }
-
-  content <- res$parse("UTF-8")
-
-  return(content)
-}

R/download_lep.R

@@ -31,10 +31,9 @@ download_lep <- function(quad = "710",
                  "&end_date=",
                  end_date)
 
-  content <- get_reservoirs(url = url,
-                            path = path)
-
-  writeLines(content)
+  content <- get_download(url = url,
+                          path = path,
+                          accept = "csv")
 
   df <- readr::read_csv(content,
                         comment = "#")

R/download_reservoir.R

@@ -97,11 +97,13 @@ download_reservoir <- function(aggregate_by = NULL,
   url <- "https://www.waterdatafortexas.org"
   path <- paste0("reservoirs/", call)
 
-  content <- get_reservoirs(url = url,
-                            path = path)
+  content <- get_download(url = url,
+                          path = path,
+                          accept = "csv")
 
   df <- readr::read_csv(content,
-                        comment = "#")
+                        comment = "#",
+                        col_types = "Dddddddd")
 
   ## Note for future: I'd like to extract the commented metadata.
   ## However, it is only sometimes returned in the parsed csv.
@@ -170,24 +172,4 @@ check_arguments_download_reservoir <- function(aggregate_by,
 }
 
 
-# function to make the http request
 
-get_reservoirs <- function(url,
-                           path,
-                           args = list(),
-                           ...) {
-  cli <- crul::HttpClient$new(
-    url = url,
-    headers = list(Accept = "text/csv")
-  )
-
-  res <- cli$get(path)
-
-  if(res$status_code != 200) {
-    stop(paste0("Server returned: "), res$response_headers$status)
-  }
-
-  content <- res$parse("UTF-8")
-
-  return(content)
-}

R/download_well.R

@@ -16,8 +16,9 @@ download_well <- function(state_well_nmbr) {
   url <- "https://www.waterdatafortexas.org"
   path <- paste0("groundwater/well/", state_well_nmbr, ".csv")
 
-  content <- get_reservoirs(url = url,
-                            path = path)
+  content <- get_download(url = url,
+                          path = path,
+                          accept = "csv")
 
   df <- readr::read_csv(content,
                         comment = "#")

R/download_well_meta.R

@@ -9,29 +9,10 @@ download_well_meta <- function() {
   url <- "https://www.waterdatafortexas.org"
   path <- paste0("groundwater/wells.geojson")
 
-  content <- get_well_meta(url, path)
+  content <- get_download(url, path, accept = "json")
+  content <- sf::read_sf(content)
   return(content)
 }
 
 
-get_well_meta <- function(url,
-                           path,
-                           args = list(),
-                           ...) {
-  cli <- crul::HttpClient$new(
-    url = url,
-    headers = list(Accept = "application/json")
-  )
-
-  res <- cli$get(path)
-
-  if(res$status_code != 200) {
-    stop(paste0("Server returned: "), res$response_headers$status)
-  }
-
-  content <- res$parse("UTF-8")
 
-  content <- sf::read_sf(content)
-
-  return(content)
-}

R/utils.R

@@ -0,0 +1,37 @@
+# function to make the http request for csv downloads
+get_download <- function(url,
+                    path,
+                    args = list(),
+                    accept = "csv",
+                    ...) {
+
+  if(accept == "csv") {
+    headers = list(Accept = "text/csv")
+  } else {
+    if(accept == "json") {
+      headers = list(Accept = "application/json")
+    }
+  }
+
+  cli <- crul::HttpClient$new(url = url,
+                              headers = headers)
+
+  res <- cli$get(path)
+
+  errs(res)
+
+  content <- res$parse("UTF-8")
+
+  return(content)
+}
+
+
+
+# return http errors gracefully
+errs <- function(x) {
+  if (x$status_code > 201) {
+
+    fun <- fauxpas::find_error_class(x$status_code)$new()
+    fun$do_verbose(x)
+  }
+}

temp_sf.R

@@ -0,0 +1,38 @@
+
+
+df <- download_coastal_geometry(type = "basin")
+
+df.geojson <- geojson::to_geojson(df)
+
+geojson::properties_get(df.geojson, property = "Acres")
+
+
+df.sf <- geojsonsf::geojson_sf(df.geojson, expand_geometries = TRUE)
+
+library(ggplot2)
+ggplot(df.sf) +
+  geom_sf(aes())
+
+
+
+
+geojsonlint::geojson_hint(df, inform = TRUE)
+
+
+df.online <- geojsonio::geojson_read("https://gist.githubusercontent.com/mps9506/70861c06ff3990bed07131d1fc4cae7a/raw/882f29e349a2e213cc248dda30270326393eb194/estuary.geojson",
+                                     what = "sp", method = "local")
+
+
+df.online <- geojsonio::geojson_json(df.online)
+df.online <- geojsonio::geojson_sf(df.online)
+
+library(dplyr)
+library(sf)
+df.online %>%
+
+ggplot(df.online) +
+  geom_sf(aes(fill = as.factor(FID))) +
+  geom_sf_label(aes(label = FID)) +
+  scale_fill_viridis_d()
+
+df.online