R/update_package.R

In luciorq/luciolib:

#' Update a Package to a new dev version
#' @param check Should run checks?; Default: FALSE
#' @inheritParams setup_package
#' @export
update_package <- function(
  pkg_name = NULL,
  project_dir = NULL,
  check = FALSE,
  branch = "main") {
  if (is.null(pkg_name) && is.null(project_dir)) {
    pkg_dir <- usethis::proj_get()
    pkg_name <- basename(pkg_dir)
  } else {
    pkg_dir <- fs::path_expand(fs::path(project_dir, pkg_name))
  }
  pkgload::unload(pkg_name)

  # Format
  usethis::use_tidy_style(strict = TRUE) # Style Source Code
  usethis::use_github_links()
  usethis::use_tidy_description()

  if (fs::file_exists(fs::path(pkg_dir, "README.Rmd"))) {
    knitr::knit(fs::path(pkg_dir, "README.Rmd"))
  }

  devtools::document()

  # TODO run tests in CI / container
  if (isTRUE(check)) {
    if (is_available("goodpractice")) {
      gp_res <- goodpractice::gp(path = pkg_dir)
    }
    if (is_available("styler")) {
      styler_res <- styler::style_pkg(
        pkg = pkg_dir, filetype = c("R", "Rprofile", "Rmd")
      )
    }
    if (is_available("reticulate")) {
      if (is_available("yamllint", "python")) {
        cli::cli_alert("{.pkg yamllint} notes:")
        yamllint_res <- sys::exec_wait(
          "yamllint",
          args = c(pkg_dir)
        )
      }
    }
    if (is_available("spelling")) {
      # devtools::spell_check & spelling::spell_check_package are the same
      # devtools::spell_check()
      spelling::spell_check_package(pkg = pkg_dir)
    }
    if (is_available("rcmdcheck")) {
      # instead of devtools::check()
      # TODO add cran build flags
      rcmdcheck::rcmdcheck(
        path = pkg_dir,
        args = c("--as-cran")
      )
    }
    if (is_available("covr")) {
      covr::package_coverage(path = pkg_dir, type = "all")
    }
    if (is_available("gert")) {
      current_branch <- gert::git_branch(repo = pkg_dir)
      if (!stringr::str_detect(current_branch, branch)) {
        cli::cli_alert_warning("Current working branch is {.url {current_branch}}, go back to {.url {branch}}.")
      }
      if (stringr::str_detect(current_branch, "master")) {
        change_default_git_branch(pkg_dir, branch)
      }
    }
  }
  pkgbuild::build(path = pkg_dir)
  devtools::install(pkg = pkg_dir)
  # TODO create update_description
  # luciolib::update_description()
  # pkgload::load_all()
  # Styling the package files
}

#' Update Personal Lib Package
#' @export
update_luciolib <- function() {
  update_package(
    pkg_name = "luciolib",
    project_dir = getOption("usethis.destdir"),
    check = FALSE
  )
}

#' Change default github branch
#' @param pkg_dir Base directory of git repo
change_default_git_branch <- function(pkg_dir, branch = "main") {
  if (!is_available("gert")) {
    return(0)
  }
  current_branch <- gert::git_branch(repo = pkg_dir)

  if (is.null(current_branch)) {
    cli::cli_alert_warning("Current repo has not been commited yet.")
    return(0)
  }

  if (stringr::str_detect(current_branch, branch)) {
    cli::cli_alert_info("Current branch is already {.url {branch}}.")
    return(0)
  }
  cli::cli_alert_warning("Current working branch is {.url {current_branch}}, replace it with {.url {branch}}.")
  sh_res <- shell_exec("git -C {pkg_dir} branch -m {current_branch} {branch}")

  remote_info <- gert::git_remote_list(pkg_dir)
  if (nrow(remote_info) == 0) {
    cli::cli_alert_danger("Current repo has not set a remote.")
    rlang::abort("Repo has no remote.")
  }

  sh_res <- shell_exec("git -C {pkg_dir} push -u origin {branch}")
  sh_res <- shell_exec("git -C {pkg_dir} symbolic-ref refs/remotes/origin/HEAD refs/remotes/origin/{branch}")

  repo_name <- stringr::str_extract(remote_info$url[1], "\\w+/\\w+")
  user <- stringr::str_remove(repo_name, "/.*")
  repo <- stringr::str_remove(repo_name, ".*/")
  # if (!stringr::str_detect(pkg_dir, repo)) { }
  utils::browseURL(
    glue::glue("https://github.com/{user}/{repo}/settings/branches")
  )
  yeah_confirm <- FALSE
  while (!yeah_confirm) {
    yeah_confirm <- usethis::ui_yeah(
      x = "Confirm after updating default branch to {branch}. Done?"
    )
  }
  sh_res <- shell_exec(
    "git -C {pkg_dir} push origin --delete {current_branch}"
  )
  cli::cli_alert_success("Removed branch {.url {current_branch}} from remote.")
}