R/setup_package.R

In luciorq/luciolib:

#' @title Build package infrastructure from template and configuration files
#' @description Bootstrap package creation
#' @param pkg_name Package name to be created
#' @param project_dir package project path to be used
#' @param config_file path to configuration file used. Default: NULL
#' @param option_name Option slot to query for description. Default: "luciolib"
#' @param use_cc Should be added a Code of Conduct, Default: TRUE
#' @param ci_suite Add CI infrastructure, Default: FALSE
#' @param is_private create private GitHub repo, Default: FALSE
#' @param branch name of the git branch to create. Default: "main"
#' @param remote_user name of the user / organization to host the remote repo
#' @return Boolean; TRUE if it package was created successfully
#' @details DETAILS
#' @examples
#' \dontrun{
#' if (interactive()) {
#'   setup_package(pkg_name = "testPkg", project_dir = fs::path_temp())
#' }
#' }
#' @export
setup_package <- function(
  pkg_name = NULL,
  project_dir = NULL,
  config_file = NULL,
  option_name = "luciolib",
  use_cc = TRUE,
  ci_suite = TRUE,
  is_private = TRUE,
  branch = "main",
  remote_user = NULL) {
  # Read input data file
  proj_options <- base::getOption(x = option_name, default = list())

  if (!is.null(config_file) && fs::file_exists(config_file)) {
    description_data <- yaml::read_yaml(config_file)
  } else {
    rlang::abort("Configuration YAML file not found.")
  }

  return(TRUE)
  # input treatment

  # Create package
  pkg_dir <- fs::path_expand(fs::path(project_dir, pkg_name))
  usethis::with_project(
    path = pkg_dir,
    code = {

    },
    force = TRUE,
    quiet = FALSE
  )
  # Basic infrastructure

  # data-raw dir is used to store temporary files and should be in .Rbuildignore
  usethis::use_data_raw()
  # Description file

  # dependencies
  # usethis::use_package()
  # usethis::use_dev_package()

  # git and github setup
  usethis::git_branch_default(branch)
  usethis::create_github_token()

  # CI, CD, GitOps infrastructure

  usethis:::check_no_uncommitted_changes()
  usethis:::git_commit_ask()

  ############################ OLD STUFF #######################################

  if (is.null(getOption("usethis.description"))) {
    rlang::abort(
      "Package configuration options not set for {usethis} description."
    )
  }

  if (is.null(getOption("usethis.destdir"))) {
    rlang::abort("Project directory not set.")
  } else {
    project_dir <- getOption("usethis.destdir")
  }

  if (is.null(pkg_name)) {
    usethis::proj_activate(".")
  } else if (fs::dir_exists(pkg_dir)) {
    usethis::proj_activate(pkg_dir)
  } else {
    usethis::create_package(pkg_dir, roxygen = "TRUE")
  }
  desc_file_path <- fs::path(project_dir, "DESCRIPTION")
  # TODO automate .Rproject file update
  # Change project build information
  # Menu: Build > Configure Build Tools > check:
  #  * Generate Documentation with roxygen and all suboptions in `configure`
  # Add check parameter `--as-cran` (Check Parameter - R CMD check)
  #
  if (Sys.getenv("GITHUB_PAT") == "") {
    credentials::set_github_pat()
  }
  usethis::use_git()
  usethis::git_vaccinate()
  usethis::use_roxygen_md()
  usethis::use_readme_rmd() # or usethis::use_readme_md()
  usethis::use_lifecycle_badge("Experimental")
  usethis::use_cran_badge()

  # TODO add logo to package description file
  usethis::use_logo(img = fs::path(pkg_dir, "man", "figures", "logo.svg"))

  read_me_rmd_text <- readr::read_lines(
    fs::path(pkg_dir, "README.Rmd")
  )
  read_me_rmd_text <- stringr::str_replace(
    string = read_me_rmd_text,
    pattern = glue::glue("^# {pkg_name}$"),
    replacement = glue::glue(
      stringr::str_c(
        "# {pkg_name} <img src='man/figures/logo.svg' ",
        "align=\"right\" alt=\"{pkg_name} logo\" height=\"140\" />",
        collapse = ""
      )
    )
  )
  readr::write_lines(read_me_rmd_text, fs::path(pkg_dir, "README.Rmd"))

  # Package documentation
  usethis::use_mit_license()
  # usethis::use_gpl3_license()

  # Use code of conduct
  if (isTRUE(use_cc)) {
    usethis::use_code_of_conduct()
    readr::write_lines(
      x = c(
        "",
        "----",
        "",
        glue::glue(
          "Please note that the '{pkg_name}' project is released with a"
        ),
        "[Contributor Code of Conduct](CODE_OF_CONDUCT.md).",
        "By contributing to this project, you agree to abide by its terms.",
        ""
      ), path = fs::path(pkg_dir, "README.Rmd"),
      append = TRUE
    )
  }

  # Add package documentation through {roxygen2}
  usethis::use_package_doc()
  usethis::use_news_md()

  usethis::git_sitrep()
  usethis::use_git_config()
  knitr::knit(fs::path(project_dir, pkg_name, "README.Rmd"))

  ## Modify Title and Description
  # Commit readme files
  gert::git_add("README.Rmd")
  gert::git_add("README.md")
  gert::git_add(glue::glue("{pkg_name}.Rproj"))
  # TODO check if there is any file to commit
  gert::git_commit(message = "Repo init")


  utils::browseURL(glue::glue("https://github.com/new"))

  # FIXME not working
  # Add remote
  gert::git_branch_create("main")
  gert::git_remote_add(
    "origin",
    glue::glue("git@github.com:luciorq/{pkg_name}.git")
  )

  # Push to master branch
  # git push -u origin master
  gert::git_remote_list()

  gert::git_fetch()
  # gert::git_pull()
  # sys::exec_wait("git", c("push", "-u", "origin", "master"))
  gert::git_push(remote = "origin")

  usethis::git_sitrep()

  # usethis::use_github(private = is_private, protocol = "ssh")
  # usethis::use_tidy_github()

  usethis::use_spell_check()
  # use_data_raw()
  # usethis::use_tibble()
  # usethis::use_pipe()

  # Set version of dependencies on DESCRIPTION
  usethis::use_github_links()
  usethis::use_dev_version()
  usethis::use_tidy_description()

  #



  # FIXME Test and CI Suite configuration
  if (isTRUE(ci_suite)) {
    if (is_bioc()) {
      if (requireNamespace("biocthis", quietly = TRUE)) {
        rlang::abort("`biocthis` package is not installed.")
      }
      biocthis::use_bioc_description()
      biocthis::use_bioc_github_action()
      styler::style_pkg(pkg = ".", transformers = biocthis::bioc_style())
    } else {
      usethis::use_github_action_check_release()
      usethis::use_tidy_style(strict = TRUE) # Style Source Code
    }
    # usethis::use_github_action_check_standard()
    usethis::use_testthat(edition = 3)
    if (stringr::str_detect(desc_file_path, "^Config/testthat/edition: 3")) {
      readr::write_lines(
        "Config/testthat/edition: 3",
        path = desc_file_path,
        append = TRUE
      )
    }
    # usethis::use_coverage("codecov")
    # usethis::use_tidy_ci()
    usethis::use_pkgdown()
    # usethis::use_pkgdown_travis()
  }

  # Build and Install package
  # use_version("minor") #To update package
  pkgload::unload(pkg_name)
  # Styling the package files
  usethis::use_tidy_style(strict = TRUE) # Style Source Code
  if (fs::file_exists(fs::path(project_dir, pkg_name, "README.Rmd"))) {
    knitr::knit(fs::path(project_dir, pkg_name, "README.Rmd"))
  }
  devtools::document()
  rcmdcheck::rcmdcheck() # devtools::check()
  # pkgbuild::build()
  # pkgload::load_all()
  # rcmdcheck::rcmdcheck()
  devtools::install()
}

#' Update Personal Lib Package
#' @param check Should run checks?; Default: FALSE
#' @inheritParams setup_package
#' @export
update_package <- function(pkg_name, project_dir, check = FALSE) {
  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()
  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")) {
        # yamllint <- reticulate::import("yamllint")
        cli::cli_alert("{.pkg yamllint} notes:")
        yamllint_res <- sys::exec_wait(
          "yamllint",
          args = c(pkg_dir)
        )
      }
    }
    if (is_available("rcmdcheck")) {
      # instead of devtools::check()
      # TODO add cran build flags
      rcmdcheck::rcmdcheck()
    }


  }
  pkgbuild::build()
  devtools::install()
  # TODO create update_description
  # luciolib::update_description()
  # pkgload::load_all()
  # Styling the package files
}


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

# ----------------------------------TOOLS--------------------------------------

#' Function to check if package is aiming BioConductor
#' @inheritParams setup_package
is_bioc <- function(pkg_name, project_dir) {
  desc_file <- fs::path(project_dir, pkg_name, "DESCRIPTION")
  desc_lines <- readr::read_lines(desc_file)
  result_bool <- any(stringr::str_detect(desc_lines, "^biocViews"))
  return(result_bool)
}


#' Check if package is installed
#' If package isn't installed tell user to install
#' @param package_name package name to query
#' @param type type of package to query c("r_pkg", "py_module", "shell")
is_available <- function(
  package_name,
  type = NULL
) {
  if (is.null(type)) {
    type <- "rstats"
  }
  type <- stringr::str_to_lower(stringr::str_squish(type))
  if (any(stringr::str_detect(type, "py|python"))) {
    type <- "python"
  }
  if (any(stringr::str_detect(type, "r_|rstats"))) {
    type <- "rstats"
  }

  if (type == "python") {
    if (reticulate::py_module_available(package_name)) {
      cli::cli_alert("Using {.pkg {package_name}} for tests.")
      return(TRUE)
    } else {
      cli::cli_alert_warning(
        "Python module {.pkg {package_name}} is not installed."
      )
      cli::cli_alert_info(
        "You should install it to use full functionality."
      )
      return(FALSE)
    }
  }
  if (type == "rstats") {
    if (requireNamespace(package_name, quietly = TRUE)) {
      cli::cli_alert("Using {.pkg {package_name}} for tests.")
      return(TRUE)
    } else {
      cli::cli_alert_warning(
        "Package {.pkg {package_name}} is not installed."
      )
      cli::cli_alert_info(
        "You should install it to use full functionality.")
      return(FALSE)
    }
  }
}