issueOpen()

R/versionControl.R

@@ -0,0 +1,70 @@
+#' `issueOpen()` is a wrapper for gh::gh() to swiftly post in the GitHub repository of the current project
+#'
+#' @param title of the issue in character
+#' @param body of the issue in character
+#' @param newBranch Logical. Default TRUE, will open a new branch in GitHub format
+#'
+#' @returns A message with the link of the issue
+#' @importFrom checkmate assertCharacter assertLogical assertTRUE
+#' @importFrom gh gh gh_tree_remote
+#' @export
+#' @examples
+issueOpen <- function(
+  title, 
+  body,
+  newBranch = FALSE
+) {
+  checkmate::assertCharacter(
+    title,
+    len = 1,
+    any.missing = FALSE
+  )
+  title_word_count <- length(
+    regmatches(
+      title,
+      gregexpr(
+        "\\S+",
+        title,
+        perl = TRUE
+      ))[[1]])
+  checkmate::assertTRUE(title_word_count >= 2)
+  checkmate::assertCharacter(body)
+  checkmate::assertLogical(newBranch)
+  checkmate::assertTRUE(gh::gh_token_exists())
+  issue_data <- gh::gh(
+    "POST /repos/{owner}/{repo}/issues",
+    owner = gh::gh_tree_remote()$username,
+    repo = gh::gh_tree_remote()$repo,
+    title = title,
+    body = body
+  )
+  issue_created <- checkmate::checkClass(
+    issue_data,
+    "gh_response"
+  )
+  if (isTRUE(issue_created)) {
+    cli::cli_alert_success(
+      "Issue created at:"
+    )
+    cat(issue_data$html_url, "\n")
+    invisible(issue_data$html_url)
+  }
+  if (isTRUE(issue_created) & isTRUE(newBranch)) {
+    branch_title <- stringr::word(title, 1, 2) |> 
+      tolower() |> 
+      stringr::str_replace_all(
+        pattern = " ",
+        replacement = "_"
+      )
+    branch_name <- glue::glue(
+      "{issue_data$number}_{branch_title}"
+    )
+    gert::git_branch_create(
+      branch = branch_name,
+      ref = gert::git_branch(),
+      checkout = TRUE,
+      force = FALSE,
+      repo = "."
+    )
+  }
+}

tests/testthat/test-getPkgZips.R

@@ -1,58 +1,3 @@
-test_that("mockLock()", {
-
-  lockfile <- mockLock()
-  # Create a supplementary file ----
-  supp <- list(
-    Packages = list(
-      devtools = list(
-        Package = "devtools",
-        Version = "2.5.2"
-      ), # 2.5.2 exists in multiple releases, should pick from the newest (R v4.6)
-      dplyr = list(
-        Package = "dplyr",
-        Version = "0.6"
-      ), # there is no 0.6 in any of the releases, should get v1.2.1 as alternate from R v4.4
-      tidyrr = list(
-        Package = "tidyr",
-        Version = "1.3.2"
-      ), # tidyrr does not exist
-      RPostgres = list(
-        Package = "RPostgres",
-        Version = NULL
-      ), # no version provided, should get v1.4.10 as alternate from R v4.4
-      renv = list(
-        Package = "renv",
-        Version = "1.0.7"
-      ), # renv already exists in lockfile, if override_lock = TRUE, should get v1.0.7 from R v4.2
-      xfun = list(
-        Package = "xfun",
-        Version = NULL
-      )
-    )
-  ) # xfun already exists in lockfile, if override_lock = TRUE, should get v0.57 from R v4.4
-  # Sanity check of counts ----
-  lock <- renv::lockfile_read(lockfile)
-  pkgs <- names(lock[["Packages"]])
-  supps <- names(supp[["Packages"]])
-  reqs <- unique(unlist(lapply(pkgs, function(pkg) {
-    lock[["Packages"]][[pkg]]$Requirements
-  })))
-  reqs <- reqs[reqs != "R"]
-  # reqs_wo_overlap <- reqs[!reqs %in% intersect(c(pkgs,supps), reqs)] # reqs that don't already exist in pkgs+supps
-  n_pkgs <- length(pkgs)
-  n_supps <- length(supps)
-  n_reqs <- length(reqs)
-  # n_reqs_wo_overlap <- length(reqs_wo_overlap)
-  n_all <- length(unique(c(pkgs, supps, reqs)))
-
-  expect_equal(n_pkgs, 11)
-  expect_equal(n_supps, 6) # 2 overlap with pkgs in lockfile, don't count unique as we have diff versions
-  expect_equal(n_reqs, 46)
-  # expect_equal(n_reqs_wo_overlap, 41)
-  expect_equal(n_all, 56) # not 58 bc of the supps overlap
-
-})
-
 # Test on  getPkgZips(): creation of dir and download of zips from project specific renv.lock ----
 test_that("Package zips are actually downloaded to renv/cellar from studyGenerics renv.lock", {
   msgs <- capture_messages(getPkgZips())
@@ -77,6 +22,7 @@ test_that("Package zips are actually downloaded to renv/cellar from studyGeneric
 # Test on lockfile only as input ----
 test_that("Message checks - lockfile only", {
 
+  lockfile <- mockLock()
   msgs <- capture_messages(pkg_summary <- getPkgZips(lockfile_path = lockfile))
 
   expect_true(any(grepl("PACKAGE NOT FOUND: Unable to find DarwinShinyModules v0.4.0 or a suitable alternate version under R v4.4", msgs)))
@@ -124,6 +70,7 @@ test_that("Message checks - lockfile + supp, override_lock = FALSE", {
 # Test on  lockfile + supp, override_lock = TRUE ----
 test_that("Message checks - lockfile + supp, override_lock = TRUE", {
 
+  lockfile <- mockLock()
   msgs <- capture_messages(pkg_summary <- getPkgZips(lockfile_path = lockfile, supplement = supp, override_lock = TRUE))
 
   expect_true(any(grepl("PACKAGE NOT FOUND: Unable to find DarwinShinyModules v0.4.0 or a suitable alternate version under R v4.4", msgs)))
@@ -152,5 +99,60 @@ test_that("Message checks - lockfile + supp, override_lock = TRUE", {
 
 })
 
+test_that("mockLock()", {
+
+  lockfile <- mockLock()
+  # Create a supplementary file ----
+  supp <- list(
+    Packages = list(
+      devtools = list(
+        Package = "devtools",
+        Version = "2.5.2"
+      ), # 2.5.2 exists in multiple releases, should pick from the newest (R v4.6)
+      dplyr = list(
+        Package = "dplyr",
+        Version = "0.6"
+      ), # there is no 0.6 in any of the releases, should get v1.2.1 as alternate from R v4.4
+      tidyrr = list(
+        Package = "tidyr",
+        Version = "1.3.2"
+      ), # tidyrr does not exist
+      RPostgres = list(
+        Package = "RPostgres",
+        Version = NULL
+      ), # no version provided, should get v1.4.10 as alternate from R v4.4
+      renv = list(
+        Package = "renv",
+        Version = "1.0.7"
+      ), # renv already exists in lockfile, if override_lock = TRUE, should get v1.0.7 from R v4.2
+      xfun = list(
+        Package = "xfun",
+        Version = NULL
+      )
+    )
+  ) # xfun already exists in lockfile, if override_lock = TRUE, should get v0.57 from R v4.4
+  # Sanity check of counts ----
+  lock <- renv::lockfile_read(lockfile)
+  pkgs <- names(lock[["Packages"]])
+  supps <- names(supp[["Packages"]])
+  reqs <- unique(unlist(lapply(pkgs, function(pkg) {
+    lock[["Packages"]][[pkg]]$Requirements
+  })))
+  reqs <- reqs[reqs != "R"]
+  # reqs_wo_overlap <- reqs[!reqs %in% intersect(c(pkgs,supps), reqs)] # reqs that don't already exist in pkgs+supps
+  n_pkgs <- length(pkgs)
+  n_supps <- length(supps)
+  n_reqs <- length(reqs)
+  # n_reqs_wo_overlap <- length(reqs_wo_overlap)
+  n_all <- length(unique(c(pkgs, supps, reqs)))
+
+  expect_equal(n_pkgs, 11)
+  expect_equal(n_supps, 6) # 2 overlap with pkgs in lockfile, don't count unique as we have diff versions
+  expect_equal(n_reqs, 46)
+  # expect_equal(n_reqs_wo_overlap, 41)
+  expect_equal(n_all, 56) # not 58 bc of the supps overlap
+
+})
+
 
 

tests/testthat/test-versionControl.R

@@ -0,0 +1,6 @@
+test_that("Opening issue and creating branch", {
+  issueOpen(
+    title = "Title Test Issue studyGenerics",
+    body = "Body Test Issue studyGenerics"
+  )
+})