R/cacheFile.R

In WebGestaltR: Gene Set Analysis Toolkit WebGestaltR

urlToFile <- function(dataUrl) {
    result <- sub("^http://", "", dataUrl)
    result <- sub("^https://", "", result)
    result <- gsub("\\?[^?]+?=", "_", result)
    result <- gsub("&[^&]+?=", "_", result)
    result <- gsub("[:/.]", "_", result)
    result <- gsub("_+", "_", result, fixed = TRUE)
    return(result)
}

#' cacheUrl
#'
#' Get data from a URL or cache and optionally save in cache for reuse
#'
#' @param dataUrl The URL of data
#' @param cache The cache directory. Defaults to \code{NULL} and fetches data from server.
#' @param query The list of queries passed on to httr methods
#'
#' @return response object from httr request
#'
#' @importFrom httr GET
#' @keywords internal
#'
cacheUrl <- function(dataUrl, cache = NULL, query = NULL) {
    if (!is.null(cache)) {
        dir.create(cache, showWarnings = FALSE)
        if (!is.null(query)) {
            localFilePrefix <- urlToFile(paste0(dataUrl, "_", paste0(query, collapse = "_")))
        } else {
            localFilePrefix <- urlToFile(dataUrl)
        }
        localFile <- file.path(cache, paste0(localFilePrefix, ".rds"))
    }
    if (!is.null(cache) && file.exists(localFile)) {
        # cat("Reading from cache: ", localFile, "\n")
        response <- readRDS(localFile)
    } else {
        # cat("Reading from server: ", dataUrl, "\n")
        if (!is.null(query)) {
            if (!("version" %in% names(query))) {
                query[["version"]] <- WEBGESTALT_DATA_VERSION
            }
            response <- GET(dataUrl, query = query)
        } else {
            response <- GET(dataUrl, query = list(version = WEBGESTALT_DATA_VERSION))
        }
        if (response$status_code != 200) {
            return(response)
        }
        if (!is.null(cache)) {
            saveRDS(response, localFile)
        }
    }
    return(response)
}