#344 fix for lcd()

use a new utiliity fxn for safe reading of csv files with more informative error message
export lcd_cache and make manual file for it so that users can manage the lcd cache
change internal fxn read_csv to storms_read_csv as it was only used for storms
add utilities tests file, add test for lcd() for bad files

NAMESPACE

@@ -67,6 +67,7 @@ export(isd_read)
 export(isd_stations)
 export(isd_stations_search)
 export(lcd)
+export(lcd_cache)
 export(lcd_cleanup)
 export(meteo_clear_cache)
 export(meteo_coverage)

R/lcd.R

@@ -8,7 +8,7 @@
 #' @param ... curl options passed on to [crul::verb-GET]
 #' @return a data.frame, with many columns, and variable rows
 #' depending on how frequently data was collected in the given year
-#'
+#' @seealso lcd_cache
 #' @references
 #' Docs: 
 #' <https://www.ncei.noaa.gov/data/local-climatological-data/doc/LCD_documentation.pdf>
@@ -52,7 +52,7 @@ lcd <- function(station, year, ...) {
   assert_range(year, 1901:format(Sys.Date(), "%Y"))
 
   path <- lcd_get(station = station, year = year, ...)
-  tmp <- read.csv(path, header = TRUE, sep = ",", stringsAsFactors = FALSE)
+  tmp <- safe_read_csv(path)
   names(tmp) <- tolower(names(tmp))
   df <- tibble::as_tibble(tmp)
   structure(df, class = c(class(df), "lcd"))
@@ -96,3 +96,45 @@ lcd_base <- function() {
 lcd_key <- function(station, year) {
   file.path(lcd_base(), year, paste0(station, ".csv"))
 }
+
+#' @title lcd_cache
+#' @description Manage the `lcd()` cache
+#' @export
+#' @details The cache directory for `lcd()` is
+#' `paste0(rappdirs::user_cache_dir(), "/R/noaa_lcd")`, but you can set
+#' your own path using `cache_path_set()`
+#'
+#' `cache_delete` only accepts 1 file name, while
+#' `cache_delete_all` doesn't accept any names, but deletes all files.
+#' For deleting many specific files, use `cache_delete` in a [lapply()]
+#' type call
+#'
+#' @section Useful user functions:
+#'
+#' - `lcd_cache$cache_path_get()` get cache path
+#' - `lcd_cache$cache_path_set()` set cache path
+#' - `lcd_cache$list()` returns a character vector of full path file names
+#' - `lcd_cache$files()` returns file objects with metadata
+#' - `lcd_cache$details()` returns files with details
+#' - `lcd_cache$delete()` delete specific files
+#' - `lcd_cache$delete_all()` delete all files, returns nothing
+#'
+#' @examples \dontrun{
+#' lcd_cache
+#'
+#' # list files in cache
+#' lcd_cache$list()
+#'
+#' # delete certain database files
+#' # lcd_cache$delete("file path")
+#' # lcd_cache$list()
+#'
+#' # delete all files in cache
+#' # lcd_cache$delete_all()
+#' # lcd_cache$list()
+#'
+#' # set a different cache path from the default
+#' # lcd_cache$cache_path_set(full_path = file.path(tempdir(), "foo_bar"))
+#' # lcd_cache
+#' }
+"lcd_cache"

R/storms.R

@@ -105,7 +105,7 @@ storm_data <- function(basin = NULL, storm = NULL, year = NULL,
     csvpath <- storm_GET(path, basin, storm, year, overwrite, ...)
   }
   message(sprintf("<path>%s", csvpath), "\n")
-  tibble::as_tibble(read_csv(csvpath))
+  tibble::as_tibble(storms_read_csv(csvpath))
 }
 
 storm_GET <- function(bp, basin, storm, year, overwrite, ...){

R/zzz.r

@@ -159,13 +159,30 @@ check_response_swdi <- function(x, format){
 
 noaa_compact <- function(l) Filter(Negate(is.null), l)
 
-read_csv <- function(x){
-  tmp <- read.csv(x, header = FALSE, sep = ",", stringsAsFactors=FALSE, skip = 3)
-  nmz <- names(read.csv(x, header = TRUE, sep = ",", stringsAsFactors=FALSE, skip = 1, nrows=1))
+storms_read_csv <- function(x){
+  tmp <- read.csv(x, header = FALSE, sep = ",",
+    stringsAsFactors=FALSE, skip = 3)
+  nmz <- names(read.csv(x, header = TRUE, sep = ",",
+    stringsAsFactors=FALSE, skip = 1, nrows=1))
   names(tmp) <- tolower(nmz)
   tmp
 }
 
+safe_read_csv <- function(x, header = TRUE, stringsAsFactors = FALSE, sep = ",") {
+  assert(x, "character")
+  tmp <- tryCatch(
+    read.csv(x, header = header, sep = sep,
+      stringsAsFactors = stringsAsFactors),
+    error = function(e) e,
+    warning = function(w) w
+  )
+  if (inherits(tmp, "warning"))
+    stop(tmp$message)
+  if (inherits(tmp, "error"))
+    stop("file ", x, " malformed; delete file and try again")
+  return(tmp)
+}
+
 check_key <- function(x){
   tmp <- if(is.null(x)) Sys.getenv("NOAA_KEY", "") else x
   if(tmp == "") getOption("noaakey", stop("need an API key for NOAA data")) else tmp

tests/testthat/test-lcd.R

@@ -36,3 +36,14 @@ test_that("lcd fails well", {
   expect_error(lcd(5, list(1)),
                "year must be of class")
 })
+
+test_that("lcd fails well when trying to read a bad file", {
+  skip_on_cran()
+
+  lcd_cache$cache_path_set(full_path = file.path(tempdir(), "foo_bar"))
+  lcd_cache$mkdir()
+  path <- file.path(tempdir(), "foo_bar", "2020_72517014737.csv")
+  file.create(path)
+  expect_error(lcd(72517014737, 2020), "malformed", class = "error")
+  unlink(path)
+})

tests/testthat/test-utilities.R

@@ -0,0 +1,22 @@
+test_that("safe_read_csv",{
+  expect_is(safe_read_csv, "function")
+  expect_error(safe_read_csv())
+  expect_error(safe_read_csv(5), "class")
+
+  # file doesn't exist, throws warning on read.csv
+  file1 <- tempfile()
+  expect_error(safe_read_csv(file1), "No such file")
+
+  # file empty
+  file2 <- tempfile()
+  file.create(file2)
+  expect_error(safe_read_csv(file2), "malformed")
+
+  # file with a single newline
+  file3 <- tempfile()
+  cat("\n", file = file3)
+  expect_error(safe_read_csv(file3), "malformed")
+
+  # cleanup
+  invisible(lapply(c(file1, file2, file3), unlink))
+})