From e05947f0e49244d7dcb13105a48e32718eb59db5 Mon Sep 17 00:00:00 2001
From: Andy Teucher <andy.teucher@posit.co>
Date: Thu, 4 May 2023 15:44:56 -0700
Subject: [PATCH] Allow appending urls in `use_github_links()` (#1834)

* Allow appending urls in use_github_links()

* account for no existing URL field

* Add NEWS bullet

* Use desc$set_list in use_description_field

* let use_description_field() construct url list

also let it handle overwrite behaviour

* Update tests, lean more on desc

* Use github_url_from_git_remotes() and mock that

* Consolidate tests

* Update code comment in use_description_field

* Move skips to top of tests
---
 NEWS.md                         |  3 +++
 R/github.R                      |  5 +---
 tests/testthat/_snaps/github.md |  8 +++++++
 tests/testthat/test-github.R    | 42 +++++++++++++++++++++++++++++++++
 4 files changed, 54 insertions(+), 4 deletions(-)
 create mode 100644 tests/testthat/_snaps/github.md
 create mode 100644 tests/testthat/test-github.R

diff --git a/NEWS.md b/NEWS.md
index 89fb4d202..874e8b9a7 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,8 @@
 # usethis (development version)
 
+* `use_github_links()` by default now appends the GitHub url to existing urls in
+  in the `URL` field of DESCRIPTION, rather than replacing existing urls (#1805).
+
 * `use_upkeep_issue()` is a new function to facilitate regular maintenance of 
   your package. Similar to `use_release_issue()`, it opens an issue in your repo 
   with a checklist of maintenance tasks. It will include additional bullets 
diff --git a/R/github.R b/R/github.R
index 1d401d7d5..818366202 100644
--- a/R/github.R
+++ b/R/github.R
@@ -219,11 +219,8 @@ use_github_links <- function(auth_token = deprecated(),
   }
 
   check_is_package("use_github_links()")
-  tr <- target_repo(github_get = TRUE)
 
-  gh <- gh_tr(tr)
-  res <- gh("GET /repos/{owner}/{repo}")
-  gh_url <- res$html_url
+  gh_url <- github_url_from_git_remotes()
 
   proj_desc_field_update("URL", gh_url, overwrite = overwrite, append = TRUE)
 
diff --git a/tests/testthat/_snaps/github.md b/tests/testthat/_snaps/github.md
new file mode 100644
index 000000000..6a1160a13
--- /dev/null
+++ b/tests/testthat/_snaps/github.md
@@ -0,0 +1,8 @@
+# use_github_links() aborts or appends URLs when it should
+
+    Code
+      use_github_links(overwrite = FALSE)
+    Condition
+      Error:
+      ! URL has a different value in DESCRIPTION. Use `overwrite = TRUE` to overwrite.
+
diff --git a/tests/testthat/test-github.R b/tests/testthat/test-github.R
new file mode 100644
index 000000000..0a85425d2
--- /dev/null
+++ b/tests/testthat/test-github.R
@@ -0,0 +1,42 @@
+test_that("use_github_links populates empty URL field", {
+  skip_if_no_git_user()
+  local_interactive(FALSE)
+  create_local_package()
+  use_git()
+
+  local_mocked_bindings(
+    github_url_from_git_remotes = function() "https://github.com/OWNER/REPO"
+  )
+
+  # when no URL field
+  use_github_links()
+  expect_equal(proj_desc()$get_urls(), "https://github.com/OWNER/REPO")
+  expect_equal(
+    proj_desc()$get_field("BugReports"),
+    "https://github.com/OWNER/REPO/issues"
+    )
+})
+
+test_that("use_github_links() aborts or appends URLs when it should", {
+  skip_if_no_git_user()
+  local_interactive(FALSE)
+  create_local_package()
+  use_git()
+
+  local_mocked_bindings(
+    github_url_from_git_remotes = function() "https://github.com/OWNER/REPO"
+  )
+
+  d <- proj_desc()
+  d$set_urls(c("https://existing.url", "https://existing.url1"))
+  d$write()
+
+  expect_snapshot(use_github_links(overwrite = FALSE), error = TRUE)
+
+  use_github_links(overwrite = TRUE)
+  expect_equal(
+    proj_desc()$get_urls(),
+    c("https://existing.url", "https://existing.url1",
+      "https://github.com/OWNER/REPO")
+  )
+})