fix

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: githubinstall
 Type: Package
-Version: 0.0.1.9001
+Version: 0.0.1.9002
 Title: A Helpful Way to Install R Packages Hosted on GitHub
 Description: Provides an helpful way to install packages hosted on GitHub.
 Authors@R: c(
@@ -13,8 +13,9 @@ URL: https://github.com/hoxo-m/githubinstall
 BugReports: https://github.com/hoxo-m/githubinstall/issues
 License: MIT + file LICENSE
 Imports:
+    curl,
     data.table,
-    ghit,
+    devtools,
     httr,
     jsonlite,
     stringr,

NAMESPACE

@@ -8,14 +8,17 @@ export(gh_suggest)
 export(gh_suggest_username)
 export(gh_update_package_list)
 export(githubinstall)
+importFrom(curl,nslookup)
 importFrom(data.table,fread)
-importFrom(ghit,install_github)
+importFrom(devtools,github_pull)
+importFrom(devtools,install_github)
 importFrom(httr,GET)
 importFrom(jsonlite,fromJSON)
 importFrom(stringr,str_count)
 importFrom(stringr,str_detect)
 importFrom(stringr,str_extract)
 importFrom(stringr,str_replace)
+importFrom(stringr,str_sub)
 importFrom(utils,adist)
 importFrom(utils,browseURL)
 importFrom(utils,menu)

R/gh_install_packages.R

@@ -1,61 +1,96 @@
 #' Install Packages from GitHub
 #'
-#' @param packages character vector of the names of packages.
+#' @param packages character vector of the names of the packages.
+#'        You can specify \code{ref} argument (see below) using \code{package_name[@ref|#pull]}.
+#'        If both are specified, the values in repo take precedence.
 #' @param ask logical. Indicates ask to confirm before install.
-#' @param build_args character string used to control the package build, passed to \code{R CMD build}.
-#' @param build_vignettes logical specifying whether to build package vignettes, passed to \code{R CMD build}. Can be slow. Default is \code{FALSE}.
-#' @param verbose logical specifying whether to print details of package building and installation.
-#' @param dependencies character vector specifying which dependencies to install (of "Depends", "Imports", "Suggests", etc.).
-#' @param ... additional arguments to control installation of package, passed to \link{install.packages}.
+#' @param ref character vector. Desired git reference. 
+#'        Could be a commit, tag, or branch name, or a call to \code{\link{github_pull}}. 
+#'        Defaults to "master".
+#' @param build_vignettes logical. If \code{TRUE}, will build vignettes.
+#' @param dependencies logical. Indicating to also install uninstalled packages which the packages depends on/links to/suggests. 
+#'        See argument dependencies of \code{\link{install.packages}}.
+#' @param verbose logical. Indicating to print details of package building and installation. Dfault is \code{TRUE}.
+#' @param quiet logical. Not \code{verbose}.
+#' @param ... additional arguments to control installation of package, passed to \code{\link{install_github}}.
 #'
-#' @return A named character vector of versions of R packages installed.
+#' @return TRUE if success.
 #'
 #' @details 
 #' \code{githubinstall()} is an alias of \code{gh_install_packages()}.
 #'
 #' @examples
 #' \dontrun{
-#' githubinstall("AnomalyDetection")
 #' gh_install_packages("AnomalyDetection")
+#' githubinstall("AnomalyDetection")
 #' }
 #'
-#' @importFrom ghit install_github
+#' @importFrom devtools install_github
 #' @importFrom utils menu packageDescription
 #'
 #' @rdname githubinstall
 #'
 #' @export
-gh_install_packages <- function(packages, ask = TRUE, build_args = NULL, 
-                                build_vignettes = FALSE, verbose = TRUE,
-                                dependencies = c("Depends", "Imports", "LinkingTo"), ...) {
+gh_install_packages <- function(packages, ask = TRUE, ref = "master", 
+                                build_vignettes = FALSE, dependencies = NA,
+                                verbose = TRUE, quiet = !verbose, ...) {
+  # Adjust arguments
   lib <- list(...)$lib # NULL if not set
-  packages <- reserve_suffix(packages)
-  packages <- reserve_subdir(packages)
-  subdir <- attr(packages, "subdir")
-  suffix <- attr(packages, "suffix")
+  dependencies <- select_dependencies(ask, build_vignettes, dependencies, quiet)
+  pac_ref <- separate_reference(packages, ref)
+  packages <- pac_ref$packages
+  references <- pac_ref$references
+
+  # 
   repos <- sapply(packages, select_repository)
-  repos_full <- paste0(repos, subdir, suffix)
+
   if (ask) {
-    target <- paste(repos_full, collapse = "\n - ")
-    title <- sprintf("Suggestion:\n - %s\nDo you install the package%s?", target, ifelse(length(target) == 1, "", "s"))
-    choice <- menu(choices = c("Yes (Install)", "No (Cancel)"), title = title)
-    if(choice != 1) {
-      message("Canceled the installation.")
-      return(invisible(NULL))
+    target <- paste(repos, attr(repos, "title"), collapse = "\n - ")
+    msg <- sprintf("Suggestion:\n - %s", target)
+    message(msg)
+    prompt <- sprintf("Do you want to install the package%s (Y/n)?  ", ifelse(length(repos) == 1, "", "s"))
+    answer <- substr(readline(prompt), 1L, 1L)
+    if (!(answer %in% c("", "y", "Y"))) {
+      cat("cancelled by user\n")
+      return(invisible())
     }
   }
-  if(is_conflict_installed_packages(repos, lib)) {
-    choice <- menu(choices = c("Install Forcibly (Overwirte)", "Cancel the Installation"), 
-                   title = "Warning occurred. Do you install the package forcibly?")
-    if(choice != 1) {
-      message("Canceled the installation.")
-      return(invisible(NULL))
+  # if(is_conflict_installed_packages(repos, lib)) {
+  #   
+  #   choice <- menu(choices = c("Install Forcibly (Overwirte)", "Cancel the Installation"), 
+  #                  title = "Warning occurred. Do you install the package forcibly?")
+  #   if(choice != 1) {
+  #     message("Canceled the installation.")
+  #     return(invisible(NULL))
+  #   }
+  # }
+  for (i in seq_along(repos)) {
+    repo <- repos[i]
+    ref <- references[i]
+    install_github(repo = repo, ref = ref, quiet = quiet, 
+                   dependencies = dependencies, build_vignettes = build_vignettes, ... = ...)
+    log_installed_packages(repos = repo, ref = ref)
+  }
+  invisible(TRUE)
+}
+
+select_dependencies <- function(ask, build_vignettes, dependencies, quiet) {
+  if (build_vignettes && is.na(dependencies)) {
+    msg <- "We recommend to specify the 'dependencies' argument when you build vignettes."
+    if (ask) {
+      message(msg)
+      answer <- readline("Do you want to use our recommended dependencies (y/N)?")
+      if (answer %in% c("", "y"))
+        return(TRUE)
+    } else {
+      if (!quiet) {
+        message(msg)
+        message("It will be set to our recommended dependencies.")
+      }
+      return(TRUE)
     }
   }
-  result <- install_github(repo = repos_full, build_args = build_args, build_vignettes = build_vignettes,
-                 verbose = verbose, dependencies = dependencies, ... = ...)
-  log_installed_packages(repos = paste0(repos, subdir), suffix = suffix)
-  result
+  dependencies
 }
 
 select_repository <- function(package_name) {

R/network.R

@@ -1,10 +1,19 @@
 #' @importFrom httr GET
-log_installed_packages <- function(repos, suffix) {
+log_installed_packages <- function(repos, ref) {
   package <- paste(repos, collapse=",")
-  suffix <- paste(suffix, collapse=",")
-  tryCatch({
-    GET(sprintf("http://githubinstall.appspot.com/package?package=%s&suffix=%s", package, suffix))
-  }, error = function(e) {
-    # do nothing
-  })
+  is_pull_request <- vapply(ref, class, character(1)) == "github_pull"
+  ref[is_pull_request] <- paste0("#", ref[is_pull_request])
+  ref <- paste(ref, collapse=",")
+  if (is_available_network()) {
+    tryCatch({
+      GET(sprintf("http://githubinstall.appspot.com/package?package=%s&suffix=%s", package, ref))
+    }, error = function(e) {
+      # do nothing
+    })
+  }
+}
+
+#' @importFrom curl nslookup
+is_available_network <- function() {
+  !is.null(nslookup("githubinstall.appspot.com", error = FALSE))
 }

R/reserve_suffix.R

@@ -1,6 +1,42 @@
 SUFFIX <- "suffix"
 SUBDIR <- "subdir"
 
+#' @importFrom devtools github_pull
+#' @importFrom stringr str_replace str_sub
+separate_reference <- function(packages, ref) {
+  commit_pattern <- "@.+$"
+  pull_request_pattern <- "#.+$"
+  branch_pattern <- "\\[.+\\]$"
+
+  commit <- vapply(packages, extract_reference, character(1), commit_pattern)
+  pull_request <- vapply(packages, extract_reference, character(1), pull_request_pattern)
+  branch <- vapply(packages, extract_reference, character(1), branch_pattern)
+
+  commit <- str_sub(commit, 2)
+  pull_request <- github_pull(str_sub(pull_request, 2))
+  branch <- str_sub(branch, 2, -2)
+
+  if (length(ref) == 1)
+    ref <- rep(ref, length(packages))
+
+  references <- commit
+  references[is.na(references)] <- pull_request[is.na(references)]
+  references[is.na(references)] <- branch[is.na(references)]
+  references[is.na(references)] <- ref[is.na(references)]
+
+  packages <- str_replace(packages, references, "")
+  list(packages = packages, references = references)
+}
+
+#' @importFrom stringr str_detect str_extract
+extract_reference <- function(x, pattern) {
+  if (str_detect(x, pattern)) {
+    str_extract(x, pattern)
+  } else {
+    NA_character_
+  }
+}
+
 reserve_suffix <- function(packages) {
   commit_pattern <- "@.+$"
   pull_request_pattern <- "#.+$"
@@ -16,13 +52,6 @@ reserve_suffix <- function(packages) {
   packages
 }
 
-reserve_subdir <- function(packages) {
-  suffix <- attr(packages, SUFFIX)
-  packages <- extract_repositry_name_with_subdir(packages)
-  attr(packages, SUFFIX) <- suffix
-  packages
-}
-
 #' @importFrom stringr str_detect str_extract str_replace
 reserve_to_attr <- function(x, pattern, attr_name) {
   if (str_detect(x, pattern)) {
@@ -35,6 +64,13 @@ reserve_to_attr <- function(x, pattern, attr_name) {
   x
 }
 
+reserve_subdir <- function(packages) {
+  suffix <- attr(packages, SUFFIX)
+  packages <- extract_repositry_name_with_subdir(packages)
+  attr(packages, SUFFIX) <- suffix
+  packages
+}
+
 #' @importFrom stringr str_extract str_replace
 extract_repositry_name_with_subdir <- function(packages) {
   repositry_name_pattern <- "^[^/]+/[^/]+"

tests/testthat/test-gh_install_packages.R

@@ -2,23 +2,22 @@ context("Install packages")
 
 tmp <- file.path(tempdir(), "tmplib")
 suppressWarnings(dir.create(tmp))
+.libPaths(c(tmp, .libPaths()))
 
 test_that("Install a single package", {
   repo <- "AnomalyDetection"
 
-  act <- suppressWarnings(gh_install_packages(repo, ask = FALSE, lib = tmp))
+  act <- suppressWarnings(gh_install_packages(repo, ask = FALSE, force = TRUE))
 
-  expect_false(is.na(act))
+  expect_true(act)
   remove.packages("AnomalyDetection", lib = tmp)
 })
 
 test_that("Install two packages", {
   repo <- c("AnomalyDetection", "toybayesopt")
 
-  act <- suppressWarnings(gh_install_packages(repo, ask = FALSE, lib = tmp))
-  expect_equal(length(act), 2)
-  expect_false(is.na(act[1]))
-  expect_false(is.na(act[2]))
+  act <- suppressWarnings(gh_install_packages(repo, ask = FALSE, force = TRUE))
+  expect_true(act)
   remove.packages("AnomalyDetection", lib = tmp)
   remove.packages("toybayesopt", lib = tmp)
 })