1#' Create a package or project
2#'
3#' @description
4#' These functions create an R project:
5#'   * `create_package()` creates an R package
6#'   * `create_project()` creates a non-package project, i.e. a data analysis
7#'   project
8#'
9#' Both functions can be called on an existing project; you will be asked before
10#' any existing files are changed.
11#'
12#' @inheritParams use_description
13#' @param path A path. If it exists, it is used. If it does not exist, it is
14#'   created, provided that the parent path exists.
15#' @param roxygen Do you plan to use roxygen2 to document your package?
16#' @param rstudio If `TRUE`, calls [use_rstudio()] to make the new package or
17#'   project into an [RStudio
18#'   Project](https://support.rstudio.com/hc/en-us/articles/200526207-Using-Projects).
19#'    If `FALSE` and a non-package project, a sentinel `.here` file is placed so
20#'   that the directory can be recognized as a project by the
21#'   [here](https://here.r-lib.org) or
22#'   [rprojroot](https://rprojroot.r-lib.org) packages.
23#' @param open If `TRUE`, [activates][proj_activate()] the new project:
24#'
25#'   * If RStudio desktop, the package is opened in a new session.
26#'   * If on RStudio server, the current RStudio project is activated.
27#'   * Otherwise, the working directory and active project is changed.
28#'
29#' @return Path to the newly created project or package, invisibly.
30#' @seealso [create_tidy_package()] is a convenience function that extends
31#'   `create_package()` by immediately applying as many of the tidyverse
32#'   development conventions as possible.
33#' @export
34create_package <- function(path,
35                           fields = list(),
36                           rstudio = rstudioapi::isAvailable(),
37                           roxygen = TRUE,
38                           check_name = TRUE,
39                           open = rlang::is_interactive()) {
40  path <- user_path_prep(path)
41  check_path_is_directory(path_dir(path))
42
43  name <- path_file(path_abs(path))
44  if (check_name) {
45    check_package_name(name)
46  }
47  challenge_nested_project(path_dir(path), name)
48  challenge_home_directory(path)
49
50  create_directory(path)
51  local_project(path, force = TRUE)
52
53  use_directory("R")
54  use_description(fields, check_name = FALSE, roxygen = roxygen)
55  use_namespace(roxygen = roxygen)
56
57  if (rstudio) {
58    use_rstudio()
59  }
60
61  if (open) {
62    if (proj_activate(proj_get())) {
63      # working directory/active project already set; clear the scheduled
64      # restoration of the original project
65      withr::deferred_clear()
66    }
67  }
68
69  invisible(proj_get())
70}
71
72#' @export
73#' @rdname create_package
74create_project <- function(path,
75                           rstudio = rstudioapi::isAvailable(),
76                           open = rlang::is_interactive()) {
77  path <- user_path_prep(path)
78  name <- path_file(path_abs(path))
79  challenge_nested_project(path_dir(path), name)
80  challenge_home_directory(path)
81
82  create_directory(path)
83  local_project(path, force = TRUE)
84
85  use_directory("R")
86
87  if (rstudio) {
88    use_rstudio()
89  } else {
90    ui_done("Writing a sentinel file {ui_path('.here')}")
91    ui_todo("Build robust paths within your project via {ui_code('here::here()')}")
92    ui_todo("Learn more at <https://here.r-lib.org>")
93    file_create(proj_path(".here"))
94  }
95
96  if (open) {
97    if (proj_activate(proj_get())) {
98      # working directory/active project already set; clear the scheduled
99      # restoration of the original project
100      withr::deferred_clear()
101    }
102  }
103
104  invisible(proj_get())
105}
106
107#' Create a project from a GitHub repo
108#'
109#' @description
110#' Creates a new local project and Git repository from a repo on GitHub, by
111#' either cloning or
112#' [fork-and-cloning](https://help.github.com/articles/fork-a-repo/). In the
113#' fork-and-clone case, `create_from_github()` also does additional remote and
114#' branch setup, leaving you in the perfect position to make a pull request with
115#' [pr_init()], one of several [functions that work pull
116#' requests][pull-requests].
117#'
118#' `create_from_github()` works best when your GitHub credentials are
119#' discoverable. See below for more about authentication.
120#'
121#' @template double-auth
122#'
123#' @seealso
124#' * [use_github()] to go the opposite direction, i.e. create a GitHub repo
125#'   from your local repo
126#' * [git_protocol()] for background on `protocol` (HTTPS vs SSH)
127#' * [use_course()] to download a snapshot of all files in a GitHub repo,
128#'   without the need for any local or remote Git operations
129#'
130#' @inheritParams create_package
131#' @param repo_spec A string identifying the GitHub repo in one of these forms:
132#'   * Plain `OWNER/REPO` spec
133#'   * Browser URL, such as `"https://github.com/OWNER/REPO"`
134#'   * HTTPS Git URL, such as `"https://github.com/OWNER/REPO.git"`
135#'   * SSH Git URL, such as `"git@github.com:OWNER/REPO.git"`
136#'
137#'   In the case of a browser, HTTPS, or SSH URL, the `host` is extracted from
138#'   the URL. The `REPO` part will be the name of the new local folder, which is
139#'   also a project and Git repo.
140#' @inheritParams use_course
141#' @param fork If `FALSE`, we clone `repo_spec`. If `TRUE`, we fork
142#'   `repo_spec`, clone that fork, and do additional set up favorable for
143#'   future pull requests:
144#'   * The source repo, `repo_spec`, is configured as the `upstream` remote,
145#'   using the indicated `protocol`.
146#'   * The local `DEFAULT` branch is set to track `upstream/DEFAULT`, where
147#'   `DEFAULT` is typically `master` or `main`. It is also immediately pulled,
148#'   to cover the case of a pre-existing, out-of-date fork.
149#'
150#'   If `fork = NA` (the default), we check your permissions on `repo_spec`. If
151#'   you can push, we set `fork = FALSE`, If you cannot, we set `fork = TRUE`.
152#' @param rstudio Initiate an [RStudio
153#'   Project](https://support.rstudio.com/hc/en-us/articles/200526207-Using-Projects)?
154#'   Defaults to `TRUE` if in an RStudio session and project has no
155#'   pre-existing `.Rproj` file. Defaults to `FALSE` otherwise (but note that
156#'   the cloned repo may already be an RStudio Project, i.e. may already have a
157#'   `.Rproj` file).
158#' @inheritParams use_github
159#'
160#' @export
161#' @examples
162#' \dontrun{
163#' create_from_github("r-lib/usethis")
164#'
165#' # repo_spec can be a URL
166#' create_from_github("https://github.com/r-lib/usethis")
167#'
168#' # a URL repo_spec also specifies the host (e.g. GitHub Enterprise instance)
169#' create_from_github("https://github.acme.com/OWNER/REPO")
170#' }
171create_from_github <- function(repo_spec,
172                               destdir = NULL,
173                               fork = NA,
174                               rstudio = NULL,
175                               open = rlang::is_interactive(),
176                               protocol = git_protocol(),
177                               host = NULL,
178                               auth_token = deprecated(),
179                               credentials = deprecated()) {
180  if (lifecycle::is_present(auth_token)) {
181    deprecate_warn_auth_token("create_from_github")
182  }
183  if (lifecycle::is_present(credentials)) {
184    deprecate_warn_credentials("create_from_github")
185  }
186  check_protocol(protocol)
187
188  parsed_repo_spec <- parse_repo_url(repo_spec)
189  if (!is.null(parsed_repo_spec$host)) {
190    repo_spec <- parsed_repo_spec$repo_spec
191    host <- parsed_repo_spec$host
192  }
193
194  whoami <- suppressMessages(gh::gh_whoami(.api_url = host))
195  no_auth <- is.null(whoami)
196  user <- if (no_auth) NULL else whoami$login
197  hint <- code_hint_with_host("gh_token_help", host)
198
199  if (no_auth && is.na(fork)) {
200    ui_stop("
201      Unable to discover a GitHub personal access token
202      Therefore, can't determine your permissions on {ui_value(repo_spec)}
203      Therefore, can't decide if `fork` should be `TRUE` or `FALSE`
204
205      You have two choices:
206      1. Make your token available (if in doubt, DO THIS):
207         - Call {ui_code(hint)} for directions
208      2. Call {ui_code('create_from_github()')} again, but with \\
209      {ui_code('fork = FALSE')}
210         - Only do this if you are absolutely sure you don't want to fork
211         - Note you will NOT be in a position to make a pull request")
212  }
213
214  if (no_auth && isTRUE(fork)) {
215    ui_stop("
216      Unable to discover a GitHub personal access token
217      A token is required in order to fork {ui_value(repo_spec)}
218
219      Call {ui_code(hint)} for help configuring a token")
220  }
221  # one of these is true:
222  # - gh is discovering a token for `host`
223  # - gh is NOT discovering a token, but `fork = FALSE`, so that's OK
224
225  source_owner <- spec_owner(repo_spec)
226  repo_name <- spec_repo(repo_spec)
227  gh <- gh_tr(list(repo_owner = source_owner, repo_name = repo_name, .api_url = host))
228
229  repo_info <- gh("GET /repos/{owner}/{repo}")
230  # 2020-10-14 GitHub has had some bugs lately around default branch
231  # today, the POST payload, if I create a fork, mis-reports the default branch
232  # it reports 'main', even though actual default branch is 'master'
233  # therefore, we're consulting the source repo for this info
234  default_branch <- repo_info$default_branch
235
236  if (is.na(fork)) {
237    fork <- !isTRUE(repo_info$permissions$push)
238    fork_status <- glue("fork = {fork}")
239    ui_done("Setting {ui_code(fork_status)}")
240  }
241  # fork is either TRUE or FALSE
242
243  if (fork && identical(user, repo_info$owner$login)) {
244    ui_stop("
245      Can't fork, because the authenticated user {ui_value(user)} \\
246      already owns the source repo {ui_value(repo_info$full_name)}")
247  }
248
249  destdir <- user_path_prep(destdir %||% conspicuous_place())
250  check_path_is_directory(destdir)
251  challenge_nested_project(destdir, repo_name)
252  repo_path <- path(destdir, repo_name)
253  create_directory(repo_path)
254  check_directory_is_empty(repo_path)
255
256  if (fork) {
257    ## https://developer.github.com/v3/repos/forks/#create-a-fork
258    ui_done("Forking {ui_value(repo_info$full_name)}")
259    upstream_url <- switch(
260      protocol,
261      https = repo_info$clone_url,
262      ssh = repo_info$ssh_url
263    )
264    repo_info <- gh("POST /repos/{owner}/{repo}/forks")
265  }
266
267  origin_url <- switch(
268    protocol,
269    https = repo_info$clone_url,
270    ssh = repo_info$ssh_url
271  )
272
273  ui_done("Cloning repo from {ui_value(origin_url)} into {ui_value(repo_path)}")
274  gert::git_clone(origin_url, repo_path, verbose = FALSE)
275  local_project(repo_path, force = TRUE) # schedule restoration of project
276
277  # 2020-10-14 due to a GitHub bug, we are consulting the source repo for this
278  # previously (and more naturally) we consulted the fork itself
279  # default_branch <- repo_info$default_branch
280  ui_info("Default branch is {ui_value(default_branch)}")
281
282  if (fork) {
283    ui_done("Adding {ui_value('upstream')} remote: {ui_value(upstream_url)}")
284    use_git_remote("upstream", upstream_url)
285    pr_merge_main()
286    upstream_remref <- glue("upstream/{default_branch}")
287    ui_done("
288      Setting remote tracking branch for local {ui_value(default_branch)} \\
289      branch to {ui_value(upstream_remref)}")
290    gert::git_branch_set_upstream(upstream_remref, repo = git_repo())
291    config_key <- glue("remote.upstream.created-by")
292    gert::git_config_set(config_key, "usethis::create_from_github", repo = git_repo())
293  }
294
295  rstudio <- rstudio %||% rstudio_available()
296  rstudio <- rstudio && !is_rstudio_project(proj_get())
297  if (rstudio) {
298    use_rstudio()
299  }
300
301  if (open) {
302    if (proj_activate(proj_get())) {
303      # Working directory/active project changed; so don't undo on exit
304      withr::deferred_clear()
305    }
306  }
307
308  invisible(proj_get())
309}
310
311# creates a backdoor we can exploit in tests
312allow_nested_project <- function() FALSE
313
314challenge_nested_project <- function(path, name) {
315  if (!possibly_in_proj(path)) {
316    return(invisible())
317  }
318
319  # we mock this in a few tests, to allow a nested project
320  if (allow_nested_project()) {
321    return()
322  }
323
324  ui_line(
325    "New project {ui_value(name)} is nested inside an existing project \\
326    {ui_path(path)}, which is rarely a good idea.
327    If this is unexpected, the here package has a function, \\
328    {ui_code('here::dr_here()')} that reveals why {ui_path(path)} \\
329    is regarded as a project."
330  )
331  if (ui_nope("Do you want to create anyway?")) {
332    ui_stop("Aborting project creation.")
333  }
334  invisible()
335}
336
337challenge_home_directory <- function(path) {
338  homes <- unique(c(path_home(), path_home_r()))
339  if (!path %in% homes) {
340    return(invisible())
341  }
342
343  qualification <- if (is_windows()) {
344    glue("a special directory, i.e. some applications regard it as ")
345  } else {
346    ""
347  }
348  ui_line("
349    {ui_path(path)} is {qualification}your home directory.
350    It is generally a bad idea to create a new project here.
351    You should probably create your new project in a subdirectory.")
352  if (ui_nope("Do you want to create anyway?")) {
353    ui_stop("Good move! Cancelling project creation.")
354  }
355  invisible()
356}
357