R/create_proj.R

In verasls/lvmisc: Veras Miscellaneous

#' Create a project
#'
#' Creates a project structure, including sub-directories, and initialization
#'   of a git repository.
#'
#' @param path A path to a directory that does not exist.
#' @param sub_dirs A character vector. If \code{sub_dirs = "default"}, it
#'   creates 'code/', 'data/', 'docs/', 'figures/' and 'tables/'
#'   sub-directories. Otherwise, it creates the sub-directories specified
#'   in the character vector.
#' @param use_git A logical value indicating whether or not to initialize a git
#'    repository. Defaults to \code{TRUE}.
#' @param use_gitignore A character vector. If \code{use_gitignore = "default"},
#'    it adds a .gitignore file with the files generated by your operating
#'    system and by R, as well as some common file extensions. The default
#'    .gitignore is as generated by
#'    \href{https://www.toptal.com/developers/gitignore}{gitignore.io}. To
#'    create a custom .gitignore, add the files to be ignored in a character
#'    vector. If you do not want to create a .gitignore file, set
#'    \code{use_gitignore = NULL}.
#' @param use_readme A logical value. If \code{TRUE} (default), adds an empty
#'    'README.md' file.
#'
#' @return Path to the newly created project, invisibly.
#'
#' @export
create_proj <- function(path,
                        sub_dirs = "default",
                        use_git = TRUE,
                        use_gitignore = "default",
                        use_readme = TRUE) {
  check_args_create_proj(
    path, sub_dirs, use_git, use_gitignore, use_readme
  )
  abort_package_not_installed(c("withr", "git2r", "usethis"))

  if (!grepl("/$", path)) {
    path <- paste0(path, "/")
  }
  if (dir.exists(path)) {
    usethis::ui_stop("{usethis::ui_path(path)} already exists")
  } else if (file.exists(substr(path, 1, nchar(path) - 1))) {
    usethis::ui_stop(
      "{usethis::ui_path(path)} already exists but is not a directory"
    )
  }
  dir.create(path)
  usethis::ui_done(
    "Creating project top-level directory {usethis::ui_path(path)}"
  )
  withr::local_dir(path)
  path <- getwd()

  if (!is.null(sub_dirs)) {
    if (sub_dirs == "default") {
     sub_dirs <- c("code/", "data/", "docs/", "figures/", "tables/")
   }
    purrr::walk(sub_dirs, create_sub_dir)
  }

  if (isTRUE(use_git)) {
    invisible(git2r::init(path))
    usethis::ui_done("Initialising a git repository")
  } else {
    use_gitignore <- NULL
  }

  if (!is.null(use_gitignore)) {
    write_gitignore(path, use_gitignore)
    usethis::ui_done("Adding a '.gitignore' file")
    if (use_gitignore == "default") {
      usethis::ui_info(
        "Default '.gitignore' for R and {get_os()} operating system"
      )
    }
  }

  if (isTRUE(use_readme)) {
    file.create("README.md")
    usethis::ui_done("Adding an empty 'README.md' file")
  }

  invisible(path)
}

create_sub_dir <- function(sub_dir) {
  sub_dir <- clean_sub_dir(sub_dir)
  dir.create(sub_dir)
  usethis::ui_done("Creating sub-directory '{sub_dir}'")
}

clean_sub_dir <- function(sub_dir) {
  if (!grepl("/", sub_dir)) {
    sub_dir <- paste0(sub_dir, "/")
  } else if (grepl("^/", sub_dir) & !grepl("/$", sub_dir)) {
    sub_dir <- paste0(substr(sub_dir, 2, nchar(sub_dir)), "/")
  } else if (!grepl("^/", sub_dir) & grepl("/$", sub_dir)) {
    sub_dir <- sub_dir
  } else if (grepl("^/", sub_dir) & grepl("/$", sub_dir)) {
    sub_dir <- substr(sub_dir, 2, nchar(sub_dir))
  }
  sub_dir
}

write_gitignore <- function(path, option) {
  gitignore_file <- paste0(path, "/.gitignore")

  if (option == "default") {
    sys_ignore <- get_sys_ignore()
    r_ignore <- get_r_ignore()
    file_extensions_ignore <- get_file_extensions_ignore()
    gitignore <- paste(
      sys_ignore, r_ignore, file_extensions_ignore,
      sep = "\r\r"
    )
  } else {
    gitignore <- paste(option, sep = "\r\r")
  }

  fileConn <- file(gitignore_file)
  writeLines(gitignore, fileConn)
  close(fileConn)
}

get_sys_ignore <- function() {
  os <- get_os()
  if (os == "macOS") {
    glue::glue(
      "### macOS ###
      # General
     .DS_Store
     .AppleDouble
     .LSOverride

     # Icon must end with two \r
     Icon


     # Thumbnails
     ._*

     # Files that might appear in the root of a volume
     .DocumentRevisions-V100
     .fseventsd
     .Spotlight-V100
     .TemporaryItems
     .Trashes
     .VolumeIcon.icns
     .com.apple.timemachine.donotpresent

     # Directories potentially created on remote AFP share
     .AppleDB
     .AppleDesktop
     Network Trash Folder
     Temporary Items
     .apdisk"
    )
  } else if (os == "Linux") {
    glue::glue(
      "### Linux ###
      *~

      # temporary files which can be created if a process still has a\\
        handle open of a deleted file
      .fuse_hidden*

      # KDE directory preferences
      .directory

      # Linux trash folder which might appear on any partition or disk
      .Trash-*

      # .nfs files are created when an open file is removed but is still\\
        being accessed
      .nfs*"
    )
  } else if (os == "Windows") {
    glue::glue(
      "### Windows ###
      # Windows thumbnail cache files
      Thumbs.db
      Thumbs.db:encryptable
      ehthumbs.db
      ehthumbs_vista.db

      # Dump file
      *.stackdump

      # Folder config file
      [Dd]esktop.ini

      # Recycle Bin used on file shares
      $RECYCLE.BIN/

      # Windows Installer files
      *.cab
      *.msi
      *.msix
      *.msm
      *.msp

      # Windows shortcuts
      *.lnk"
    )
  }
}

get_r_ignore <- function() {
  glue::glue(
    "### R ###
    # History files
    .Rhistory
    .Rapp.history

    # Session Data files
    .RData

    # User-specific files
    .Ruserdata

    # Example code in package build process
    *-Ex.R

    # Output files from R CMD build
    /*.tar.gz

    # Output files from R CMD check
    /*.Rcheck/

    # RStudio files
    .Rproj.user/

    # produced vignettes
    vignettes/*.html
    vignettes/*.pdf

    # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3
    .httr-oauth

    # knitr and R markdown default cache directories
    *_cache/
    /cache/

    # Temporary files created by R markdown
    *.utf8.md
    *.knit.md

    # R Environment Variables
    .Renviron

    ### R.Bookdown Stack ###
    # R package: bookdown caching files
    /*_files/"
  )
}

get_file_extensions_ignore <- function() {
  glue::glue(
    "# Common file extensions
    *.pdf
    *.jpeg
    *.tiff
    *.png
    *.doc
    *.docx
    *.ppt
    *.pptx"
  )
}

get_os <- function() {
  os <- Sys.info()["sysname"]
  if (os == "Darwin") {
    os <- "macOS"
  }
  os
}


check_args_create_proj <- function(path,
                                   sub_dirs,
                                   use_git,
                                   use_gitignore,
                                   use_readme) {
  if (!is.character(path)) {
    abort_argument_type(arg = "path", must = "be character", not = path)
  }
  if (!is.character(sub_dirs)) {
    abort_argument_type(arg = "sub_dirs", must = "be character", not = sub_dirs)
  }
  if (!is.logical(use_git)) {
    abort_argument_type(arg = "use_git", must = "be logical", not = use_git)
  }
  if (!is.character(use_gitignore) & !is.null(use_gitignore)) {
    abort_argument_type(
      arg = "use_gitignore", must = "be character", not = use_gitignore
    )
  }
  if (!is.logical(use_readme)) {
    abort_argument_type(
      arg = "use_readme", must = "be logical", not = use_readme
    )
  }
}