utils::globalVariables(c(
"actualFile", "checksum.x", "checksum.y", "expectedFile", "filesize.x", "filesize.y", "result"
))
defaultGitRepoToSpaDESModules <- "PredictiveEcology/SpaDES-modules"
#' Find the latest module version from a SpaDES module repository
#'
#' Modified from <https://stackoverflow.com/a/25485782/1380598>.
#'
#' @param name Character string giving the module name.
#'
#' @param repo GitHub repository name, specified as `"username/repo"`.
#' Default is `"PredictiveEcology/SpaDES-modules"`, which is
#' specified by the global option `spades.moduleRepo`.
#' Only `master`/`main` branches can be used at this point.
#'
#' @return `numeric_version`
#'
#' @details
#' `getModuleVersion` extracts a module's most recent version by
#' looking at the module \file{.zip} files contained in the module directory.
#' It takes the most recent version, based on the name of the zip file.
#'
#' See the modules vignette for details of module directory structure
#' (<https://spades-core.predictiveecology.org/articles/ii-modules.html#module-directory-structure-modulename>),
#' and see our SpaDES-modules repo for details of module repository structure
#' (<https://github.com/PredictiveEcology/SpaDES-modules>).
#'
#' @author Alex Chubaty
#' @export
#' @rdname getModuleVersion
#' @seealso [zipModule()] for creating module \file{.zip} folders.
#'
setGeneric("getModuleVersion", function(name, repo) {
standardGeneric("getModuleVersion")
})
#' @rdname getModuleVersion
setMethod(
"getModuleVersion",
signature = c(name = "character", repo = "character"),
definition = function(name, repo) {
if (length(name) > 1) {
warning("name contains more than one module. Only the first will be used.")
name <- name[1]
}
moduleFiles <- checkModule(name, repo)
zipFiles <- grep(paste0(name, "_+.+.zip"), moduleFiles, value = TRUE) # moduleName_....zip only
zipFiles <- grep(file.path(name, "data"), zipFiles, invert = TRUE, value = TRUE) # remove any zip in data folder
# all zip files is not correct behaviour, only
versions <- strsplit(zipFiles, "_") |>
unlist() |>
grep("[.]zip$", x = _, value = TRUE) |>
strsplit("[.]zip$") |>
unlist() |>
as.numeric_version()
currentVersion <- sort(versions, decreasing = TRUE)[1]
return(currentVersion)
})
#' @rdname getModuleVersion
setMethod("getModuleVersion",
signature = c(name = "character", repo = "missing"),
definition = function(name) {
v <- getModuleVersion(name, getOption("spades.moduleRepo",
defaultGitRepoToSpaDESModules))
return(v)
})
#' Check for the existence of a remote module
#'
#' Looks in the remote `repo` for a module named `name`.
#'
#' @param name Character string giving the module name.
#'
#' @param repo GitHub repository name.
#' Default is `"PredictiveEcology/SpaDES-modules"`, which is
#' specified by the global option `spades.moduleRepo`.
#'
#' @return a character vector of module file paths (invisibly).
#'
#' @author Eliot McIntire and Alex Chubaty
#' @export
#' @importFrom cli col_magenta
#' @importFrom utils packageVersion
#' @rdname checkModule
setGeneric("checkModule", function(name, repo) {
standardGeneric("checkModule")
})
#' @rdname checkModule
setMethod(
"checkModule",
signature = c(name = "character", repo = "character"),
definition = function(name, repo) {
goAhead <- FALSE
if (requireNamespace("httr", quietly = TRUE)) {
if (packageVersion("httr") >= "1.2.1") {
goAhead <- TRUE
}}
if (goAhead) {
if (length(name) > 1) {
warning("name contains more than one module. Only the first will be used.")
name <- name[1]
}
apiurl <- paste0("https://api.github.com/repos/", repo, "/git/trees/master?recursive=1") # nolint
ua <- httr::user_agent(getOption("spades.useragent"))
pat <- Sys.getenv("GITHUB_PAT")
request <- if (identical(pat, "")) {
httr::GET(apiurl, ua)
} else {
message(cli::col_magenta("Using GitHub PAT from envvar GITHUB_PAT", sep = ""))
httr::GET(apiurl, ua, config = list(httr::config(token = pat)))
}
httr::stop_for_status(request)
allFiles <- unlist(lapply(httr::content(request)$tree, "[", "path"), use.names = FALSE)
moduleFiles <- grep(paste0("^modules/", name), allFiles, value = TRUE)
if (length(moduleFiles) == 0) {
moduleFiles <- grep(paste0("^", name), allFiles, value = TRUE)
if (length(moduleFiles) == 0) {
agrep(name, allFiles, max.distance = 0.25, value = TRUE,
ignore.case = FALSE) |>
strsplit(split = "/") |>
lapply(function(x) x[2]) |>
unique() |>
unlist() |>
paste(collapse = ", ") |>
stop("Module ", name, " does not exist in the repository. ",
"Did you mean: ", ., "?")
}
}
} else {
stop("checkModule does not work without httr package: ",
"install.packages('httr')")
}
return(invisible(moduleFiles))
})
#' @rdname checkModule
setMethod("checkModule",
signature = c(name = "character", repo = "missing"),
definition = function(name) {
v <- checkModule(name, getOption("spades.moduleRepo",
defaultGitRepoToSpaDESModules))
return(v)
})
################################################################################
#' Check for the existence of a module locally
#'
#' Looks the module path for a module named `name`, and checks for existence
#' of all essential module files listed below.
#'
#' \itemize{
#' \item \file{data/CHECKSUMS.txt}
#' \item \file{name.R}
#' }
#'
#' @param name Character string giving the module name.
#'
#' @param path Local path to modules directory.
#' Default is specified by the global option `spades.modulePath`.
#'
#' @param version Character specifying the desired module version.
#'
#' @return Logical indicating presence of the module (invisibly).
#'
#' @author Alex Chubaty
#' @export
#' @rdname checkModuleLocal
#'
setGeneric("checkModuleLocal", function(name, path, version) {
standardGeneric("checkModuleLocal")
})
#' @rdname checkModuleLocal
setMethod(
"checkModuleLocal",
signature = c(name = "character", path = "character", version = "character"),
definition = function(name, path, version) {
if (length(name) > 1) {
warning("name contains more than one module. Only the first will be used.")
name <- name[1]
}
essentialFiles <- file.path(path, name, c(paste0(name, ".R")))
moduleFiles <- file.path(path, name) |>
list.files(full.names = TRUE, recursive = TRUE) |>
unlist(use.names = FALSE)
result <- FALSE
# check whether any module files exist locally
if (length(moduleFiles > 0)) {
# check all essential files exist locally
if (all(essentialFiles %in% moduleFiles)) {
# check that local module version matches that desired
# if desired version is NA then we need to download most recent version
if (!is.na(version)) {
v <- .parseModulePartial(filename = file.path(path, name, paste0(name, ".R")),
defineModuleElement = "version")
if (isTRUE(length(v) > length(name))) {
v <- v[names(v) %in% name]
}
result <- ifelse(v == numeric_version(version), TRUE, FALSE)
}
}
}
return(invisible(result))
})
#' @rdname checkModuleLocal
setMethod(
"checkModuleLocal",
signature = c(name = "character", path = "ANY", version = "ANY"),
definition = function(name, path, version) {
if (missing(path)) path <- getOption("spades.modulePath")
if (missing(version)) version <- NA_character_
result <- checkModuleLocal(name, path, version)
return(invisible(result))
})
################################################################################
#' Download a module from a SpaDES module GitHub repository
#'
#' Download a .zip file of the module and extract (unzip) it to a user-specified location.
#'
#' Currently only works with GitHub repositories where modules are located in
#' a `modules` directory in the root tree on the `master` branch.
#' Module .zip files' names should contain the version number and be inside their
#' respective module folders (see [zipModule()] for zip compression of modules).
#'
#' @note `downloadModule` uses the `GITHUB_PAT` environment variable
#' if a value is set. This alleviates 403 errors caused by too-frequent downloads.
#' Generate a GitHub personal access token with no additional permissions at
#' <https://github.com/settings/tokens>, and add this key to \file{.Renviron}
#' as `GITHUB_PAT=<your-github-pat-here>`.
#'
#' @note The default is to overwrite any existing files in the case of a conflict.
#'
#' @seealso [zipModule()] for creating module .zip folders.
#'
#' @inheritParams getModuleVersion
#'
#' @param path Character string giving the location in which to save the
#' downloaded module.
#'
#' @param version The module version to download. (If not specified, or `NA`,
#' the most recent version will be retrieved.)
#'
#' @param data Logical. If `TRUE`, then the data that is identified in the
#' module metadata will be downloaded, if possible. Default `FALSE`.
#'
#' @param quiet Logical. This is passed to `download.file` (default `FALSE`).
#'
#' @param quickCheck Logical. If `TRUE`, then the check with local data will only
#' use `file.size` instead of `digest::digest`.
#' This is faster, but potentially much less robust.
#'
#' @param overwrite Logical. Should local module files be overwritten in case they exist?
#' Default `FALSE`.
#'
#' @return A list of length 2. The first element is a character vector containing
#' a character vector of extracted files for the module. The second element is
#' a `tbl` with details about the data that is relevant for the function,
#' including whether it was downloaded or not, and whether it was renamed
#' (because there was a local copy that had the wrong file name).
#'
#' @author Alex Chubaty
#' @export
#' @rdname downloadModule
setGeneric("downloadModule", function(name, path, version, repo, data, quiet,
quickCheck = FALSE, overwrite = FALSE) {
standardGeneric("downloadModule")
})
#' @rdname downloadModule
#' @importFrom reproducible checkPath
#' @importFrom utils unzip zip
#' @importFrom data.table setDF rbindlist
setMethod(
"downloadModule",
signature = c(name = "character", path = "character", version = "character",
repo = "character", data = "logical", quiet = "logical",
quickCheck = "ANY", overwrite = "logical"),
definition = function(name, path, version, repo, data, quiet, quickCheck,
overwrite) {
if (requireNamespace("httr", quietly = TRUE)) {
path <- checkPath(path, create = TRUE)
checkPath(file.path(path, name), create = TRUE)
# check locally for module. only download if doesn't exist locally,
# or if overwrite is wanted
if (!checkModuleLocal(name, path, version) | overwrite) {
# check remotely for module
checkModule(name, repo)
if (is.na(version)) version <- getModuleVersion(name, repo)
innerPaths <- c(paste0("/master/modules/", name, "/"), "/master/")
for (tries in 1:2) {
innerPath <- innerPaths[tries]
zip <- paste0("https://raw.githubusercontent.com/", repo,
innerPath, name, "_", version, ".zip") # nolint
localzip <- file.path(path, basename(zip))
ua <- httr::user_agent(getOption("spades.useragent"))
pat <- Sys.getenv("GITHUB_PAT")
request <- if (identical(pat, "")) {
httr::GET(zip, ua, httr::write_disk(localzip, overwrite = overwrite))
} else {
message(cli::col_magenta("Using GitHub PAT from envvar GITHUB_PAT", sep = ""))
httr::GET(zip, ua, config = list(httr::config(token = pat)),
httr::write_disk(localzip, overwrite = overwrite))
}
status1 <- try(httr::stop_for_status(request), silent = TRUE)
if (!is(status1, "try-error")) break
if (is(status1, "try-error") && tries == 2) stop(status1)
}
files <- unzip(localzip, exdir = file.path(path), overwrite = TRUE)
} else {
files <- list.files(file.path(path, name))
}
# after download, check for childModules that also require downloading
files2 <- list()
children <- .parseModulePartial(filename = file.path(path, name, paste0(name, ".R")),
defineModuleElement = "childModules")
childVersions <- .parseModulePartial(filename = file.path(path, name, paste0(name, ".R")),
defineModuleElement = "version")
dataList2 <- data.frame(result = character(0), expectedFile = character(0),
actualFile = character(0), checksum.x = character(0),
checksum.y = character(0), algorithm.x = character(0),
algorithm.y = character(0),
stringsAsFactors = FALSE)
dataList3 <- dataList2
if (!is.null(children)) {
if (all(nzchar(children) & !is.na(children)) && length(children)) {
tmp <- lapply(children, function(x) {
f <- if (!is.null(childVersions[[x]])) {
downloadModule(x, path = path, repo = repo, data = data, version = childVersions[[x]],
quickCheck = quickCheck, overwrite = overwrite)
} else {
downloadModule(x, path = path, repo = repo, data = data, quickCheck = quickCheck,
overwrite = overwrite)
}
files2 <<- append(files2, f[[1]])
dataList2 <<- setDF(rbindlist(list(dataList2, f[[2]]), use.names = TRUE, fill = TRUE))
})
}
}
if (data) {
moduleFilename <- file.path(path, name, paste0(name, ".R"))
inputs <- .parseModulePartial(filename = moduleFilename,
defineModuleElement = "inputObjects")
urls <- inputs$sourceURL
objNames <- if (is.call(inputs$objectName)) {
unlist(lapply(tail(parse(text = inputs$objectName), length(urls)), function(x) deparse(x)))
} else {
inputs$objectName
}
names(urls) <- objNames
children <- .parseModulePartial(filename = moduleFilename,
defineModuleElement = "childModules")
dataList <- downloadData(module = name, path = path, quiet = quiet,
quickCheck = quickCheck, urls = urls, children = children)
} else {
dataList <- checksums(module = name, path = path, quickCheck = quickCheck)
}
message(cli::col_magenta("Download complete for module ", name,
" (v", version, " at '", path,"').", sep = ""))
} else{
stop("downloadModule does not work without httr package: ",
"install.package('httr')")
}
return(list(c(files, files2),
setDF(rbindlist(list(dataList, dataList2), use.names = TRUE, fill = TRUE))))
})
#' @rdname downloadModule
setMethod(
"downloadModule",
signature = c(name = "character", path = "missing", version = "missing",
repo = "missing", data = "missing", quiet = "missing",
quickCheck = "ANY", overwrite = "ANY"),
definition = function(name, quickCheck, overwrite) {
path <- checkModulePath()
files <- downloadModule(name, path = path,
version = NA_character_,
repo = getOption("spades.moduleRepo",
defaultGitRepoToSpaDESModules),
data = FALSE, quiet = FALSE,
quickCheck = quickCheck, overwrite = overwrite)
return(invisible(files))
})
#' @rdname downloadModule
setMethod(
"downloadModule",
signature = c(name = "character", path = "ANY", version = "ANY",
repo = "ANY", data = "ANY", quiet = "ANY", quickCheck = "ANY",
overwrite = "ANY"),
definition = function(name, path, version, repo, data, quiet, quickCheck,
overwrite) {
if (missing(path)) path <- getOption("spades.modulePath")
if (missing(version)) version <- NA_character_
if (missing(repo)) repo <- getOption("spades.moduleRepo",
defaultGitRepoToSpaDESModules)
if (missing(data)) data <- FALSE
if (missing(quiet)) quiet <- FALSE
if (missing(quickCheck)) quickCheck <- FALSE
if (missing(overwrite)) overwrite <- FALSE
files <- downloadModule(name, path, version, repo, data, quiet, quickCheck, overwrite)
return(invisible(files))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.