github_locations() function to give github location, plus reporting number of repositories

NAMESPACE

@@ -25,6 +25,7 @@ export(get_bad_words)
 export(get_sentiment)
 export(get_wikipedia)
 export(get_wiktionary)
+export(github_locations)
 export(suggest)
 export(valid_package_name)
 importFrom(jsonlite,fromJSON)

R/github.R

@@ -1,6 +1,17 @@
 #' See if a name is available on github
 #'
+#' @rdname available_on_github
+#' @name available_on_github
+#' @aliases github_locations
+#'
 #' @param name Name of package to search
+#' @param x An object from available_on_github()
+#' @examples
+#' x <- available_on_github("available")
+#' github_locations(x)
+NULL
+
+#' @rdname available_on_github
 #' @importFrom jsonlite fromJSON
 #' @export
 available_on_github <- function(name) {
@@ -28,6 +39,18 @@ available_on_github <- function(name) {
     class = "available_github")
 }
 
+#' @rdname available_on_github
+#' @export
+github_locations <- function(x) {
+  if(!inherits(x, "available_github")) {
+    stop("x is not an object of class 'available_github'.")
+  }
+  if(isTRUE(x$available)) {
+    return(character())
+  }
+  x$close[[1]][["pkg_location"]]
+}
+
 gh_pkg <- memoise::memoise(function(pkg) {
   res <- jsonlite::fromJSON(paste0("http://rpkg-api.gepuro.net/rpkg?q=", pkg))
   if (length(res) == 0) {
@@ -42,7 +65,12 @@ gh_pkg <- memoise::memoise(function(pkg) {
 #' @export
 
 format.available_github <- function(x, ...) {
-  paste0(crayon::bold("Available on GitHub: ", yes_no(x[[1]]), "\n"))
+  if(isTRUE(x[[1]])) {
+    report <- ""
+  } else {
+    report <- paste(nrow(x$close[[1]]), "repositories")
+  }
+  paste0(crayon::bold("Available on GitHub: ", yes_no(x[[1]]), report, "\n"))
 }
 
 #' @export

tests/testthat/test-github.R

@@ -11,3 +11,10 @@ test_that("Can't find made up package", {
 
   expect_true(available_on_github("This_is_not_a_pkg")$available)
 })
+
+test_that("github_locations() tests", {
+  skip_on_cran()
+
+  expect_equal(github_locations(available_on_github("This_is_not_a_pkg")), character(0))
+  expect_error(github_locations(5), "of class 'available_github'")
+})