R/new_compendium.R

Defines functions new_compendium

Documented in new_compendium

#' Create an R compendium structure
#' 
#' @description
#' This function creates a research compendium (i.e. a predefined files/folders 
#' structure) to help user organizing files/folders to run analysis.
#' 
#' In addition to common R packages files/folders (see [new_package()] for 
#' further information) this function will created these following folders:
#' 
#' * `data/`: a folder to store raw data. Note that these data must never be
#' modified. If user want to modify them it is recommended to export new data 
#' in `outputs/`.
#' * `analyses/`: a folder to write analyses instructions, i.e. R scripts. If
#' user need to create R functions it is recommended to write them in the `R/`
#' folder.
#' * `outputs/`: a folder to store intermediate and final outputs generated by
#' the R scripts.
#' * `figures/`: a folder to store figures generated by the R scripts.
#' 
#' This function also creates a Make-like R file (`make.R`). This file contains
#' two main lines:
#' 
#' * `devtools::install_deps()`: downloads the external dependencies required 
#' by the project (an alternative to `install.packages()`). Ideal for sharing;
#' * `devtools::load_all()`: loads external dependencies and R functions (an
#' alternative to `library()` and `source()` respectively).
#' 
#' As the user writes R scripts he/she can add the following line in this file:
#' `source(here::here("rscripts", "script_X.R"))`. Then he/she can source the
#' entire `make.R` to run analysis. The function [add_dependencies()] can be
#' used to automatically add external dependencies in the `DESCRIPTION` file.
#' 
#' It is recommended, for a better reproducibility, to call external 
#' dependencies as `pkg::fun()` or with `@import` or `@importFrom` in R 
#' functions instead of using `library()`.
#' 
#' All these files/folders are added to the `.Rbuildignore` so the rest of the
#' project (e.g. R functions) can be used (or installed) as a R package.
#' 
#' @param compendium A character vector specifying the folders to be created.
#'   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)'` 
#'   
#'   The license can be changed later by calling [add_license()] (and 
#'   [add_license_badge()] or [refresh()] to update the corresponding badge in
#'   the README).
#' 
#' @param status A character vector of length 1. The status of the project 
#'   according to the standard defined by the \url{https://www.repostatus.org} 
#'   project. One among `'concept'`, `'wip'`, `'suspended'`, `'abandoned'`, 
#'   `'active'`, `'inactive'`, or `'unsupported'`. See [add_repostatus_badge()]
#'   for further information. 
#'   
#'   This argument is used to add a badge to the `README.Rmd` to help visitors 
#'   to better understand your project. Default is `status = NULL`.
#'   
#'   This status can be added/changed later by using [add_repostatus_badge()].
#' 
#' @param lifecycle A character vector of length 1. The life cycle stage of 
#'   the project according to the standard defined at 
#'   \url{https://lifecycle.r-lib.org/articles/stages.html}. One among 
#'   `'experimental'`, `'stable'`, `'deprecated'`, or `'superseded'`.
#'   See [add_lifecycle_badge()] for further information. 
#'   
#'   This argument is used to add a badge to the `README.Rmd` to help visitors 
#'   to better understand your project. Default is `lifecycle = NULL`. 
#'   
#'   This stage can be added/changed later by using [add_lifecycle_badge()].
#' 
#' @param contributing A logical value. If `TRUE` (default) adds a 
#'   `CONTRIBUTING.md` file and `ISSUE_TEMPLATES`. See [add_contributing()] for
#'   further information.
#' 
#' @param code_of_conduct A logical value. If `TRUE` (default) adds a 
#'   `CODE_OF_CONDUCT.md` file. See [add_code_of_conduct()] for further 
#'   information.
#' 
#' @param vignette A logical value. If `TRUE` creates a vignette in 
#'   `vignettes/`. Packages [`knitr`](https://yihui.org/knitr/) and 
#'   [`rmarkdown`](https://rmarkdown.rstudio.com/) are also added to the 
#'   `Suggests` field in the `DESCRIPTION` file. Default is `FALSE`.
#' 
#' @param test A logical value. If `TRUE` initializes units tests by running 
#'   [usethis::use_testthat()]. 
#'   Package [`testthat`](https://testthat.r-lib.org) is also added to the 
#'   `Suggests` field in the `DESCRIPTION` file. Default is `FALSE`.
#' 
#' @param renv A logical value. If `TRUE` initializes an `renv` environment for 
#'   the project by running [renv::init()]. 
#'   Package [`renv`](https://rstudio.github.io/renv/) is also added to the 
#'   `Imports` field in the `DESCRIPTION` file. Default is `FALSE`.
#'   
#' @param dockerfile A logical value. If `TRUE` creates an `Dockerfile` for 
#'   the project. See [add_dockerfile()] for further detail. Default is `FALSE`.
#'   
#' @param create_repo A logical value. If `TRUE` (default) creates a repository 
#'   (public if `private = FALSE` or private if `private = TRUE`) on GitHub. 
#'   See the section **Creating a GitHub repo** of the help page of 
#'   [new_package()].
#' 
#' @param private A logical value. If `TRUE` creates a private repository on 
#'   user GitHub account (or organisation). Default is `private = FALSE`.
#' 
#' @param gh_check A logical value. If `TRUE` configures GitHub 
#'   Actions to automatically check and test the package after each push. This 
#'   will run `R CMD check` on the three major operating systems (Ubuntu, macOS,
#'   and Windows) on the latest release of R. See [add_github_actions_check()] 
#'   for further information. 
#'   
#'   If `create_repo = FALSE` this argument is ignored. Default is `FALSE`.
#'   
#' @param gh_render A logical value. If `TRUE` configures GitHub 
#'   Actions to automatically knit the `README.Rmd` after each push. 
#'   See [add_github_actions_render()] for further information. 
#'   
#'   If `create_repo = FALSE` this argument is ignored. Default is `FALSE`.
#'   
#' @param gh_citation A logical value. If `TRUE` configures GitHub 
#'   Actions to automatically update the `CITATION.cff` file. 
#'   See [add_github_actions_citation()] for further information. 
#'   
#'   If `create_repo = FALSE` this argument is ignored. Default is `FALSE`.
#'   
#' @param codecov A logical value. If `TRUE` configures GitHub Actions to 
#'   automatically report the code coverage of units tests after each push. 
#'   See [add_github_actions_codecov()] for further information. 
#'   
#'   If `create_repo = FALSE` this argument is ignored. Default is `FALSE`.
#'   
#' @param website A logical value. If `TRUE` configures GitHub 
#'   Actions to automatically build and deploy the package website 
#'   (using [`pkgdown`](https://pkgdown.r-lib.org/index.html)) 
#'   after each push. A **gh-pages** branch will be created using 
#'   [usethis::use_github_pages()] and the GitHub repository will be 
#'   automatically configured to deploy website.
#'   
#'   If `create_repo = FALSE` this argument is ignored. Default is `FALSE`.
#' 
#' @param given A character vector of length 1. The given name of the 
#'   maintainer of the package. If `NULL` (default) the function will try to 
#'   get this value by reading the `.Rprofile` file. 
#'   
#'   For further information see [set_credentials()].
#' 
#' @param family A character vector of length 1. The family name of the 
#'   maintainer of the package. If `NULL` (default) the function will try to 
#'   get this value by reading the `.Rprofile` file. 
#'   
#'   For further information see [set_credentials()].
#' 
#' @param email A character vector of length 1. The email address of the 
#'   maintainer of the package. If `NULL` (default) the function will try to 
#'   get this value by reading the `.Rprofile` file. 
#'   
#'   For further information see [set_credentials()].
#' 
#' @param orcid A character vector of length 1. The ORCID of the maintainer of 
#'   the package. If `NULL` (default) the function will try to get this value 
#'   by reading the `.Rprofile` file. 
#'   
#'   For further information see [set_credentials()].
#' 
#' @param organisation A character vector of length 1. The GitHub organisation 
#'   to host the repository. If defined it will overwrite the GitHub pseudo.
#' 
#'   Default is `organisation = NULL` (the GitHub pseudo will be used).
#' 
#' @param overwrite A logical value. If `TRUE` files written from templates and
#'   modified by user are erased. Default is `overwrite = FALSE`. 
#'   **Be careful while using this argument**.
#' 
#' @param quiet A logical value. If `TRUE` messages are deleted. Default is 
#'   `FALSE`.
#' 
#' @return No return value.
#'
#' @export
#' 
#' @family setup functions
#' 
#' @examples 
#' \dontrun{
#' library(rcompendium)
#' 
#' ## Define **ONCE FOR ALL** your credentials ----
#' set_credentials(given = "John", family = "Doe", 
#'                 email = "john.doe@@domain.com", 
#'                 orcid = "9999-9999-9999-9999", protocol = "ssh")
#'
#' ## Create an R package ----
#' new_compendium()
#' 
#' ## Start adding data and developing functions and scripts ----
#' ## ...
#' 
#' ## Update package (documentation, dependencies, README, check) ----
#' refresh()
#' }

new_compendium <- function(compendium = NULL, license = "GPL (>= 2)", 
                           status = NULL, lifecycle = NULL, contributing = TRUE,
                           code_of_conduct = TRUE, vignette = FALSE, 
                           test = FALSE, create_repo = TRUE, private = FALSE, 
                           gh_check = FALSE, codecov = FALSE, website = FALSE, 
                           gh_render = FALSE, gh_citation = FALSE, given = NULL,
                           family = NULL, email = NULL, orcid = NULL, 
                           organisation = NULL, renv = FALSE, 
                           dockerfile = FALSE, overwrite = FALSE, 
                           quiet = FALSE) { 
  
  ## If not RStudio ----
  
  if (!rstudioapi::isAvailable()) {
    if (!file.exists(".here")) file.create(".here")
  }
  
  
  ## Check for inceptions ----
  
  git_in_git()
  proj_in_proj()
  
  
  ## Check if git is well configured ----
  
  github <- gh::gh_whoami()$"login"
  
  if (is.null(github)) {
    stop("Unable to find GitHub username. Please run ", 
         "`?gert::git_config_global` for more information.")
  }
  
  
  ## Check for package name ----
  
  project_name <- get_package_name()
  
  
  
  ## Check License ----
  
  if (!length(which(licenses$tag == license))) {
    stop("Invalid license. Please use `get_licenses()` to choose an ",
         "appropriate one.")
  }
  
  
  ## Check mandatory credentials ----
  
  if (is.null(given)) {
    
    given <- getOption("given")
    if (is.null(given)) {
      stop("Please provide a given name. Use `set_credentials()` to ", 
           "store it permanently or use the argument `given`.")
    }
  }
  
  if (is.null(family)) {
    family <- getOption("family")
    if (is.null(family)) {
      stop("Please provide a family name. Use `set_credentials()` to ", 
           "store it permanently or use the argument `family`.")
    }
  }
  
  if (is.null(email)) {
    email <- getOption("email")
    if (is.null(email)) {
      stop("Please provide an email address. Use `set_credentials()` to ", 
           "store it permanently or use the argument `email`.")
    }
  }
  
  
  ## Check if GitHub Pseudo / Organisation exists ----
  
  if (!is.null(organisation)) {
    
    is_gh_organisation(organisation)
    
  } else {
    
    is_gh_user()
  }
  
  
  ## Check GITHUB PAT & Available Repo ----
  
  if (create_repo) {
    
    if (gh::gh_token() == "") {
      stop("No GITHUB PAT found. Please run `usethis::gh_token_help()` for ", 
           "further information or read the vignette.")
    }
    
    if (!is.null(organisation)) {
      
      if (!is.null(is_gh_repo(organisation, project_name))) {
        
        github_url <- paste0("https://", "github.com/", organisation, "/", 
                             project_name)
        stop("Repository < ", github_url, " > already exists.")
      }
      
    } else {
      
      if (!is.null(is_gh_repo(github, project_name))) {
        
        github_url <- paste0("https://", "github.com/", github, "/", 
                             project_name)
        stop("Repository < ", github_url, " > already exists.")
      }
    }
    
  } else {
    
    gh_check    <- FALSE
    codecov     <- FALSE
    website     <- FALSE
    gh_render   <- FALSE
    gh_citation <- FALSE
  }
  
  
  stop_if_not_logical(test)
  
  if (!test) codecov  <- FALSE
  
  
  
  ## Check Repo Status ----
  
  if (!is.null(status)) {
    if (!(tolower(status) %in% c("concept", "wip", "suspended", "abandoned", 
                                 "active", "inactive", "unsupported"))) {
      
      stop("Invalid Repo status. Please run `?add_repostatus_badge` to ",
           "select an appropriate one.")
    }  
  }
  
  
  ## Check Life cycle ----
  
  if (!is.null(lifecycle)) {
    if (!(tolower(lifecycle) %in% c("experimental", "stable", "deprecated", 
                                    "superseded"))) {
      
      stop("Invalid Life cycle. Please run `?add_lifecycle_badge` to ",
           "select an appropriate one.")
    }  
  }
  
  
  ## Check renv ----
  
  stop_if_not_logical(renv)
  
  
  ## ... End of Checks ----
  
  
  
  ##
  ## INITIALIZING VERSIONING ----
  ## 
  
  
  
  ui_title("Initializing Versioning")
  
  
  ## Init GIT (if required) ----
  
  if (!is_git()) {
    
    gert::git_init(file.path(path_proj()))
    ui_done("Init {ui_value('git')} versioning")
  }
  
  
  ## Add/Replace R-specific gitignore ----
  
  if (file.exists(file.path(path_proj(), ".gitignore"))) {
    
    invisible(file.remove(file.path(path_proj(), ".gitignore")))
  }
  
  add_to_gitignore()
  
  
  
  ##
  ## CREATING PACKAGE STRUCTURE ----
  ## 
  
  
  
  ui_title("Creating Package Structure")
  
  
  ## Ignore files for R CMD ----
  
  add_to_buildignore(paste0(project_name, ".Rproj"), quiet = quiet)
  add_to_buildignore(".Rproj.user", quiet = quiet)
  add_to_buildignore(".DS_Store", quiet = quiet)
  
  if (!quiet) cli::cat_line()
  
  
  ## Create DESCRIPTION ----
  
  add_description(given, family, email, orcid, organisation, open = FALSE, 
                  overwrite = overwrite, quiet = quiet)
  
  if (!quiet) cli::cat_line()
  
  
  ## Add LICENSE ----
  
  add_license(license, given, family, quiet = quiet)
  
  if (!quiet) cli::cat_line()
  
  
  ## Create folders ----
  
  dir.create(file.path(path_proj(), "R"), showWarnings = FALSE)
  
  if (!quiet) ui_done("Creating {ui_value('R/')} directory")
  
  
  # dir.create(file.path(path_proj(), "man"), showWarnings = FALSE)
  
  # if (!quiet) ui_done("Creating {ui_value('man/')} directory")
  
  if (!quiet) cli::cat_line()
  
  
  ## Package doc bonus ----
  
  add_package_doc(open = FALSE, overwrite = overwrite, quiet = quiet)

  # add_citation(given, family, organisation, open = FALSE, 
  #              overwrite = overwrite, quiet = quiet)
  
  
  ## Demo R function ----
  
  if (!file.exists(file.path(path_proj(), "R", "fun-demo.R"))) {
    
    invisible(
      file.copy(system.file(file.path("templates", "fun-demo.R"), 
                            package = "rcompendium"), 
                file.path(path_proj(), "R", "fun-demo.R"), 
                overwrite = overwrite)) 
  }
  
  if (!quiet) cli::cat_line()
  if (!quiet) ui_done("Writing {ui_value('R/fun-demo.R')} file")
  
  # suppressMessages(devtools::document(quiet = TRUE))
  
  add_to_gitignore("man/", quiet = quiet)
  add_to_gitignore("NAMESPACE", quiet = quiet)
  
  
  ##
  ## CREATING COMPENDIUM STRUCTURE ----
  ## 
  
  
  
  ui_title("Creating Compendium Folders")  
  
  add_compendium(compendium, quiet = quiet)
  cli::cat_line()
  
  add_makefile(given, family, email, open = FALSE, overwrite = overwrite, 
               quiet = quiet)
  
  
  
  ##
  ## ADDING TESTTHAT ----
  ## 
  
  
  if (test) {
    
    ui_title("Adding Testthat")
    
    add_testthat()
  }
  
  
  
  ##
  ## ADDING VIGNETTE ----
  ## 
  
  
  if (vignette) {
    
    ui_title("Adding Vignette")
    
    add_vignette(open = FALSE, overwrite = overwrite, quiet = quiet)
  }
  
  
  
  ##
  ## INITALIZE RENV ----
  ## 
  
  
  if (renv) {
    
    ui_title("Initializing renv")
    
    add_renv(quiet)
  }
  
  
  
  ##
  ## UPDATE DEPENDENCIES ----
  ## 
  
  
  ui_title("Checking for Dependencies")
  
  add_dependencies(compendium)
  
  
  
  ##
  ## ADDING CONTRIBUTING ----
  ## 
  
  
  if (contributing) {
    
    ui_title("Adding Contributing")
    
    add_contributing(email = email, organisation = organisation, open = FALSE, 
                     overwrite = overwrite, quiet = quiet)
  } 
  
  
  
  ##
  ## ADDING CODE OF CONDUCT ----
  ## 
  
  
  if (code_of_conduct) {
    
    ui_title("Adding Code of conduct")
    
    add_code_of_conduct(email = email, open = FALSE, overwrite = overwrite, 
                        quiet = quiet)
  }
  
  
  
  ##
  ## ADDING README ----
  ## 
  
  
  
  ui_title("Adding README")
  
  
  
  add_readme_rmd(type = "compendium", given, family, organisation, 
                 open = FALSE, overwrite = overwrite, quiet = quiet)
  
  add_sticker(type = "compendium", overwrite = overwrite, quiet = quiet)
  
  
  
  ##
  ## KNITING README ----
  ## 
  
  
  
  ui_title("Kniting README")  
  
  
  rmarkdown::render(file.path(path_proj(), "README.Rmd"), 
                    output_format = "md_document", quiet = TRUE)
  
  if (!quiet) ui_done("Kniting {ui_value('README.Rmd')}")
  
  
  
  ##
  ## FIRST COMMIT ----
  ## 
  
  
  
  ui_title("Committing changes")  
  
  
  ## Commit changes ----
  
  invisible(gert::git_add("."))
  invisible(gert::git_commit("init repo"))
  
  if (!quiet) {
    ui_done(paste0("Committing changes with the following message: ", 
                   "{ui_value('init repo')}"))
  }
  
  
  
  ##
  ## CREATING GITHUB REPOSITORY ----
  ## 
  
  
  
  if (create_repo) {
    
    ui_title("Creating GITHUB Repository")
    
    
    ## Create GitHub repo ----
    
    usethis::use_github(organisation = organisation, private = private)
    
    
    ## Update GitHub repo fields ----
    
    owner <- ifelse(is.null(organisation), github, organisation)
    update_gh_repo(owner, repo = project_name, website = website, quiet = quiet)
    
  }
  
  
  
  ##
  ## GHA R-CMD-Check ----
  ## 
  
  
  
  if (gh_check) {
    
    ui_title("Configuring GH Actions - R CMD CHECK")
    
    add_github_actions_check(quiet = quiet)
  }
  
  
  
  ##
  ## GHA Code coverage ----
  ## 
  
  
  
  if (codecov) {
    
    ui_title("Configuring GH Actions - Code Coverage")
    
    add_github_actions_codecov(quiet = quiet)
  }
  
  
  
  ##
  ## GHA Render README ----
  ## 
  
  
  
  if (gh_render) {
    
    ui_title("Configuring GH Actions - Render README")
    
    add_github_actions_render(quiet = quiet)
  }
  
  
  
  ##
  ## GHA Website deployment ----
  ## 
  
  
  
  if (website) {
    
    ui_title("Configuring GH Actions - Website deployment")
    
    add_github_actions_pkgdown()
    
    cli::cat_line()
    
    usethis::use_github_pages(branch = "gh-pages")
  }
  
  
  
  ##
  ## GHA CITATION ----
  ## 
  
  
  
  if (gh_citation) {
    
    ui_title("Configuring GH Actions - CITATION.cff")
    
    add_github_actions_citation(quiet = quiet)
  }
  
  
  
  ##
  ## SECOND COMMIT ----
  ## 
  
  
  
  if (gh_check || codecov || website || gh_render || gh_citation) {
    
    ui_title("Committing changes")
    
    invisible(gert::git_add("."))
    invisible(gert::git_commit("ci: setup actions"))
    
    if (!quiet) {
      
      ui_done(paste0("Committing changes with the following message: ", 
                     "{ui_value('ci: setup actions')}"))
    }
  }
  
  
  
  
  ##
  ## DOCKERFILE ----
  ## 
  
  
  if (dockerfile) {
    
    ui_title("Adding Dockerfile")
    
    add_dockerfile(given, family, email, open = FALSE, overwrite = overwrite, 
                   quiet = quiet)
  }
  
  
  
  ##
  ## ADDING BADGES ----
  ## 
  
  
  
  ui_title("Adding Badges to README") 
  
  
  if (gh_check) {
    add_github_actions_check_badge(organisation, quiet = quiet)
  }
  
  if (website) {
    add_github_actions_pkgdown_badge(organisation, quiet = quiet)
  }
  
  if (codecov) {
    add_github_actions_codecov_badge(organisation, quiet = quiet)
    add_codecov_badge(organisation, quiet = quiet)
  }
  
  add_license_badge(quiet = quiet)
  
  if (!is.null(lifecycle)) {
    add_lifecycle_badge(lifecycle, quiet = quiet)
  }
  
  if (!is.null(status)) {
    add_repostatus_badge(status, quiet = quiet)
  }
  
  # add_dependencies_badge(quiet = quiet)
  
  
  
  ##
  ## KNITING README ----
  ## 
  
  
  
  ui_title("Kniting README")  
  
  
  rmarkdown::render(file.path(path_proj(), "README.Rmd"), 
                    output_format = "md_document", quiet = TRUE)
  
  if (!quiet) ui_done("Kniting {ui_value('README.Rmd')}")
  
  
  
  ##
  ## THIRD COMMIT ----
  ## 
  
  
  
  ui_title("Committing changes")
  
  invisible(gert::git_add("."))
  invisible(gert::git_commit("doc: update README"))
  
  if (!quiet) {
    
    ui_done(paste0("Committing changes with the following message: ", 
                   "{ui_value('doc: update README')}"))
  }
  
  
  if (create_repo) invisible(gert::git_push(verbose = FALSE))
  
  
  
  
  ##
  ## FINAL MESSAGES ----
  ## 
  
  
  ui_title("Done!")
  
  ui_title("What's next?")
  
  ui_todo("Edit project metadata in {ui_value('DESCRIPTION')}")
  ui_todo("Edit project description in {ui_value('README.Rmd')}")
  ui_todo("Write your R functions in the {ui_value('R/')} directory")
  
  if (test) 
    ui_todo(paste0("Write your units tests in the ", 
                   "{ui_value('tests/testthat/')} directory"))
  
  if (!is.null(compendium)) {
    
    cli::cat_line()
    ui_todo("Put your data in {ui_value('data/raw-data')} directory")
    ui_todo("Write your R scripts in the {ui_value('analyses/')} directory")
    ui_todo("Source your R scripts in the {ui_value('make.R')} file")
    ui_todo(paste0("Export your derived data in the ", 
                   "{ui_value('data/derived-data/')} directory"))
    ui_todo("Export your outputs in the {ui_value('outputs/')} directory")
    ui_todo("Export your figures in the {ui_value('figures/')} directory")
  }
  
  cli::cat_line()

  ui_todo("...and commit your changes!")
  
  invisible(NULL)
}
FRBCesab/rcompendium documentation built on Nov. 15, 2024, 9:38 p.m.