# Copyright 2017 Province of British Columbia
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and limitations under the License.
#' Create a bcgov R project directory structure
#'
#' Create a project directory structure for a new bcgov R project in your current working directory.
#'
#' @inheritParams use_bcgov_req
#'
#' @param path Path to the directory in which to initialize the project.
#' Default `"."` - your current working directory.
#' @param dir_struct Alternative project directory structure. This should be specified as
#' a character vector of directory (i.e. folders) and file paths, relative to the root of the project.
#' Directories should be identified by having a trailing forward-slash (e.g., \code{"dir/"}).
#'
#' The default is: \code{c("R/", "data/", "out/", "01_load.R", "02_clean.R", "03_analysis.R", "04_output.R", "run_all.R")}.
#'
#' This can also be set as an option \code{bcgovr.dir.struct}. You may want to set this in your
#' .Rprofile file so that every time you start a new project, your custom project structure is set up.
#' The line in your \code{.Rprofile} file would look something like this:
#' \code{options("bcgovr.dir.struct" = c("doc/", "data/", "results/", "src/01_load.R", "src/02_clean.R", "src/03_analysis.r", "src/04_output.R", "src/run_all.R"))}
#' @param rstudio If `TRUE`, calls [usethis::use_rstudio()] to make the new
#' project into an RStudio Project. If `FALSE`, a `.here` file is created so
#' that the directory can be recognized as a project by the `here` or `rprojroot` packages.
#' @param open If TRUE and in RStudio, the new project is opened in a new instance,
#' if possible, or is switched to, otherwise.
#'
#' @export
#'
#' @examples \dontrun{
#' bcgovr::create_bcgov_project()
#' }
create_bcgov_project <- function(path = ".", rmarkdown = FALSE,
licence = "apache2",
coc_email = get_coc_email(),
dir_struct = getOption("bcgovr.dir.struct", default = NULL),
rstudio = rstudioapi::isAvailable(),
open = TRUE) {
path_norm <- normalizePath(path, mustWork = FALSE)
# If calling this from a current project, reset it on exit
old_proj <- get_proj()
if (!is.null(old_proj) && path_norm != normalizePath(getwd())) {
on.exit(usethis::proj_set(old_proj), add = TRUE)
}
congrats("Setting up the ", basename(path_norm), " project")
create_proj(path = path, rstudio = rstudio)
## Add in bcgov repo requirements
use_bcgov_req(licence = licence, rmarkdown = rmarkdown, coc_email = coc_email)
default_str <- FALSE
# Catch the case when dir_struct == ""
dir_struct <- dir_struct[nzchar(dir_struct)]
## Need to check for analysis structure
if (is.null(dir_struct)) {
dir_struct <- c("out/", "data/", "01_load.R", "02_clean.R","03_analysis.R", "04_output.R", "run_all.R")
default_str <- TRUE
}
dirs <- file.path(path_norm, dir_struct[grepl("/$", dir_struct)])
files <- setdiff(file.path(path_norm, dir_struct), dirs)
filedirs <- dirname(files)
if (any(file.exists(files, dirs))) { ## file.exists is case-insensitive
stop("It looks as though you already have a project set up here!
If you want to add the required GitHub files, call use_bcgov_req()",
call. = FALSE)
}
## Add the necessary R files and directories
done("Creating new project")
done("Populating with directory structure")
lapply(c(dirs, filedirs), dir.create, recursive = TRUE, showWarnings = FALSE)
lapply(files, file.create)
# Insert appropriate licence header into source files
insert_licence_header <- switch(licence,
"apache2" = insert_bcgov_apache_header,
"cc-by" = insert_bcgov_cc_header)
lapply(files, insert_licence_header)
if (default_str) {
cat('source("01_load.R")\nsource("02_clean.R")\nsource("03_analysis.R")\nsource("04_output.R")\n',
file = file.path(path_norm, "run_all.R"))
}
if (open) open_project(path)
}
#' Create a bcgov R package directory structure
#'
#' Create a package directory structure for a new bcgov R package in your current working directory.
#'
#' @inheritParams create_bcgov_project
#' @param rmarkdown Should an Rmarkdown file be added to the repository
#' with its corresponding markdown file? Default \code{TRUE}.
#'
#' @inherit create_bcgov_project details
#'
#' @export
#'
#' @examples \dontrun{
#' bcgovr::create_bcgov_package()
#' }
create_bcgov_package <- function(path = ".", rmarkdown = TRUE,
coc_email = get_coc_email(),
rstudio = rstudioapi::isAvailable(),
open = TRUE) {
path_norm <- normalizePath(path, mustWork = FALSE)
package_name <- sub('.*\\/', '', basename(path_norm))
# If calling this from a current project, reset it on exit
old_proj <- get_proj()
if (!is.null(old_proj) && path_norm != normalizePath(getwd())) {
on.exit(usethis::proj_set(old_proj), add = TRUE)
}
congrats("Setting up the ", package_name, " package")
bcgovr_desc <- list("Package" = package_name,
"License" = "Apache License (== 2.0) | file LICENSE",
"Authors@R" = paste0('c(person("First", "Last", email = "first.last@example.com", role = c("aut", "cre")),
person("Province of British Columbia", role = "cph"))')
)
## Add in package setup files
usethis::create_package(path = path_norm, fields = bcgovr_desc,
rstudio = rstudio, open = FALSE)
usethis::proj_set(path_norm, force = TRUE)
## Add individual elements via usethis
usethis::use_template("NEWS.md", data = bcgovr_desc, open = FALSE)
usethis::use_roxygen_md()
usethis::use_vignette(name = package_name)
## Add in bcgov repo requirements
## A package will only ever need apache2 licence
use_bcgov_req(licence = "apache2", rmarkdown = rmarkdown, coc_email = coc_email)
if (open) open_project(path)
}
#' Create a local repository from a bcgov GitHub repository
#'
#' Creates a new local Git repository cloned from a bcgov GitHub repository
#'
#' @param repo bcgov GitHub repo name specified like this: \code{bcgov/reponame}
#' @param destdir The destination directory where the cloned project will be stored locally
#' @inheritParams use_bcgov_github
#' @param ... Other arguments passed on to [usethis::create_from_github()]
#'
#' @examples
#' \dontrun{
#' create_from_bcgov_github("bcgov/bcgovr")
#' }
#'
#' @export
create_from_bcgov_github <- function(repo,
destdir = ".",
protocol = "https",
...){
##TODO: Have a check that repo is two string separated by a /
## Only allow bcgov repos
if(!grepl("bcgov|bcgov-c",repo)){
stop("Not a bcgov repo")
}
base_reponame <- gsub("bcgov/|bcgov-c/", "", repo)
local_repo_path <- file.path(destdir, base_reponame)
if(!dir.exists(file.path(destdir))) dir.create(file.path(destdir))
## First try using git2r via usethis::create_from_github
## If that fails with two specific errors then check if Git is installed and use it directly
## via a system call
tryCatch(usethis::create_from_github(repo = repo, destdir = destdir, protocol = protocol),
error = function(e){
## Check if the repo even exists
if (grepl("404 Not Found", e$message)){
## Clean up files if repo wasn't found
unlink(base_reponame, recursive = TRUE)
stop(paste0(repo, " doesn't exist on GitHub. Consider using use_bcgov_github to create one"), call. = FALSE)
}
if (grepl("unknown certificate check failure|failed to start SSH session: Unable to exchange encryption keys", e$message)){
is_git_installed()
repo_clone_cmd <- paste0("git clone -q https://github.com/",repo, " ", local_repo_path)
done("Using system call to git")
system(repo_clone_cmd)
usethis::proj_set(local_repo_path, force = TRUE)
} else {
stop(e)
}
})
use_bcgov_req()
}
#' Get the path to the current project if it exists, otherwise return NULL
#' @noRd
get_proj <- function() {
if (usethis:::is_package() || usethis:::possibly_in_proj(".")) {
return(usethis::proj_get())
}
NULL
}
#' Create a project if one doesn't exist
#' @noRd
create_proj <- function(path = ".", rstudio) {
if (!(usethis:::is_package(path) || usethis:::possibly_in_proj(path))) {
usethis::create_project(path = path, open = FALSE, rstudio = rstudio)
}
usethis::proj_set(path, force = TRUE)
if (rstudio) usethis::use_rstudio()
invisible(TRUE)
}
#' Open a project if in RStudio
#' @noRd
open_project <- function(path) {
if (rstudioapi::isAvailable() && interactive()) {
rstudioapi::openProject(path, newSession = TRUE)
} else if (normalizePath(path) != getwd()) {
congrats("Your new project is created in ", path)
}
invisible(TRUE)
}
# Function to be executed on error, to clean up files that were created
# error_cleanup <- function(t) {
# info <- file.info(list.files(all.files = TRUE, include.dirs = TRUE, no.. = TRUE))
# del_files <- rownames(info[t < info$ctime, ])
# cat("Deleting generatedfiles:", del_files)
# unlink(del_files, recursive = TRUE, force = TRUE)
# }
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.