Set cache path when creating BEDbase instance (#13)

* Add bb_save
* Modify bb_save to save bedsets

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: bedbaser
 Title: A BEDbase client
-Version: 0.99.4
+Version: 0.99.8
 Authors@R: c(
     person(
         given = "Jen",

NAMESPACE

@@ -7,14 +7,18 @@ export(bb_example)
 export(bb_list_beds)
 export(bb_list_bedsets)
 export(bb_metadata)
+export(bb_save)
 export(bb_to_granges)
 export(bb_to_grangeslist)
+export(getCache)
+export(setCache)
+exportMethods(getCache)
 exportMethods(operations)
+exportMethods(setCache)
 importFrom(AnVIL,Service)
 importFrom(AnVIL,operations)
 importFrom(BiocFileCache,BiocFileCache)
 importFrom(BiocFileCache,bfcadd)
-importFrom(BiocFileCache,bfccache)
 importFrom(BiocFileCache,bfcdownload)
 importFrom(BiocFileCache,bfcneedsupdate)
 importFrom(BiocFileCache,bfcquery)
@@ -38,6 +42,5 @@ importFrom(stringr,str_split_1)
 importFrom(tibble,tibble)
 importFrom(tidyr,unnest)
 importFrom(tidyr,unnest_wider)
-importFrom(tools,R_user_dir)
 importFrom(utils,URLencode)
 importFrom(utils,read.table)

R/bedbaser.R

@@ -5,6 +5,7 @@
 #' @returns BEDbase class instance
 .BEDbase <- setClass(
     "BEDbase",
+    slots = c("cache"),
     contains = "Service"
 )
 
@@ -22,6 +23,8 @@
 #'
 #' The convenience functions are as follows
 #' * `bedbaser::BEDbase()`: API service constructor
+#' * `bedbaser::getCache()`: Retrieve cache
+#' * `bedbaser::setCache()`: Set path to cache
 #' * `bedbaser::bb_example()`: Retrieve an example BED file or BEDset
 #' * `bedbaser::bb_metadata()`: Retrieve metadata for a BED file or BEDset
 #' * `bedbaser::bb_list_beds()`: List all BED files
@@ -30,21 +33,25 @@
 #' * `bedbaser::bb_bed_text_search()`: Search BED files by text
 #' * `bedbaser::bb_to_granges()`: Create a `GRanges` object from a BED id
 #' * `bedbaser::bb_to_grangeslist()`: Create a `GrangesList` from a BEDset id
-#' Set the environment variable `BEDBASER_CACHE` to alter the cache path for
-#' downloaded BED files.
+#' * `bedbaser::bb_save()`: Save a BED file to a path.
+#'
+#' @param cache_path string() cache
 #'
 #' @importFrom AnVIL Service
 #' @importFrom rlang warn
 #'
-#' @returns Service object
+#' @returns BEDbase object
 #'
 #' @examples
 #' BEDbase()
 #'
 #' @export
-BEDbase <- function() {
+BEDbase <- function(cache_path) {
+    if (missing(cache_path))
+        cache_path <- tools::R_user_dir("bedbaser", which = "cache")
     suppressWarnings(
         .BEDbase(
+            cache = BiocFileCache::BiocFileCache(cache_path),
             Service(
                 service = "bedbase",
                 host = "api.bedbase.org",
@@ -58,6 +65,69 @@ BEDbase <- function() {
     )
 }
 
+#' @rdname BEDbase
+#'
+#' @param x BEDbase object
+#' @param quietly (default TRUE) display messages
+#'
+#' @export
+setGeneric("getCache", function(x, quietly = TRUE) standardGeneric("getCache"))
+
+#' Return cache path
+#'
+#' @param x BEDbase object
+#' @param quietly (default TRUE) display messages
+#'
+#' @return BiocFileCache cache of BED files
+#'
+#' @examples
+#' api <- BEDbase(tempdir())
+#' getCache(api)
+#'
+#' @export
+setMethod(
+    "getCache", "BEDbase",
+    function(x, quietly = TRUE) {
+        if (quietly)
+            BiocFileCache::bfcinfo(x@cache)
+         x@cache
+    }
+)
+
+#' @rdname BEDbase
+#'
+#' @param x BEDbase object
+#' @param cache_path character()
+#' @param quietly (default TRUE) display messages
+#'
+#' @export
+setGeneric("setCache",
+    function(x, cache_path, quietly = TRUE) standardGeneric("setCache")
+)
+
+#' Set cache path
+#'
+#' @param x BEDbase object
+#' @param cache_path character()
+#' @param quietly (default TRUE) display messages
+#'
+#' @return BiocFileCache cache of BED files
+#'
+#' @examples
+#' api <- BEDbase(tempdir())
+#' api <- setCache(api, "/tmp")
+#'
+#' @export
+setMethod(
+    "setCache", "BEDbase",
+    function(x, cache_path, quietly = TRUE) {
+        x@cache <- BiocFileCache::BiocFileCache(cache_path)
+        if (quietly)
+            BiocFileCache::bfcinfo(x@cache)
+        x
+    }
+)
+
 #' Display API
 #'
 #' @param x BEDbase object
@@ -332,7 +402,7 @@ bb_to_granges <- function(
         quietly = TRUE) {
     stopifnot(file_type %in% c("bed", "bigbed"))
     metadata <- bb_metadata(api, bed_id, TRUE)
-    file_path <- .get_file(metadata, file_type, "http", quietly)
+    file_path <- .get_file(metadata, file_type, "http", getCache(api), quietly)
 
     if (file_type == "bed") {
         .bed_file_to_granges(file_path, metadata, extra_cols, quietly)
@@ -376,3 +446,38 @@ bb_to_grangeslist <- function(api, bedset_id, quietly = TRUE) {
     }
     GRangesList(gros)
 }
+
+#' Save a BED or BEDset files to a path given an id
+#'
+#' @rdname bb_save
+#'
+#' @param api API object of BEDbase created from BEDbase()
+#' @param bed_or_bedset_id integer() BED or BEDset record identifier
+#' @param path character() directory to save file
+#' @param file_type character() (default bed) bed, bigbed, etc.
+#' @param access_type character() (default http)  s3 or http
+#' @param quietly logical() (default TRUE) display messages
+#'
+#' @examples
+#' api <- BEDbase()
+#' ex <- bb_example(api, "bed") 
+#' bb_save(api, ex$id, tempdir())
+#'
+#' @export
+bb_save <- function(
+        api, bed_or_bedset_id, path, file_type = "bed", access_type = "http",
+        quietly = TRUE)
+{
+    if (!dir.exists(path))
+        rlang::abort(paste(path, "doesn't exist.", sep = " "))
+    metadata <- bb_metadata(api, bed_or_bedset_id, TRUE)
+    if ("bedsets" %in% names(metadata)) {
+        ids <- list(metadata$id)
+    } else {
+        ids <- metadata$bed_ids
+    }
+    for (id in ids) {
+        metadata <- bb_metadata(api, id, TRUE)
+        .get_file(metadata, file_type, access_type, path, quietly)
+    }
+}

R/cache.R

@@ -1,37 +1,9 @@
-#' Get the cache
-#'
-#' Uses BEDBASER_CACHE for cache path if set; otherwise, it uses the default R
-#' cache path for bedbaser.
-#'
-#' @param quietly logical() (default TRUE) display message
-#'
-#' @importFrom BiocFileCache BiocFileCache bfccache
-#' @importFrom rlang inform
-#' @importFrom tools R_user_dir
-#'
-#' @returns BiocFileCache object
-#'
-#' @examples
-#' Sys.setenv("BEDBASER_CACHE" = ".cache/bedbaser")
-#' .get_cache()
-#'
-#' @noRd
-.get_cache <- function(quietly = TRUE) {
-    bfc <- ifelse(Sys.getenv("BEDBASER_CACHE") != "",
-        Sys.getenv("BEDBASER_CACHE"),
-        R_user_dir("bedbaser", which = "cache")
-    )
-    if (!quietly) {
-        inform(paste("Using", bfccache()))
-    }
-    BiocFileCache(bfc)
-}
-
 #' Retrieve path from cache or download file and cache
 #'
 #' This function is described in the BiocFileCache vignette.
 #'
 #' @param url character() remote resource
+#' @param bfc BiocFileCache object
 #' @param quietly logical() (default TRUE) display message
 #'
 #' @importFrom BiocFileCache BiocFileCache bfcadd bfcdownload bfcneedsupdate
@@ -45,11 +17,10 @@
 #'     "https://data2.bedbase.org/files/2/6/",
 #'     "26a57da7c732a8e63a1dda7ea18af021.bed.gz"
 #' )
-#' .download_and_cache(url)
+#' .download_to_cache(url, BiocFileCache::BiocFileCache(tempdir()))
 #'
 #' @noRd
-.download_and_cache <- function(url, quietly = TRUE) {
-    bfc <- .get_cache()
+.download_to_cache <- function(url, bfc, quietly = TRUE) {
     rid <- bfcquery(bfc, url, "rname")$rid
     if (!length(rid)) {
         if (!quietly) {

R/utils.R

@@ -20,11 +20,14 @@
         unnest_wider(access_url)
 }
 
-#' Get a file from BEDbase
+#' Save a file from BEDbase to the cache or a path
+#'
+#' Will create directories that do not exist when saving
 #'
 #' @param metadata list() full metadata
 #' @param file_type character() bed or bigbed
 #' @param access_type character() s3 or http
+#' @param cache_or_path BiocFileCache or character() cache or save path
 #' @param quietly logical() (default TRUE) display messages
 #'
 #' @importFrom R.utils gunzip
@@ -36,24 +39,33 @@
 #' api <- BEDbase()
 #' ex_bed <- bb_example(api, "bed")
 #' md <- bb_metadata(api, ex_bed$id, TRUE)
-#' .get_file(md, "bed", "http")
+#' .get_file(md, "bed", "http", tempdir())
 #'
 #' @noRd
 .get_file <- function(
         metadata, file_type = c("bed", "bigbed"),
-        access_type = c("s3", "http"), quietly = TRUE) {
+        access_type = c("s3", "http"), cache_or_path, quietly = TRUE) {
     file_details <- .format_metadata_files(metadata$files) |>
         filter(
             name == paste(file_type, "file", sep = "_"),
             access_id == access_type
         )
-    gzipfile <- .download_and_cache(file_details$url, quietly)
-    tryCatch(
-        gunzip(gzipfile, remove = FALSE),
-        error = function(e) {
-            gsub(".gz", "", gzipfile)
-        }
-    )
+    if (class(cache_or_path) == "BiocFileCache") {
+        cached_file <- .download_to_cache(file_details$url, cache_or_path, quietly)
+        bedbase_file <- tryCatch(
+            gunzip(cached_file, remove = FALSE),
+            error = function(e) {
+                gsub(".gz", "", cached_file)
+            }
+        )
+    } else {
+        if (!dir.exists(cache_or_path))
+            dir.create(cache_or_path, recursive = TRUE)
+        url_parts <- unlist(strsplit(file_details$url, "/"))
+        bedbase_file <- file.path(cache_or_path, url_parts[length(url_parts)]) 
+        utils::download.file(file_details$url, bedbase_file, quiet = quietly)
+    }
+    bedbase_file
 }
 
 #' Get extra_cols