diff --git a/R/p_install_gh.R b/R/p_install_gh.R index 490f1bc..49d6f4c 100644 --- a/R/p_install_gh.R +++ b/R/p_install_gh.R @@ -21,8 +21,13 @@ #' } p_install_gh <- function(package, dependencies = TRUE, ...){ - if (p_loaded(char = package)) { - p_unload(char = package) + ## Extract repository names and use them as package names + package_names <- sapply(package, function(x) parse_git_repo(x)[["repo"]]) + + ## Unload loaded packages + packages_loaded <- p_loaded(char = package_names) + if (any(packages_loaded)) { + suppressMessages(p_unload(char = package_names[packages_loaded])) } ## Download package @@ -39,13 +44,12 @@ p_install_gh <- function(package, dependencies = TRUE, ...){ ) }) - ## Check if package was installed & success notification. - pack <- sapply(package, function(x) parse_git_repo(x)[["repo"]]) - ## Message for install status - install_checks <- stats::setNames(unlist(out), pack) + install_checks <- stats::setNames(unlist(out), package_names) + + ## Check if package was installed & success notification. + caps_check <- p_isinstalled(package_names) == install_checks - caps_check <- p_isinstalled(pack) == install_checks if (any(!caps_check)) { warning(paste0("The following may have incorrect capitalization specification:\n\n", paste(names(caps_check)[!caps_check], collapse=", "))) @@ -58,6 +62,7 @@ p_install_gh <- function(package, dependencies = TRUE, ...){ did_install) ) } + if (any(!install_checks)){ did_not_install <- paste(names(install_checks)[!install_checks], collapse=", ") message(sprintf( diff --git a/R/utils.R b/R/utils.R index ac4d2e8..c6e0231 100644 --- a/R/utils.R +++ b/R/utils.R @@ -189,25 +189,22 @@ object_check <- function(x) { !inherits(try(x,silent = TRUE), "try-error") } -## Code taken from Hadley's devtools -## https://github.com/hadley/devtools/blob/master/R/install-github.r +## Code taken from non-exported function viapply() from remotes package +## https://github.com/r-lib/remotes/blob/master/R/utils.R +viapply <- function(X, FUN, ..., USE.NAMES = TRUE) { + vapply(X, FUN, integer(1L), ..., USE.NAMES = USE.NAMES) +} + +## Code taken from non-exported function parse_git_repo() from remotes package +## https://github.com/r-lib/remotes/blob/master/R/parse-git.R parse_git_repo <- function(path) { - username_rx <- "(?:([^/]+)/)?" - repo_rx <- "([^/@#]+)" - subdir_rx <- "(?:/([^@#]*[^@#/]))?" - ref_rx <- "(?:@([^*].*))" - pull_rx <- "(?:#([0-9]+))" - release_rx <- "(?:@([*]release))" - ref_or_pull_or_release_rx <- sprintf("(?:%s|%s|%s)?", ref_rx, pull_rx, release_rx) - github_rx <- sprintf("^(?:%s%s%s%s|(.*))$", - username_rx, repo_rx, subdir_rx, ref_or_pull_or_release_rx) - - param_names <- c("username", "repo", "subdir", "ref", "pull", "release", "invalid") - replace <- stats::setNames(sprintf("\\%d", seq_along(param_names)), param_names) - params <- lapply(replace, function(r) gsub(github_rx, r, path, perl = TRUE)) - if (params$invalid != "") stop(sprintf("Invalid git repo: %s", path)) - params <- params[sapply(params, nchar) > 0] + if (grepl("^https://github|^git@github", path)) { + params <- remotes::parse_github_url(path) + } else { + params <- remotes::parse_repo_spec(path) + } + params <- params[viapply(params, nchar) > 0] if (!is.null(params$pull)) { params$ref <- remotes::github_pull(params$pull) @@ -221,4 +218,4 @@ parse_git_repo <- function(path) { params -} \ No newline at end of file +}