feat: git_clone() creates path more similarly to git clone (#272)

Author: maelle

NEWS.md

@@ -1,5 +1,7 @@
 # gert (development version)
 
+- `git_clone()` without a `path` argument now clones into a directory named after the
+"humanish" part of the URL, so "git@github.com:francisbarton/myrepo.git" gets cloned into `myrepo` (@francisbardon, #192).
 - `git_remote_set_pushurl()` gains an `add` argument to append push URLs instead of replacing them. (@robitalec, #128)
 - Fix `git_info()` for the case when no upstream is configured (@mpage, #263)
 - `git_branch_create()`: `force` now also applies to the checkout step, allowing branch creation even when local changes would be overwritten (@MichaelChirico, #177).

R/fetch.R

@@ -174,6 +174,9 @@ git_push <- function(
 #' repositories, and `https://yourname@github.com/` or `git@github.com/` for
 #' private repos. You will be prompted for a password or pat when needed.
 #' @param path Directory of the Git repository to create.
+#' By default, the "humanish" part of the URL.
+#' For instance, "git@github.com:someone/myrepo.git" will be cloned to
+#' `myrepo/`.
 #' @param ssh_key path or object containing your ssh private key. By default we
 #' look for keys in `ssh-agent` and [credentials::ssh_key_info()].
 #' @param branch name of branch to check out locally
@@ -220,8 +223,13 @@ git_clone <- function(
   verbose = interactive()
 ) {
   stopifnot(is.character(url))
+  # "humanish" part of the URL
+  # https://github.com/git/git/blob/6e8d538aab8fe4dd07ba9fb87b5c7edcfa5706ad/dir.h#L494
   if (!length(path)) {
-    path <- file.path(getwd(), basename(url))
+    path <- file.path(
+      getwd(),
+      sub("\\.git$", "", sub("/.git$", "", basename(url)))
+    )
   }
   stopifnot(is.character(path))
   stopifnot(is.null(branch) || is.character(branch))
@@ -249,7 +257,7 @@ git_clone <- function(
 #' @param rebase if TRUE we try to rebase instead of merge local changes. This
 #' is not possible in case of conflicts (you will get an error).
 #' @param ... arguments passed to `git_fetch()`
-git_pull <- function(remote = NULL, rebase = FALSE, ..., repo = '.'){
+git_pull <- function(remote = NULL, rebase = FALSE, ..., repo = '.') {
   repo <- git_open(repo)
   info <- git_info(repo)
   branch <- info$shorthand

man/git_fetch.Rd

@@ -33,3 +33,15 @@ test_that("cloning repositories works", {
   expect_equal(zip::zip_list('gert.zip')$filename, git_ls(repo = repo)$path)
   unlink('gert.zip')
 })
+
+test_that("cloning repositories works, no path", {
+  skip_if_offline('github.com')
+  path <- file.path(tempdir(), 'gert-test')
+  dir.create(path)
+  on.exit(unlink(path, recursive = TRUE))
+  oldwd <- getwd()
+  on.exit(setwd(oldwd), add = TRUE)
+  setwd(path)
+  repo <- git_clone('https://github.com/r-lib/gert.git')
+  expect_true(file.exists(file.path(path, "gert", 'DESCRIPTION')))
+})