Fix warning in p_install_gh when installing multiple packages

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(

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
 
-}
+}