Improve helpers and add unit tests

DESCRIPTION

@@ -29,20 +29,21 @@ Imports:
     gert,
     gh,
     gtools,
+    httr2,
     renv,
     rmarkdown,
+    roxygen2,
     rprojroot,
-    rstudioapi,
     stringr,
     usethis,
-    utils,
-    xfun
+    utils
 Roxygen: list(markdown = TRUE)
 VignetteBuilder: knitr
 Suggests: 
     fs,
     knitr,
     testthat (>= 3.0.0),
+    vcr,
     withr
 Config/testthat/edition: 3
 Config/roxygen2/version: 8.0.0

NAMESPACE

@@ -38,9 +38,11 @@ export(get_all_dependencies)
 export(get_all_functions)
 export(get_available_gh_actions)
 export(get_available_issue_templates)
-export(get_licenses)
+export(get_available_licenses)
 export(get_minimal_r_version)
 export(set_credentials)
+importFrom(gert,git_branch)
+importFrom(gert,git_config_global)
 importFrom(usethis,ui_code)
 importFrom(usethis,ui_done)
 importFrom(usethis,ui_field)

NEWS.md

@@ -29,6 +29,7 @@
   * Add dependabot for GitHub Actions([#77](https://github.com/FRBCesab/rcompendium/pull/77))
   * Add download badges in README ([#78](https://github.com/FRBCesab/rcompendium/pull/78))
   * Remove dependency to `cffr` and `codemetar` packages ([#87](https://github.com/FRBCesab/rcompendium/pull/87))
+  * Remove dependency to `xfun` and `rstudioapi` packages ([#87](https://github.com/FRBCesab/rcompendium/pull/144))
   * Rename `add_cran_badge()` in `add_cran_version_badge()` ([#96](https://github.com/FRBCesab/rcompendium/pull/96))
 
 # rcompendium 1.4.0

R/add_dockerfile.R

@@ -117,8 +117,8 @@ add_dockerfile <- function(
 
   ## Update default values ----
 
-  xfun::gsub_file(path, "{{r_version}}", r_version, fixed = TRUE)
-  xfun::gsub_file(path, "{{email}}", email, fixed = TRUE)
+  gsub_in_file(path, "{{r_version}}", r_version)
+  gsub_in_file(path, "{{email}}", email)
 
   ## Install R packages ----
 
@@ -136,8 +136,8 @@ add_dockerfile <- function(
     )
     pattern <- paste0(pattern, "\n && sudo -u rstudio R -e \"renv::restore()\"")
 
-    xfun::gsub_file(path, "{{install_packages}}", pattern, fixed = TRUE)
-    xfun::gsub_file(path, "{{renv_version}}", renv_version, fixed = TRUE)
+    gsub_in_file(path, "{{install_packages}}", pattern)
+    gsub_in_file(path, "{{renv_version}}", renv_version)
   } else {
     pattern <- paste0(
       "RUN R -e \"install.packages('remotes', ",
@@ -148,7 +148,7 @@ add_dockerfile <- function(
       "\n && R -e \"remotes::install_deps(upgrade = 'never')\""
     )
 
-    xfun::gsub_file(path, "{{install_packages}}", pattern, fixed = TRUE)
+    gsub_in_file(path, "{{install_packages}}", pattern)
   }
 
   ## Update README.Rmd ----

R/add_license.R

@@ -6,7 +6,7 @@
 #' the license in a `LICENSE.md` file.
 #'
 #' @param license A character of length 1. The license name.
-#'   Run [get_licenses()]) to select an appropriate one.
+#'   Run [get_available_licenses()]) to select an appropriate one.
 #'
 #' @inheritParams add_citation
 #'

R/add_renv.R

@@ -100,11 +100,10 @@ add_renv <- function(quiet = FALSE) {
     path <- build_abs_path("make.R")
 
     if (file.exists(path)) {
-      xfun::gsub_file(
+      gsub_in_file(
         path,
         "devtools::install_deps(upgrade = \"never\")",
-        "renv::restore()",
-        fixed = TRUE
+        "renv::restore()"
       )
     }
   }

R/add_vignette.R

@@ -104,8 +104,8 @@ add_vignette <- function(
     title <- "Get started"
   }
 
-  xfun::gsub_file(path, "{{title}}", title, fixed = TRUE)
-  xfun::gsub_file(path, "{{project_name}}", package_name, fixed = TRUE)
+  gsub_in_file(path, "{{title}}", title)
+  gsub_in_file(path, "{{project_name}}", package_name)
 
   ## Message ----
 

R/constants.R

@@ -0,0 +1,22 @@
+#' Blocks used to organise metadata
+#' @noRd
+.DEFAULT_BLOCKS <- c("user", "project", "git", "runtime")
+
+#' Version of the GitHub API
+#' @noRd
+.GITHUB_API_VERSION <- "2022-11-28"
+
+#' URL of the GitHub API
+#' @noRd
+.GITHUB_API_URL <- "https://api.github.com"
+
+#' Endpoint of the GitHub API
+#' @noRd
+.GITHUB_API_ENDPOINT <- "/repos/frbcesab/r-templates/contents/"
+
+#' URL to access raw file on GH repo
+#' @noRd
+.TEMPLATE_FILE_URL <- paste0(
+  "https://raw.githubusercontent.com/FRBCesab/",
+  "r-templates/refs/heads/main/"
+)

R/create_new_compendium.R

@@ -41,8 +41,8 @@
 #'   See [add_compendium()] for further information.
 #'
 #' @param license A character vector of length 1. The license to be used for
-#'   this project. Run [get_licenses()] to choose an appropriate one. Default
-#'   is `license = 'GPL (>= 2)'`
+#'   this project. Run [get_available_licenses()] to choose an appropriate one.
+#'   Default is `license = 'GPL (>= 2)'`
 #'
 #'   The license can be changed later by calling [add_license()] (and
 #'   [add_license_badge()] to update the corresponding badge in the README).
@@ -255,8 +255,6 @@ create_new_compendium <- function(
   ## Check for inceptions ----
 
   stop_if_git_in_git()
-  stop_if_proj_in_proj()
-
   stop_if_invalid_project_name()
 
   ## Check if git is well configured ----
@@ -278,7 +276,7 @@ create_new_compendium <- function(
 
   if (!length(which(licenses$tag == license))) {
     stop(
-      "Invalid license. Please use `get_licenses()` to choose an ",
+      "Invalid license. Please use `get_available_licenses()` to choose an ",
       "appropriate one."
     )
   }

R/create_new_package.R

@@ -34,7 +34,7 @@
 #' **Creating a GitHub repo**.
 #'
 #' @param license A character vector of length 1. The license to be used for
-#'   this package. Run [get_licenses()] to choose an appropriate one.
+#'   this package. Run [get_available_licenses()] to choose an appropriate one.
 #'   Default is `license = 'GPL (>= 2)'`
 #'
 #'   The license can be changed later by calling [add_license()] (and
@@ -347,8 +347,6 @@ create_new_package <- function(
   ## Check for inceptions ----
 
   stop_if_git_in_git()
-  stop_if_proj_in_proj()
-
   stop_if_invalid_project_name()
 
   ## Check if git is well configured ----
@@ -370,7 +368,7 @@ create_new_package <- function(
 
   if (!length(which(licenses$tag == license))) {
     stop(
-      "Invalid license. Please use `get_licenses()` to choose an ",
+      "Invalid license. Please use `get_available_licenses()` to choose an ",
       "appropriate one."
     )
   }

R/get_available_gh_actions.R

@@ -13,7 +13,9 @@
 #' @family utilities functions
 #'
 #' @examples
+#' \dontrun{
 #' get_available_gh_actions()
+#' }
 
 get_available_gh_actions <- function() {
   actions <- list_template_files("actions")

R/get_available_issue_template.R

@@ -13,7 +13,9 @@
 #' @family utilities functions
 #'
 #' @examples
+#' \dontrun{
 #' get_available_issue_templates()
+#' }
 
 get_available_issue_templates <- function() {
   issues <- list_template_files("issues")

R/get_licenses.R → R/get_available_licenses.R

@@ -14,6 +14,6 @@
 #' @family utilities functions
 #'
 #' @examples
-#' get_licenses()
+#' get_available_licenses()
 
-get_licenses <- function() licenses[, c("tag", "url")]
+get_available_licenses <- function() licenses[, c("tag", "url")]

R/rcompendium-package.R

@@ -116,6 +116,7 @@
 "_PACKAGE"
 
 # Imports: start ----
+#' @importFrom gert git_branch git_config_global
 #' @importFrom usethis ui_code ui_done ui_field ui_info
 #' @importFrom usethis ui_line ui_oops ui_todo ui_value
 # Imports: end ----

R/utils-action.R

@@ -17,19 +17,3 @@ stop_if_invalid_gh_action_name <- function(name) {
 
   invisible(NULL)
 }
-
-
-#' List templates of a directory
-#' @param directory a character of length of 1. The name of the GH directory.
-#' @noRd
-list_template_files <- function(directory = NULL) {
-  content <- gh::gh(
-    endpoint = paste0(get_template_repo_url(), directory),
-    .send_headers = c(
-      `Accept` = "application/vnd.github.raw+json",
-      `Content-Type` = "application/json"
-    )
-  )
-
-  unlist(lapply(content, function(x) x[["name"]]))
-}

R/utils-desc.R

@@ -4,14 +4,22 @@ read_descr <- function() {
   path <- build_abs_path("DESCRIPTION")
 
   if (!file.exists(path)) {
-    stop("The file 'DESCRIPTION' does not exist.", call. = FALSE)
+    stop("The 'DESCRIPTION' file does not exist.", call. = FALSE)
   }
 
-  col_names <- colnames(read.dcf(path))
+  raw <- tryCatch(
+    read.dcf(path),
+    error = function(e) {
+      stop("The 'DESCRIPTION' file is not a valid DCF file.", call. = FALSE)
+    }
+  )
+
+  col_names <- colnames(raw)
+
   descr <- read.dcf(path, keep.white = col_names)
 
   if (nrow(descr) != 1) {
-    stop("Malformed 'DESCRIPTION' file")
+    stop("Malformed 'DESCRIPTION' file.", call. = FALSE)
   }
 
   as.data.frame(descr, stringsAsFactors = FALSE)
@@ -21,8 +29,6 @@ read_descr <- function() {
 #' Write DESCRIPTION (erase content)
 #' @noRd
 write_descr <- function(descr_file) {
-  stop_if_not_project()
-
   path <- build_abs_path("DESCRIPTION")
 
   write.dcf(

R/utils-file.R

@@ -1,54 +1,58 @@
-#' Open a file in editor
-#' @noRd
-edit_file <- function(path) {
-  if (rstudioapi::isAvailable() && rstudioapi::hasFun("navigateToFile")) {
-    rstudioapi::navigateToFile(path)
-  } else {
-    utils::file.edit(path)
-  }
-
-  invisible(NULL)
-}
-
-
 #' Open a file if required
 #' @param path a character of length of 1. The absolute path of the file.
 #' @param open a logical of length 1.
 #' @noRd
 open_file_if_needed <- function(path, open) {
   if (open) {
-    edit_file(path)
+    utils::file.edit(path)
   }
 
   invisible(NULL)
 }
 
 
 #' Search and replace strings in files
-#'
-#' File version of [gsub()]. Modified from [xfun::gsub_file()] allowing to
-#' search for strings in multiple lines.
-#' @param file Path of a single file.
-#' @param ... Arguments passed to [gsub()].
+#' @param file a character of length 1. The path of a single file.
+#' @param pattern a character of length 1. The pattern to replace.
+#' @param replacement a character of length 1. The replacement of the pattern.
+#' @note Inspired from `xfun::gsub_file()`
 #' @noRd
-gsub_in_file <- function(file, ...) {
-  if (!(file.access(file, 2) == 0 && file.access(file, 4) == 0)) {
-    stop("Unable to read or write to ", file)
+gsub_in_file <- function(file, pattern, replacement) {
+  stop_if_not_string(file)
+  stop_if_not_string(pattern)
+  stop_if_not_string(replacement)
+
+  if (!file.exists(file)) {
+    stop("The file '", file, "' does not exist", call. = FALSE)
+  }
+
+  if (file.access(file, 4) != 0) {
+    stop("Cannot read the '", file, "' file", call. = FALSE)
   }
 
-  x1 <- tryCatch(xfun::read_utf8(file, error = TRUE), error = function(e) {
-    stop(e)
-  })
+  if (file.access(file, 2) != 0) {
+    stop("Cannot write the '", file, "' file", call. = FALSE)
+  }
+
+  opts <- options(encoding = "native.enc")
+  on.exit(options(opts), add = TRUE)
+
+  x <- tryCatch(
+    readLines(file, encoding = "UTF-8", warn = FALSE),
+    error = function(e) {
+      stop("Cannot read the '", file, "' file", call. = FALSE)
+    }
+  )
 
-  if (is.null(x1)) {
+  if (length(x) == 0) {
     return(invisible(NULL))
   }
 
-  x1 <- paste0(x1, collapse = "\n")
-  x2 <- gsub(x = x1, ...)
+  text <- paste0(x, collapse = "\n")
+  text_new <- gsub(pattern, replacement, text, fixed = TRUE)
 
-  if (!identical(x1, x2)) {
-    xfun::write_utf8(x2, file)
+  if (!identical(text, text_new)) {
+    writeLines(enc2utf8(text_new), file, useBytes = TRUE)
   }
 
   invisible(NULL)