WIP Set up import from Zenodo, GitHub hash; remove .downloadZ

R/bugphyzz.R

@@ -12,8 +12,8 @@ utils::globalVariables(c(
 #' tidy data.frames. To learn more about the structure of the data.frames
 #' please check the bugphyzz vignette with `browseVignettes("bugphyzz")`.
 #'
-#' @param version Character string indicating the version.
-#' Options: devel or a zenodo record.
+#' @param version Character string indicating the version. Default is the
+#' latest release on Zenodo.  Options: Zenodo DOI, GitHub commit hash, or devel.
 #' @param force_download Logical value. Force a fresh download of the data or
 #' use the one stored in the cache (if available). Default is FALSE.
 #' @param v Validation value. Default 0.5 (see details).
@@ -54,12 +54,14 @@ utils::globalVariables(c(
 #' names(bp)
 #'
 importBugphyzz <- function(
-    version = 'devel', force_download = FALSE, v = 0.5, exclude_rarely = TRUE
+    version = "d3fd894", force_download = FALSE, v = 0.5, exclude_rarely = TRUE
 
 ) {
-  if (version == 'devel') {
-    output <- .downloadDevel(force_download)
-  }
+
+  ## output is a list of three data.frames
+  ## one of each: binary, multistate, numeric
+  output <- .downloadResource(version, force_download)
+
   ## TODO add release version
   output <- lapply(output, function(x) split(x, x$Attribute))
   output <- purrr::list_flatten(output)
@@ -297,30 +299,21 @@ getTaxonSignatures <- function(tax, bp, ...) {
     )
 }
 
-## Import the devel version of bupghyzz
-.downloadDevel <- function(force_download) {
-  types <- c("multistate", "binary", "numeric")
-  urls <- paste0(
-    "https://github.com/waldronlab/bugphyzzExports/raw/main/bugphyzz_",
-    types,
-    ".csv"
-  )
-  names(urls) <- types
-  output <- vector("list", length(urls))
-  for (i in seq_along(output)) {
-    message("Importing ", names(urls)[i], " data...")
-    names(output)[i] <- names(urls)[i]
-    rpath <- .getResource(
-      rname = paste0("bugphyzz_", names(urls)[i], ".tsv"),
-      url = urls[i], verbose = TRUE, force = force_download
-    )
-    output[[i]] <- utils::read.csv(rpath, header = TRUE, skip = 1) |>
-      dplyr::mutate(Attribute = tolower(Attribute))
+## Import a version of bupghyzz
+.downloadResource <- function(version = "d3fd894", force_download) {
+  if (stringr::str_detect(version, "^10.5281/zenodo.[0-9]+$")) {
+    suffix <- sub("^10.5281/zenodo\\.", "", version)
+    output <- .downloadZ(suffix, force_download)
+  } else if (version == "devel") {
+    output <- .downloadGH(version, force_download)
+  } else if (stringr::str_detect(version, stringr::regex("^[:alnum:]{7}$")) ){
+    output <- .downloadGH(version, force_download)
+  } else {
+    stop("Version must be a Zenodo DOI, GitHub commit hash, or 'devel'.")
   }
   return(output)
 }
 
-## TODO update this function when relase is ready
 .downloadZ <- function(record, force_download) {
   base_url <- paste0("https://zenodo.org/api/records/", record)
   req <- httr2::request(base_url)
@@ -340,9 +333,28 @@ getTaxonSignatures <- function(tax, bp, ...) {
 
   output <- vector("list", length(files))
   for (i in seq_along(output)) {
-    output[[i]] <- utils::read.csv(files[i], header = TRUE)
-    # output[[i]] <- utils::read.csv(files, header = TRUE, skip = 1)
-    # dplyr::mutate(Attribute = tolower(Attribute))
+    output[[i]] <- utils::read.csv(files, header = TRUE, skip = 1) |>
+      dplyr::mutate(Attribute = tolower(Attribute))
   }
   return(output)
 }
+
+.downloadGH <- function(version = "devel", force_download) {
+    file_suffix <- c("binary", "multistate", "numeric")
+    urls <- paste0("https://github.com/waldronlab/bugphyzzExports/raw/",
+           version, "/bugphyzz_", file_suffix, ".csv"
+    )
+    names(urls) <-  c("binary", "multistate", "numeric")
+    output <- vector("list", length(urls))
+    for (i in seq_along(output)) {
+      message("Importing ", names(urls)[i], " data...")
+      names(output)[i] <- names(urls)[i]
+      rpath <- .getResource(
+        rname = paste0("bugphyzz_", names(urls)[i], ".csv"),
+        url = urls[i], verbose = TRUE, force = force_download
+      )
+      output[[i]] <- utils::read.csv(rpath, header = TRUE, skip = 1) |>
+        dplyr::mutate(Attribute = tolower(Attribute))
+    }
+    return(output)
+}

tests/testthat/test-importBugphyzz.R

@@ -2,7 +2,6 @@
 # Setup -------------------------------------------------------------------
 
 library(purrr)
-bp <- importBugphyzz()
 expected_columns_multistate <- c(
   NCBI_ID = "integer", Taxon_name = "character",
   Rank = "character",
@@ -62,17 +61,30 @@ checkColumnTypes <- function(x) {
   return(all(lgl_vct))
 }
 
-# Tests -------------------------------------------------------------------
+checkNAs <- function(x) {
+  x
+}
 
-test_that("importBugphyzz works", {
-  chr_vct <- map_chr(bp, class)
-  expect_true(all("data.frame" == chr_vct))
-})
+# tests -------------------------------------------------------------------
 
-test_that("All variable names are correct", {
+test_that("importBugphyzz works with devel", {
+  bp <- importBugphyzz(version = "devel", force_download = TRUE)
+  expect_true(all("data.frame" == map_chr(bp, class)))
+  expect_true(all(map_lgl(bp, ~ nrow(.x) > 0)))
   expect_true(all(map_lgl(bp, checkColumnNames)))
+  expect_true(all(map_lgl(bp, checkColumnTypes)))
 })
 
-test_that("All variable types are correct", {
+test_that("importBugphyzz works with hash", {
+  bp <- importBugphyzz(version = "d3fd894", force_download = TRUE)
+  expect_true(all("data.frame" == map_chr(bp, class)))
+  expect_true(all(map_lgl(bp, ~ nrow(.x) > 0)))
+  expect_true(all(map_lgl(bp, checkColumnNames)))
   expect_true(all(map_lgl(bp, checkColumnTypes)))
 })
+
+## TODO create test for using Zenodo
+
+test_that("importBugphyzz doesn't work with other words", {
+  expect_error(importBugphyzz(version = "abcd-1234", force_download = TRUE))
+})