From 5f9699eb42fb56bef0b7a82a1cfa57bdff94e373 Mon Sep 17 00:00:00 2001 From: nevrome Date: Mon, 24 Jun 2019 23:16:48 +0200 Subject: [PATCH 01/12] separate files for core functions --- R/core_create_compendium.R | 23 ++ R/core_use_analysis.R | 69 +++++ R/core_use_circleci.R | 69 +++++ R/core_use_compendium.R | 132 ++++++++++ R/core_use_dockerfile.R | 58 +++++ R/core_use_readme_rmd.R | 63 +++++ R/core_use_travis.R | 79 ++++++ R/hello.R | 508 ------------------------------------- 8 files changed, 493 insertions(+), 508 deletions(-) create mode 100644 R/core_create_compendium.R create mode 100644 R/core_use_analysis.R create mode 100644 R/core_use_circleci.R create mode 100644 R/core_use_compendium.R create mode 100644 R/core_use_dockerfile.R create mode 100644 R/core_use_readme_rmd.R create mode 100644 R/core_use_travis.R diff --git a/R/core_create_compendium.R b/R/core_create_compendium.R new file mode 100644 index 0000000..4230ce9 --- /dev/null +++ b/R/core_create_compendium.R @@ -0,0 +1,23 @@ +#' @name create_compendium +#' @title Quickly create a basic research compendium by combining several rrtools functions into one. +#' +#' @description In one step, this will create an R package, attach the MIT license to it, add the rrtools' README to it, initiate a Git repository and make an initial commit to track files in the package, and create the 'analysis' directory structure, and populate it with an R Markdown file and bib file. This function will not create a GitHub repository for the compendium, a Dockerfile, a Travis config file, or any package tests. Those require some interaction outside of R and are left to the user. +#' +#' @param pkgname location to create new package. The last component of the path will be used as the package name +#' @param data_in_git should git track the files in the data directory? Default is TRUE +#' +#' @importFrom usethis use_mit_license use_git +#' @export + +create_compendium <- function(pkgname, data_in_git = TRUE){ + rrtools::use_compendium(pkgname) + # move us into the new project + setwd(pkgname) + my_name <- usethis::use_git_config()$`user.name` + usethis::use_mit_license(name = my_name) + rrtools::use_readme_rmd() + rrtools::use_git_quietly() + rrtools::use_analysis(data_in_git = data_in_git) + devtools::install(quiet = TRUE) + +} diff --git a/R/core_use_analysis.R b/R/core_use_analysis.R new file mode 100644 index 0000000..ca81834 --- /dev/null +++ b/R/core_use_analysis.R @@ -0,0 +1,69 @@ +#' @name use_analysis +#' @aliases add_analysis +#' @title Adds an analysis directory (and sub-directories), and an Rmd file ready to write +#' +#' @description This will create \file{paper.Rmd}, \file{references.bib} +#' and several others, and add \pkg{bookdown} to the imported packages listed in the DESCRIPTION file. +#' +#' @param pkg defaults to the package in the current working directory +#' @param template the template file to use to create the main analysis document. Defaults to 'paper.Rmd', ready to write R Markdown and knit to MS Word using bookdown +#' @param location the location where the directories and files will be written to. Defaults to a top-level 'analysis' directory. Other options are 'inst' (for the inst/ directory, so that all the contents will be included in the installed package) and 'vignettes' (as in a regular package vignette, all contents will be included in the installed package). +#' @param data forwarded to \code{whisker::whisker.render} +#' @param data_in_git should git track the files in the data directory? +#' @export +use_analysis <- function(pkg = ".", location = "top_level", template = 'paper.Rmd', data = list(), data_in_git = TRUE) { + pkg <- as.package(pkg) + pkg$Rmd <- TRUE + gh <- github_info(pkg$path) + + usethis::ui_done("Adding bookdown to Imports\n") + add_desc_package(pkg, "Imports", "bookdown") + + location <- ifelse(location == "top_level", "analysis", + ifelse(location == "vignettes", "vignettes", + ifelse(location == "inst", "inst", + stop("invalid 'location' argument")))) + + # create file structure... + create_directories(location, pkg) + + # add template files for paper.Rmd, .bib, etc. ... + switch( + location, + vignettes = use_vignette_rmd(location, + pkg, + gh, + template), + analysis = {use_paper_rmd(pkg, + location = file.path(location, "paper"), + gh, + template); + use_build_ignore("analysis", + escape = FALSE, + pkg = pkg) + }, + inst = use_paper_rmd(pkg, + location = file.path(location, "paper"), + gh, + template) + ) + + if (!data_in_git) use_git_ignore("*/data/*") + + cat(crayon::bold("\nNext, you need to: "), rep(crayon::green(clisymbols::symbol$arrow_down),4), "\n") + usethis::ui_todo("Write your article/report/thesis, start at the paper.Rmd file") + usethis::ui_todo("Add the citation style library file (csl) to replace the default provided here, see {crayon::bgBlue('https://github.com/citation-style-language/')}") + usethis::ui_todo("Add bibliographic details of cited items to the {usethis::ui_value('references.bib')} file") + usethis::ui_todo("For adding captions & cross-referencing in an Rmd, see {crayon::bgBlue('https://bookdown.org/yihui/bookdown/')}") + usethis::ui_todo("For adding citations & reference lists in an Rmd, see {crayon::bgBlue('http://rmarkdown.rstudio.com/authoring_bibliographies_and_citations.html')}") + + # message about whether data files are tracked by Git: + cat(crayon::bold("\nNote that:\n")) + if(!data_in_git) {cat(paste0(warning_bullet(), " Your data files ", crayon::red("are not"), " tracked by Git and ", crayon::red("will not"), " be pushed to GitHub \n")) + } else { + cat(paste0(warning_bullet(), " Your data files ", crayon::green("are"), " tracked by Git and ", crayon::green("will"), " be pushed to GitHub \n")) + } + + +invisible(TRUE) +} diff --git a/R/core_use_circleci.R b/R/core_use_circleci.R new file mode 100644 index 0000000..684d709 --- /dev/null +++ b/R/core_use_circleci.R @@ -0,0 +1,69 @@ +#' @name use_circleci +#' @aliases use_circleci +#' @title Add a circleci config file +#' +#' @description This will build the Docker container on the Circle-CI service. +#' The advantage of Circle-CI over Travis is that Circle-CI will freely work with +#' private GitHub repositories. Only the paid service from Travis will work +#' with private GitHub repositories. Before using this function you need +#' to create an account with Circle-CI, using your GitHub account. If you want +#' Circle-CI to run on a private GitHub repo, make sure you give Circle-CI +#' access to 'all repos' when you log in with your GitHub credentials. +#' +#' @param pkg defaults to the package in the current working directory +#' @param browse open a browser window to enable Circle-CI builds for the package automatically +#' @param docker_hub should circleci push to Docker Hub after a successful build? +#' +#' @importFrom curl has_internet +#' @importFrom utils browseURL +#' @export +use_circleci <- function(pkg = ".", browse = interactive(), docker_hub = TRUE) { + pkg <- as.package(pkg) + + gh <- github_info(pkg$path) + circleci_url <- file.path("https://circleci.com/gh/", gh$username) + + if(docker_hub){ + + use_template("circle.yml-with-docker-hub", + "circle.yml", + ignore = TRUE, + pkg = pkg, + data = gh, + out_path = "") + + } else { + + use_template("circle.yml-without-docker-hub", + "circle.yml", + ignore = TRUE, + pkg = pkg, + data = gh, + out_path = "") + + } + + + message("Next: \n", + " * Add a circleci shield to your README.Rmd:\n", + "[![Circle-CI Build Status]", + "(https://circleci.com/gh/", gh$fullname, ".svg?style=shield&circle-token=:circle-token)]", + "(https://circleci.com/gh/", gh$fullname, ")\n", + " * Turn on circleci for your repo at ", circleci_url, "\n", + " and add your environment variables: DOCKER_EMAIL, ", "\n", + " DOCKER_USER, DOCKER_PASS.", "\n", + ifelse(docker_hub, + paste0(" * Your Docker container will be pushed to the Docker Hub", "\n", + " if the build completes successfully", "\n" ), + paste0(" * Your Docker container will be kept private and NOT be pushed to the Docker Hub", "\n" ))) + + if (browse) { + if(curl::has_internet()) { + utils::browseURL(circleci_url) + } else { + message("No internet connection. Can't open ", circleci_url) + } + } + + invisible(TRUE) +} diff --git a/R/core_use_compendium.R b/R/core_use_compendium.R new file mode 100644 index 0000000..b049749 --- /dev/null +++ b/R/core_use_compendium.R @@ -0,0 +1,132 @@ +#' @name use_compendium +#' @title Creates an R package suitable to use as a research compendium, and +#' switches to the working directory of this new package, ready to work +#' +#' @description This is usethis::create_package() with some additional messages to simplify the transition into the new project setting +#' +#' @param path location to create new package. The last component of the path will be used as the package name +#' @param fields list of description values to override default values or add additional values +#' @param rstudio create an RStudio project file? (with \code{usethis::use_rstudio}) +#' @param open if TRUE and in RStudio, the new project is opened in a new instance. If TRUE and not in RStudio, the working directory is set to the new project +#' @param quiet if FALSE, the default, prints informative messages +#' +#' @importFrom usethis create_package +#' @importFrom rstudioapi isAvailable +#' @export + +use_compendium <- function( + path, + fields = getOption("usethis.description"), + rstudio = rstudioapi::isAvailable(), + open = interactive(), + quiet = FALSE +){ + + # seems that use_description creates a different description for OSX and Linux, so we force all to have ByteCompile + options( + usethis.description = list( + Version = "0.0.0.9000", + Title = "What the Package Does (One Line, Title Case)", + Description = "What the package does (one paragraph)", + `Authors@R` = 'person("First", "Last", , "first.last@example.com", c("aut", "cre"))', + License = "What license it uses", + Encoding = "UTF-8", + LazyData = "true", + ByteCompile = "true" + ) + ) + + # everything in an unevaluated expression to suppress cat() output and messages + create_the_package <- expression({ + + name <- basename(path) + + # from googledrive (!) + stop_glue <- function(..., .sep = "", .envir = parent.frame(), + call. = FALSE, .domain = NULL) { + stop( + glue::glue(..., .sep = .sep, .envir = .envir), + call. = call., domain = .domain + ) + } + + # from usethis + value <- function(...) { + x <- paste0(...) + crayon::blue(encodeString(x, quote = "'")) + } + + # from usethis + valid_name <- function(x){ + grepl("^[[:alpha:]][[:alnum:].]+$", x) && !grepl("\\.$", x) + } + + # from usethis, modified + check_package_name <- function(name) { + if (!valid_name(name)) { + stop_glue( + "{value(name)} is not a valid package name. It should:\n", + "* Contain only ASCII letters, numbers, and '.'\n", + "* Have at least two characters\n", + "* Start with a letter\n", + "* Not end with '.'\n" + ) + } + + } + + check_package_name(name) + + # welcome message in new repo at first start + if (rstudio & open & !quiet) { + dir.create(path) + fileConn <- file(file.path(path, ".Rprofile")) + writeLines( + c( + "cat(crayon::bold('\nThis project was set up by rrtools.'))", + "cat('\nYou can start working now or apply some more basic configuration.\n')", + "cat('Check out ')", + "cat(crayon::underline('https://github.com/benmarwick/rrtools'))", + "cat(' for an explanation of all the project configuration functions of rrtools.\n')", + "cat('Or run the rrtools configuration addin: ')", + "cat(crayon::cyan('rrtools.addin::rrtools_assistant() '))", + "cat(crayon::underline('https://github.com/nevrome/rrtools.addin\n\n'))", + "invisible(file.remove('.Rprofile'))" + ), + fileConn + ) + close(fileConn) + } + + # create new package + usethis::create_package( + path = path, + fields = fields, + rstudio = rstudio, + open = open + ) + + + usethis::ui_done("The package {name} has been created") + + if (rstudio & open) { + usethis::ui_done("Opening the new compendium in a new RStudio session...") + } else { + usethis::ui_done("Now opening the new compendium...") + usethis::ui_done("Done. The working directory is currently {getwd()}") + } + + cat(crayon::bold("\nNext, you need to: "), rep(crayon::green(clisymbols::symbol$arrow_down),3), "\n") + usethis::ui_todo("Edit the DESCRIPTION file") + usethis::ui_todo("Use other 'rrtools' functions to add components to the compendium\n") + + + }) + + if (quiet) { + quietly(suppressMessages(capture.output(eval(create_the_package), file = NULL))) + } else { + eval(create_the_package) + } + +} diff --git a/R/core_use_dockerfile.R b/R/core_use_dockerfile.R new file mode 100644 index 0000000..f1f83b6 --- /dev/null +++ b/R/core_use_dockerfile.R @@ -0,0 +1,58 @@ +#' @name use_dockerfile +#' @title Add a Dockerfile +#' +#' @description This will create a basic \file{Dockerfile} based on rocker/verse +#' +#' @param pkg defaults to the package in the current working directory +#' @param rocker chr, the rocker image to base this container on +#' @param rmd_to_knit, chr, path to the Rmd file to render in the Docker +#' container, relative to the top level of the compendium +#' (i.e. "analysis/paper/paper.Rmd"). There's no need to specify this if your Rmd +#' to render is at "analysis/paper/paper.Rmd", "vignettes/paper/paper.Rmd" or +#' "inst/paper/paper.Rmd". If you have a custom directory structure, and a custom +#' file name for the Rmd file, you can specify that file path and name here so +#' Docker can find the file to render in the container.B +#' +#' @import utils +#' @export + + use_dockerfile <- function(pkg = ".", rocker = "verse", rmd_to_knit = "path_to_rmd") { + pkg <- as.package(pkg) + + # get R version for rocker/r-ver + si <- utils::sessionInfo() + r_version <- paste0(si$R.version$major, ".", si$R.version$minor) + + # get path to Rmd file to knit + if(rmd_to_knit == "path_to_rmd"){ + dir_list <- list.dirs() + paper_dir <- dir_list[grep(pattern = "/paper", dir_list)] + rmd_path <- regmatches(paper_dir, regexpr("analysis|vignettes|inst", paper_dir)) + rmd_path <- file.path(rmd_path, "paper/paper.Rmd") + } else { + # preempt the string with home directory notation or back-slash (thx Matt Harris) + rmd_path <- gsub("^.|^/|^./|^~/","",rmd_to_knit) + } + + + # assign variables for whisker + gh <- github_info(pkg$path) + gh$r_version <- r_version + gh$rocker <- rocker + gh$rmd_path <- rmd_path + + use_template("Dockerfile", + "Dockerfile", + ignore = TRUE, + pkg = pkg, + data = gh, + open = TRUE, + out_path = "") + + message("Next: \n", + " * Edit the dockerfile with your name & email", "\n", + " * Edit the dockerfile to include system dependencies, such as linux libraries that are needed by the R packages you're using", "\n", + " * Check the last line of the dockerfile to specify which Rmd should be rendered in the Docker container, edit if necessary", "\n" ) + + invisible(TRUE) +} diff --git a/R/core_use_readme_rmd.R b/R/core_use_readme_rmd.R new file mode 100644 index 0000000..ed7585d --- /dev/null +++ b/R/core_use_readme_rmd.R @@ -0,0 +1,63 @@ +#' Creates skeleton README files +#' +#' @description +#' \code{README.Rmd} will be automatically +#' added to \code{.Rbuildignore}. The resulting README is populated with default +#' YAML frontmatter and R fenced code chunks (\code{Rmd}). +#' Your readme should contain: +#' \itemize{ +#' \item a high-level description of the package and its goals +#' \item R code to install from GitHub, if GitHub usage detected +#' \item a basic example +#' } +#' +#' @param pkg package description, can be path or package name. See +#' \code{\link{as.package}} for more information +#' @param render_readme should the README.Rmd be directly rendered to +#' a github markdown document? default: TRUE +#' @importFrom rmarkdown render +#' @export +#' @examples +#' \dontrun{ +#' use_readme_rmd() +#' } +#' @family infrastructure +use_readme_rmd <- function(pkg = ".", render_readme = TRUE) { + pkg <- as.package(pkg) + + if (uses_github(pkg$path)) { + pkg$github <- github_info(pkg$path) + } + pkg$Rmd <- TRUE + + + use_template("omni-README", + save_as = "README.Rmd", + data = pkg, + ignore = TRUE, + open = TRUE, + pkg = pkg, + out_path = "") + + use_build_ignore("^README-.*\\.png$", escape = FALSE, pkg = pkg) + + if (uses_git(pkg$path) && !file.exists(pkg$path, ".git", "hooks", "pre-commit")) { + message("* Adding pre-commit hook") + use_git_hook("pre-commit", render_template("readme-rmd-pre-commit.sh"), + pkg = pkg) + } + + if (render_readme) { + usethis::ui_done("\nRendering README.Rmd to README.md for GitHub.") + rmarkdown::render("README.Rmd", quiet = TRUE) + unlink("README.html") + } + + usethis::ui_done("Adding code of conduct.") + use_code_of_conduct(pkg) + + usethis::ui_done("Adding instructions to contributors.") + use_contributing(pkg) + + invisible(TRUE) +} diff --git a/R/core_use_travis.R b/R/core_use_travis.R new file mode 100644 index 0000000..e918fb0 --- /dev/null +++ b/R/core_use_travis.R @@ -0,0 +1,79 @@ +#' @name use_travis +#' @aliases add_travis +#' @title Add a travis config file +#' +#' @description This has two options. One is the same as `usethis::use_travis`, a vanilla travis config that builds, installs and runs the custom package on travis. The other type of configuration directs travis to build the Docker container (according to the instructions in your Dockerfile) and push the successful result to Docker Hub. Using a Dockerfile is recommended because it gives greater isolation of the computational enviroment, and will result in much faster build times on travis. +#' +#' @param pkg defaults to the package in the current working directory +#' @param browse open a browser window to enable Travis builds for the package automatically +#' @param docker logical, if TRUE (the default) the travis config will build a Docker container according to the instructions in the Dockerfile, and build and install the package in that container. If FALSE, the standard config for R on travis is used. +#' @param rmd_to_knit path to .Rmd file that should be knitted by the virtual build environment: default is "path_to_rmd" which causes the function to search for a paper.Rmd file by itself. +#' @param ask should the function ask with \code{yesno()} if an old .travis.yml should be overwritten with a new one? default: TRUE +#' +#' @importFrom curl has_internet +#' @importFrom utils browseURL +#' @export +use_travis <- function( + pkg = ".", + browse = interactive(), + docker = TRUE, + rmd_to_knit = "path_to_rmd", + ask = TRUE +) { + pkg <- as.package(pkg) + + # get path to Rmd file to knit + if(rmd_to_knit == "path_to_rmd"){ + dir_list <- list.dirs() + paper_dir <- dir_list[grep(pattern = "/paper", dir_list)] + rmd_path <- regmatches(paper_dir, regexpr("analysis|vignettes|inst", paper_dir)) + rmd_path <- file.path(rmd_path, "paper/paper.Rmd") + } else { + # preempt the string with home directory notation or back-slash (thx Matt Harris) + rmd_path <- gsub("^.|^/|^./|^~/","",rmd_to_knit) + } + + gh <- github_info(pkg$path) + gh$rmd_path <- rmd_path + travis_url <- file.path("https://travis-ci.org", gh$fullname) + + if(docker){ + use_template("travis.yml-with-docker", + ".travis.yml", + ignore = TRUE, + pkg = pkg, + data = gh, + out_path = "", + ask = ask) + } else { + gh$date <- format(Sys.Date(), "%Y-%m-%d") + use_template("travis.yml-no-docker", + ".travis.yml", + ignore = TRUE, + pkg = pkg, + data = gh, + out_path = "", + ask = ask) + } + + message("Next: \n", + " * Add a travis shield to your README.Rmd:\n", + "[![Travis-CI Build Status]", + "(https://travis-ci.org/", gh$fullname, ".svg?branch=master)]", + "(https://travis-ci.org/", gh$fullname, ")\n", + " * Turn on travis for your repo at ", travis_url, "\n", + ifelse(docker, + " * To connect Docker, go to https://travis-ci.org/, and add your environment variables: DOCKER_EMAIL, DOCKER_USER, DOCKER_PASS to enable pushing to the Docker Hub", + "") + ) + + if (browse) { + if(curl::has_internet()) { + utils::browseURL(travis_url) + } else { + message("No internet connection. Can't open https://travis-ci.org.") + } + } + + invisible(TRUE) +} diff --git a/R/hello.R b/R/hello.R index edceeca..2916e84 100644 --- a/R/hello.R +++ b/R/hello.R @@ -1,511 +1,3 @@ - -#' @name create_compendium -#' @title Quickly create a basic research compendium by combining several rrtools functions into one. -#' -#' @description In one step, this will create an R package, attach the MIT license to it, add the rrtools' README to it, initiate a Git repository and make an initial commit to track files in the package, and create the 'analysis' directory structure, and populate it with an R Markdown file and bib file. This function will not create a GitHub repository for the compendium, a Dockerfile, a Travis config file, or any package tests. Those require some interaction outside of R and are left to the user. -#' -#' @param pkgname location to create new package. The last component of the path will be used as the package name -#' @param data_in_git should git track the files in the data directory? Default is TRUE -#' -#' @importFrom usethis use_mit_license use_git -#' @export - -create_compendium <- function(pkgname, data_in_git = TRUE){ - rrtools::use_compendium(pkgname) - # move us into the new project - setwd(pkgname) - my_name <- usethis::use_git_config()$`user.name` - usethis::use_mit_license(name = my_name) - rrtools::use_readme_rmd() - rrtools::use_git_quietly() - rrtools::use_analysis(data_in_git = data_in_git) - devtools::install(quiet = TRUE) - -} - - - -#' @name use_compendium -#' @title Creates an R package suitable to use as a research compendium, and -#' switches to the working directory of this new package, ready to work -#' -#' @description This is usethis::create_package() with some additional messages to simplify the transition into the new project setting -#' -#' @param path location to create new package. The last component of the path will be used as the package name -#' @param fields list of description values to override default values or add additional values -#' @param rstudio create an RStudio project file? (with \code{usethis::use_rstudio}) -#' @param open if TRUE and in RStudio, the new project is opened in a new instance. If TRUE and not in RStudio, the working directory is set to the new project -#' @param quiet if FALSE, the default, prints informative messages -#' -#' @importFrom usethis create_package -#' @importFrom rstudioapi isAvailable -#' @export - -use_compendium <- function( - path, - fields = getOption("usethis.description"), - rstudio = rstudioapi::isAvailable(), - open = interactive(), - quiet = FALSE -){ - - # seems that use_description creates a different description for OSX and Linux, so we force all to have ByteCompile - options( - usethis.description = list( - Version = "0.0.0.9000", - Title = "What the Package Does (One Line, Title Case)", - Description = "What the package does (one paragraph)", - `Authors@R` = 'person("First", "Last", , "first.last@example.com", c("aut", "cre"))', - License = "What license it uses", - Encoding = "UTF-8", - LazyData = "true", - ByteCompile = "true" - ) - ) - - # everything in an unevaluated expression to suppress cat() output and messages - create_the_package <- expression({ - - name <- basename(path) - - # from googledrive (!) - stop_glue <- function(..., .sep = "", .envir = parent.frame(), - call. = FALSE, .domain = NULL) { - stop( - glue::glue(..., .sep = .sep, .envir = .envir), - call. = call., domain = .domain - ) - } - - # from usethis - value <- function(...) { - x <- paste0(...) - crayon::blue(encodeString(x, quote = "'")) - } - - # from usethis - valid_name <- function(x){ - grepl("^[[:alpha:]][[:alnum:].]+$", x) && !grepl("\\.$", x) - } - - # from usethis, modified - check_package_name <- function(name) { - if (!valid_name(name)) { - stop_glue( - "{value(name)} is not a valid package name. It should:\n", - "* Contain only ASCII letters, numbers, and '.'\n", - "* Have at least two characters\n", - "* Start with a letter\n", - "* Not end with '.'\n" - ) - } - - } - - check_package_name(name) - - # welcome message in new repo at first start - if (rstudio & open & !quiet) { - dir.create(path) - fileConn <- file(file.path(path, ".Rprofile")) - writeLines( - c( - "cat(crayon::bold('\nThis project was set up by rrtools.'))", - "cat('\nYou can start working now or apply some more basic configuration.\n')", - "cat('Check out ')", - "cat(crayon::underline('https://github.com/benmarwick/rrtools'))", - "cat(' for an explanation of all the project configuration functions of rrtools.\n')", - "cat('Or run the rrtools configuration addin: ')", - "cat(crayon::cyan('rrtools.addin::rrtools_assistant() '))", - "cat(crayon::underline('https://github.com/nevrome/rrtools.addin\n\n'))", - "invisible(file.remove('.Rprofile'))" - ), - fileConn - ) - close(fileConn) - } - - # create new package - usethis::create_package( - path = path, - fields = fields, - rstudio = rstudio, - open = open - ) - - - usethis::ui_done("The package {name} has been created") - - if (rstudio & open) { - usethis::ui_done("Opening the new compendium in a new RStudio session...") - } else { - usethis::ui_done("Now opening the new compendium...") - usethis::ui_done("Done. The working directory is currently {getwd()}") - } - - cat(crayon::bold("\nNext, you need to: "), rep(crayon::green(clisymbols::symbol$arrow_down),3), "\n") - usethis::ui_todo("Edit the DESCRIPTION file") - usethis::ui_todo("Use other 'rrtools' functions to add components to the compendium\n") - - - }) - - if (quiet) { - quietly(suppressMessages(capture.output(eval(create_the_package), file = NULL))) - } else { - eval(create_the_package) - } - -} - - - -#' @name use_travis -#' @aliases add_travis -#' @title Add a travis config file -#' -#' @description This has two options. One is the same as `usethis::use_travis`, a vanilla travis config that builds, installs and runs the custom package on travis. The other type of configuration directs travis to build the Docker container (according to the instructions in your Dockerfile) and push the successful result to Docker Hub. Using a Dockerfile is recommended because it gives greater isolation of the computational enviroment, and will result in much faster build times on travis. -#' -#' @param pkg defaults to the package in the current working directory -#' @param browse open a browser window to enable Travis builds for the package automatically -#' @param docker logical, if TRUE (the default) the travis config will build a Docker container according to the instructions in the Dockerfile, and build and install the package in that container. If FALSE, the standard config for R on travis is used. -#' @param rmd_to_knit path to .Rmd file that should be knitted by the virtual build environment: default is "path_to_rmd" which causes the function to search for a paper.Rmd file by itself. -#' @param ask should the function ask with \code{yesno()} if an old .travis.yml should be overwritten with a new one? default: TRUE -#' -#' @importFrom curl has_internet -#' @importFrom utils browseURL -#' @export -use_travis <- function( - pkg = ".", - browse = interactive(), - docker = TRUE, - rmd_to_knit = "path_to_rmd", - ask = TRUE -) { - pkg <- as.package(pkg) - - # get path to Rmd file to knit - if(rmd_to_knit == "path_to_rmd"){ - dir_list <- list.dirs() - paper_dir <- dir_list[grep(pattern = "/paper", dir_list)] - rmd_path <- regmatches(paper_dir, regexpr("analysis|vignettes|inst", paper_dir)) - rmd_path <- file.path(rmd_path, "paper/paper.Rmd") - } else { - # preempt the string with home directory notation or back-slash (thx Matt Harris) - rmd_path <- gsub("^.|^/|^./|^~/","",rmd_to_knit) - } - - gh <- github_info(pkg$path) - gh$rmd_path <- rmd_path - travis_url <- file.path("https://travis-ci.org", gh$fullname) - - if(docker){ - use_template("travis.yml-with-docker", - ".travis.yml", - ignore = TRUE, - pkg = pkg, - data = gh, - out_path = "", - ask = ask) - } else { - gh$date <- format(Sys.Date(), "%Y-%m-%d") - use_template("travis.yml-no-docker", - ".travis.yml", - ignore = TRUE, - pkg = pkg, - data = gh, - out_path = "", - ask = ask) - } - - message("Next: \n", - " * Add a travis shield to your README.Rmd:\n", - "[![Travis-CI Build Status]", - "(https://travis-ci.org/", gh$fullname, ".svg?branch=master)]", - "(https://travis-ci.org/", gh$fullname, ")\n", - " * Turn on travis for your repo at ", travis_url, "\n", - ifelse(docker, - " * To connect Docker, go to https://travis-ci.org/, and add your environment variables: DOCKER_EMAIL, DOCKER_USER, DOCKER_PASS to enable pushing to the Docker Hub", - "") - ) - - if (browse) { - if(curl::has_internet()) { - utils::browseURL(travis_url) - } else { - message("No internet connection. Can't open https://travis-ci.org.") - } - } - - invisible(TRUE) -} - - -#' @name use_circleci -#' @aliases use_circleci -#' @title Add a circleci config file -#' -#' @description This will build the Docker container on the Circle-CI service. -#' The advantage of Circle-CI over Travis is that Circle-CI will freely work with -#' private GitHub repositories. Only the paid service from Travis will work -#' with private GitHub repositories. Before using this function you need -#' to create an account with Circle-CI, using your GitHub account. If you want -#' Circle-CI to run on a private GitHub repo, make sure you give Circle-CI -#' access to 'all repos' when you log in with your GitHub credentials. -#' -#' @param pkg defaults to the package in the current working directory -#' @param browse open a browser window to enable Circle-CI builds for the package automatically -#' @param docker_hub should circleci push to Docker Hub after a successful build? -#' -#' @importFrom curl has_internet -#' @importFrom utils browseURL -#' @export -use_circleci <- function(pkg = ".", browse = interactive(), docker_hub = TRUE) { - pkg <- as.package(pkg) - - gh <- github_info(pkg$path) - circleci_url <- file.path("https://circleci.com/gh/", gh$username) - - if(docker_hub){ - - use_template("circle.yml-with-docker-hub", - "circle.yml", - ignore = TRUE, - pkg = pkg, - data = gh, - out_path = "") - - } else { - - use_template("circle.yml-without-docker-hub", - "circle.yml", - ignore = TRUE, - pkg = pkg, - data = gh, - out_path = "") - - } - - - message("Next: \n", - " * Add a circleci shield to your README.Rmd:\n", - "[![Circle-CI Build Status]", - "(https://circleci.com/gh/", gh$fullname, ".svg?style=shield&circle-token=:circle-token)]", - "(https://circleci.com/gh/", gh$fullname, ")\n", - " * Turn on circleci for your repo at ", circleci_url, "\n", - " and add your environment variables: DOCKER_EMAIL, ", "\n", - " DOCKER_USER, DOCKER_PASS.", "\n", - ifelse(docker_hub, - paste0(" * Your Docker container will be pushed to the Docker Hub", "\n", - " if the build completes successfully", "\n" ), - paste0(" * Your Docker container will be kept private and NOT be pushed to the Docker Hub", "\n" ))) - - if (browse) { - if(curl::has_internet()) { - utils::browseURL(circleci_url) - } else { - message("No internet connection. Can't open ", circleci_url) - } - } - - invisible(TRUE) -} - - - - -#' @name use_analysis -#' @aliases add_analysis -#' @title Adds an analysis directory (and sub-directories), and an Rmd file ready to write -#' -#' @description This will create \file{paper.Rmd}, \file{references.bib} -#' and several others, and add \pkg{bookdown} to the imported packages listed in the DESCRIPTION file. -#' -#' @param pkg defaults to the package in the current working directory -#' @param template the template file to use to create the main analysis document. Defaults to 'paper.Rmd', ready to write R Markdown and knit to MS Word using bookdown -#' @param location the location where the directories and files will be written to. Defaults to a top-level 'analysis' directory. Other options are 'inst' (for the inst/ directory, so that all the contents will be included in the installed package) and 'vignettes' (as in a regular package vignette, all contents will be included in the installed package). -#' @param data forwarded to \code{whisker::whisker.render} -#' @param data_in_git should git track the files in the data directory? -#' @export -use_analysis <- function(pkg = ".", location = "top_level", template = 'paper.Rmd', data = list(), data_in_git = TRUE) { - pkg <- as.package(pkg) - pkg$Rmd <- TRUE - gh <- github_info(pkg$path) - - usethis::ui_done("Adding bookdown to Imports\n") - add_desc_package(pkg, "Imports", "bookdown") - - location <- ifelse(location == "top_level", "analysis", - ifelse(location == "vignettes", "vignettes", - ifelse(location == "inst", "inst", - stop("invalid 'location' argument")))) - - # create file structure... - create_directories(location, pkg) - - # add template files for paper.Rmd, .bib, etc. ... - switch( - location, - vignettes = use_vignette_rmd(location, - pkg, - gh, - template), - analysis = {use_paper_rmd(pkg, - location = file.path(location, "paper"), - gh, - template); - use_build_ignore("analysis", - escape = FALSE, - pkg = pkg) - }, - inst = use_paper_rmd(pkg, - location = file.path(location, "paper"), - gh, - template) - ) - - if (!data_in_git) use_git_ignore("*/data/*") - - cat(crayon::bold("\nNext, you need to: "), rep(crayon::green(clisymbols::symbol$arrow_down),4), "\n") - usethis::ui_todo("Write your article/report/thesis, start at the paper.Rmd file") - usethis::ui_todo("Add the citation style library file (csl) to replace the default provided here, see {crayon::bgBlue('https://github.com/citation-style-language/')}") - usethis::ui_todo("Add bibliographic details of cited items to the {usethis::ui_value('references.bib')} file") - usethis::ui_todo("For adding captions & cross-referencing in an Rmd, see {crayon::bgBlue('https://bookdown.org/yihui/bookdown/')}") - usethis::ui_todo("For adding citations & reference lists in an Rmd, see {crayon::bgBlue('http://rmarkdown.rstudio.com/authoring_bibliographies_and_citations.html')}") - - # message about whether data files are tracked by Git: - cat(crayon::bold("\nNote that:\n")) - if(!data_in_git) {cat(paste0(warning_bullet(), " Your data files ", crayon::red("are not"), " tracked by Git and ", crayon::red("will not"), " be pushed to GitHub \n")) - } else { - cat(paste0(warning_bullet(), " Your data files ", crayon::green("are"), " tracked by Git and ", crayon::green("will"), " be pushed to GitHub \n")) - } - - -invisible(TRUE) -} - -#' @name use_dockerfile -#' @title Add a Dockerfile -#' -#' @description This will create a basic \file{Dockerfile} based on rocker/verse -#' -#' @param pkg defaults to the package in the current working directory -#' @param rocker chr, the rocker image to base this container on -#' @param rmd_to_knit, chr, path to the Rmd file to render in the Docker -#' container, relative to the top level of the compendium -#' (i.e. "analysis/paper/paper.Rmd"). There's no need to specify this if your Rmd -#' to render is at "analysis/paper/paper.Rmd", "vignettes/paper/paper.Rmd" or -#' "inst/paper/paper.Rmd". If you have a custom directory structure, and a custom -#' file name for the Rmd file, you can specify that file path and name here so -#' Docker can find the file to render in the container.B -#' -#' @import utils -#' @export - - use_dockerfile <- function(pkg = ".", rocker = "verse", rmd_to_knit = "path_to_rmd") { - pkg <- as.package(pkg) - - # get R version for rocker/r-ver - si <- utils::sessionInfo() - r_version <- paste0(si$R.version$major, ".", si$R.version$minor) - - # get path to Rmd file to knit - if(rmd_to_knit == "path_to_rmd"){ - dir_list <- list.dirs() - paper_dir <- dir_list[grep(pattern = "/paper", dir_list)] - rmd_path <- regmatches(paper_dir, regexpr("analysis|vignettes|inst", paper_dir)) - rmd_path <- file.path(rmd_path, "paper/paper.Rmd") - } else { - # preempt the string with home directory notation or back-slash (thx Matt Harris) - rmd_path <- gsub("^.|^/|^./|^~/","",rmd_to_knit) - } - - - # assign variables for whisker - gh <- github_info(pkg$path) - gh$r_version <- r_version - gh$rocker <- rocker - gh$rmd_path <- rmd_path - - use_template("Dockerfile", - "Dockerfile", - ignore = TRUE, - pkg = pkg, - data = gh, - open = TRUE, - out_path = "") - - message("Next: \n", - " * Edit the dockerfile with your name & email", "\n", - " * Edit the dockerfile to include system dependencies, such as linux libraries that are needed by the R packages you're using", "\n", - " * Check the last line of the dockerfile to specify which Rmd should be rendered in the Docker container, edit if necessary", "\n" ) - - invisible(TRUE) -} -#' Creates skeleton README files -#' -#' @description -#' \code{README.Rmd} will be automatically -#' added to \code{.Rbuildignore}. The resulting README is populated with default -#' YAML frontmatter and R fenced code chunks (\code{Rmd}). -#' Your readme should contain: -#' \itemize{ -#' \item a high-level description of the package and its goals -#' \item R code to install from GitHub, if GitHub usage detected -#' \item a basic example -#' } -#' -#' @param pkg package description, can be path or package name. See -#' \code{\link{as.package}} for more information -#' @param render_readme should the README.Rmd be directly rendered to -#' a github markdown document? default: TRUE -#' @importFrom rmarkdown render -#' @export -#' @examples -#' \dontrun{ -#' use_readme_rmd() -#' } -#' @family infrastructure -use_readme_rmd <- function(pkg = ".", render_readme = TRUE) { - pkg <- as.package(pkg) - - if (uses_github(pkg$path)) { - pkg$github <- github_info(pkg$path) - } - pkg$Rmd <- TRUE - - - use_template("omni-README", - save_as = "README.Rmd", - data = pkg, - ignore = TRUE, - open = TRUE, - pkg = pkg, - out_path = "") - - use_build_ignore("^README-.*\\.png$", escape = FALSE, pkg = pkg) - - if (uses_git(pkg$path) && !file.exists(pkg$path, ".git", "hooks", "pre-commit")) { - message("* Adding pre-commit hook") - use_git_hook("pre-commit", render_template("readme-rmd-pre-commit.sh"), - pkg = pkg) - } - - if (render_readme) { - usethis::ui_done("\nRendering README.Rmd to README.md for GitHub.") - rmarkdown::render("README.Rmd", quiet = TRUE) - unlink("README.html") - } - - usethis::ui_done("Adding code of conduct.") - use_code_of_conduct(pkg) - - usethis::ui_done("Adding instructions to contributors.") - use_contributing(pkg) - - invisible(TRUE) -} - # helpers, not exported ------------------------------------------------------- use_code_of_conduct <- function(pkg){ From fdf0ee406110b8be4d24e0fccec10a8b2004e259 Mon Sep 17 00:00:00 2001 From: nevrome Date: Mon, 24 Jun 2019 23:27:44 +0200 Subject: [PATCH 02/12] started to restructure files with helper functions --- ...endencies.R => core_manage_dependencies.R} | 0 R/{hello.R => helpers_general.R} | 0 R/{git.R => helpers_git.R} | 49 +++ R/{github.R => helpers_github.R} | 53 +++ R/{utils.R => helpers_infrastructure.R} | 335 ++++++++++++------ R/helpers_package.R | 198 +++++++++++ R/infrastructure-git.R | 269 -------------- R/infrastructure.R | 106 ------ R/package-deps.R | 79 ----- R/package.R | 116 ------ 10 files changed, 521 insertions(+), 684 deletions(-) rename R/{manage_dependencies.R => core_manage_dependencies.R} (100%) rename R/{hello.R => helpers_general.R} (100%) rename R/{git.R => helpers_git.R} (81%) rename R/{github.R => helpers_github.R} (62%) rename R/{utils.R => helpers_infrastructure.R} (53%) create mode 100644 R/helpers_package.R delete mode 100644 R/infrastructure-git.R delete mode 100644 R/infrastructure.R delete mode 100644 R/package-deps.R delete mode 100644 R/package.R diff --git a/R/manage_dependencies.R b/R/core_manage_dependencies.R similarity index 100% rename from R/manage_dependencies.R rename to R/core_manage_dependencies.R diff --git a/R/hello.R b/R/helpers_general.R similarity index 100% rename from R/hello.R rename to R/helpers_general.R diff --git a/R/git.R b/R/helpers_git.R similarity index 81% rename from R/git.R rename to R/helpers_git.R index 2a56db3..c768627 100644 --- a/R/git.R +++ b/R/helpers_git.R @@ -223,3 +223,52 @@ git_extract_sha1 <- function(bundle) { NULL } } + +# unexported fns from devtools, we include them here so +# we don't have to use ::: +# from +# https://raw.githubusercontent.com/hadley/devtools/6bb4b5f36cdfaee4d7e2f0a1f7f71ffeaf4aaf2f/R/infrastructure-git.R + +#' Add a git hook. +#' +#' @param hook Hook name. One of "pre-commit", "prepare-commit-msg", +#' "commit-msg", "post-commit", "applypatch-msg", "pre-applypatch", +#' "post-applypatch", "pre-rebase", "post-rewrite", "post-checkout", +#' "post-merge", "pre-push", "pre-auto-gc". +#' @param script Text of script to run +#' @inheritParams use_git +#' @export +#' @family git infrastructure +#' @keywords internal +use_git_hook <- function(hook, script, pkg = ".") { + pkg <- as.package(pkg) + + git_dir <- file.path(pkg$path, ".git") + if (!file.exists(git_dir)) { + stop("This project doesn't use git", call. = FALSE) + } + + hook_dir <- file.path(git_dir, "hooks") + if (!file.exists(hook_dir)) { + dir.create(hook_dir) + } + + hook_path <- file.path(hook_dir, hook) + writeLines(script, hook_path) + Sys.chmod(hook_path, "0744") +} + + +use_git_ignore <- function(ignores, directory = ".", pkg = ".", quiet = FALSE) { + pkg <- as.package(pkg) + + paths <- paste0("`", ignores, "`", collapse = ", ") + if (!quiet) { + usethis::ui_done("Adding ", paths, " to ", file.path(directory, ".gitignore")) + } + + path <- file.path(pkg$path, directory, ".gitignore") + union_write(path, ignores) + + invisible(TRUE) +} diff --git a/R/github.R b/R/helpers_github.R similarity index 62% rename from R/github.R rename to R/helpers_github.R index d6d60c5..8f33dcc 100644 --- a/R/github.R +++ b/R/helpers_github.R @@ -110,3 +110,56 @@ github_pat <- function(quiet = FALSE) { in_ci <- function() { nzchar(Sys.getenv("CI")) } + +#' Add GitHub links to DESCRIPTION. +#' +#' Populates the URL and BugReports fields of DESCRIPTION with +#' \code{https://github.com//} AND +#' \code{https://github.com///issues}, respectively, unless +#' those fields already exist. +#' +#' @inheritParams use_git +#' @param auth_token Provide a personal access token (PAT) from +#' \url{https://github.com/settings/tokens}. Defaults to the \code{GITHUB_PAT} +#' environment variable. +#' @param host GitHub API host to use. Override with the endpoint-root for your +#' GitHub enterprise instance, for example, +#' "https://github.hostname.com/api/v3". +#' @family git infrastructure +#' @keywords internal +#' @export +use_github_links <- function(pkg = ".", auth_token = github_pat(), + host = "https://api.github.com") { + + if (!uses_github(pkg)) { + stop("Cannot detect that package already uses GitHub.\n", + "You might want to run use_github().") + } + + gh_info <- github_info(pkg) + pkg <- as.package(pkg) + + desc_path <- file.path(pkg$path, "DESCRIPTION") + desc <- new_desc <- read_dcf(desc_path) + + path_to_repo <- paste("repos", gh_info$fullname, sep = "/") + res <- github_GET(path = path_to_repo, pat = auth_token, host = host) + github_URL <- res$html_url + + fill <- function(d, f, filler) { + if (is.null(d[[f]]) || identical(d[[f]], "")) { + d[[f]] <- filler + } else { + message("Existing ", f, " field found and preserved") + } + d + } + new_desc <- fill(new_desc, "URL", github_URL) + new_desc <- fill(new_desc, "BugReports", file.path(github_URL, "issues")) + + if (!identical(desc, new_desc)) + write_dcf(desc_path, new_desc) + + new_desc[c("URL", "BugReports")] +} + diff --git a/R/utils.R b/R/helpers_infrastructure.R similarity index 53% rename from R/utils.R rename to R/helpers_infrastructure.R index 9fae3b2..63879ce 100644 --- a/R/utils.R +++ b/R/helpers_infrastructure.R @@ -1,114 +1,221 @@ - -warning_bullet <- function() crayon::yellow(clisymbols::symbol$warning) -red_cross <- function() crayon::red(clisymbols::symbol$cross) -green_tick <- function() crayon::green(clisymbols::symbol$tick) - - - -# capture the cat & message output -# from http://r.789695.n4.nabble.com/Suppressing-output-e-g-from-cat-tp859876p859882.html -quietly <- function(x) { - sink(tempfile()) - on.exit(sink()) - invisible(force(suppressMessages(x))) -} - -# unexported fns from devtools, we include them here so -# we don't have to use ::: -# from https://github.com/hadley/devtools/blob/ba7a5a4abd8258c52cb156e7b26bb4bf47a79f0b/R/utils.r - - -is_dir <- function(x) file.info(x)$isdir - -render_template <- function(name, data = list()) { - path <- system.file("templates", name, package = "devtools") - template <- readLines(path) - whisker::whisker.render(template, data) -} - -read_dcf <- function(path) { - fields <- colnames(read.dcf(path)) - as.list(read.dcf(path, keep.white = fields)[1, ]) -} - -write_dcf <- function(path, desc) { - desc <- unlist(desc) - # Add back in continuation characters - desc <- gsub("\n[ \t]*\n", "\n .\n ", desc, perl = TRUE, useBytes = TRUE) - desc <- gsub("\n \\.([^\n])", "\n .\\1", desc, perl = TRUE, useBytes = TRUE) - - starts_with_whitespace <- grepl("^\\s", desc, perl = TRUE, useBytes = TRUE) - delimiters <- ifelse(starts_with_whitespace, ":", ": ") - text <- paste0(names(desc), delimiters, desc, collapse = "\n") - - # If the description file has a declared encoding, set it so nchar() works - # properly. - if ("Encoding" %in% names(desc)) { - Encoding(text) <- desc[["Encoding"]] - } - - if (substr(text, nchar(text), 1) != "\n") { - text <- paste0(text, "\n") - } - - cat(text, file = path) -} - -dots <- function(...) { - eval(substitute(alist(...))) -} - - -suggests_dep <- function(pkg) { - - suggests <- read_dcf(system.file("DESCRIPTION", package = "devtools"))$Suggests - deps <- parse_deps(suggests) - - found <- which(deps$name == pkg)[1L] - - if (!length(found)) { - stop(sQuote(pkg), " is not in Suggests: for devtools!", call. = FALSE) - } - deps[found, ] -} - - -is_installed <- function(pkg, version = 0) { - installed_version <- tryCatch(utils::packageVersion(pkg), error = function(e) NA) - !is.na(installed_version) && installed_version >= version -} - - - -check_suggested <- function(pkg, version = NULL, compare = NA) { - - if (is.null(version)) { - if (!is.na(compare)) { - stop("Cannot set ", sQuote(compare), " without setting ", - sQuote(version), call. = FALSE) - } - - dep <- suggests_dep(pkg) - - version <- dep$version - compare <- dep$compare - } - - if (!is_installed(pkg) || !check_dep_version(pkg, version, compare)) { - msg <- paste0(sQuote(pkg), - if (is.na(version)) "" else paste0(" >= ", version), - " must be installed for this functionality.") - - if (interactive()) { - message(msg, "\nWould you like to install it?") - if (menu(c("Yes", "No")) == 1) { - install.packages(pkg) - } else { - stop(msg, call. = FALSE) - } - } else { - stop(msg, call. = FALSE) - } - } -} - +# unexported fns from devtools, we include them here so +# we don't have to use ::: +# from https://github.com/hadley/devtools/blob/ad6f28ef9de6a02e1ea300af45d34deccc40bd2f/R/infrastructure.R + +yesno <- function(...) { + yeses <- c("Yes", "Definitely", "For sure", "Yup", "Yeah", "I agree", "Absolutely") + nos <- c("No way", "Not yet", "I forget", "No", "Nope", "Uhhhh... Maybe?") + + cat(paste0(..., collapse = "")) + qs <- c(sample(yeses, 1), sample(nos, 2)) + rand <- sample(length(qs)) + + menu(qs[rand]) != which(rand == 1) +} + +union_write <- function(path, new_lines) { + if (file.exists(path)) { + lines <- readLines(path, warn = FALSE) + } else { + lines <- character() + } + + all <- union(lines, new_lines) + writeLines(all, path) +} + + +add_desc_package <- function(pkg = ".", field, name) { + pkg <- as.package(pkg) + desc_path <- file.path(pkg$path, "DESCRIPTION") + + desc <- read_dcf(desc_path) + old <- desc[[field]] + if (is.null(old)) { + new <- name + changed <- TRUE + } else { + if (!grepl(paste0('\\b', name, '\\b'), old)) { + new <- paste0(old, ",\n ", name) + changed <- TRUE + } else { + changed <- FALSE + } + } + if (changed) { + desc[[field]] <- new + write_dcf(desc_path, desc) + } + invisible(changed) +} + + +#' Add a file to \code{.Rbuildignore} +#' +#' \code{.Rbuildignore} has a regular expression on each line, but it's +#' usually easier to work with specific file names. By default, will (crudely) +#' turn a filename into a regular expression that will only match that +#' path. Repeated entries will be silently removed. +#' +#' @param pkg package description, can be path or package name. See +#' \code{\link{as.package}} for more information +#' @param files Name of file. +#' @param escape If \code{TRUE}, the default, will escape \code{.} to +#' \code{\\.} and surround with \code{^} and \code{$}. +#' @return Nothing, called for its side effect. +#' @export +#' @aliases add_build_ignore +#' @family infrastructure +#' @keywords internal +use_build_ignore <- function(files, escape = TRUE, pkg = ".") { + pkg <- as.package(pkg) + + if (escape) { + files <- paste0("^", gsub("\\.", "\\\\.", files), "$") + } + + path <- file.path(pkg$path, ".Rbuildignore") + union_write(path, files) + + invisible(TRUE) +} + + +open_in_rstudio <- function(path) { + if (!rstudioapi::isAvailable()) + return() + + if (!rstudioapi::hasFun("navigateToFile")) + return() + + rstudioapi::navigateToFile(path) + +} + +can_overwrite <- function(path, ask = TRUE) { + name <- basename(path) + + if (!file.exists(path)) { + TRUE + } else if (ask && (interactive() && !yesno("Overwrite `", name, "`?"))) { + TRUE + } else { + FALSE + } +} + +### + +warning_bullet <- function() crayon::yellow(clisymbols::symbol$warning) +red_cross <- function() crayon::red(clisymbols::symbol$cross) +green_tick <- function() crayon::green(clisymbols::symbol$tick) + + + +# capture the cat & message output +# from http://r.789695.n4.nabble.com/Suppressing-output-e-g-from-cat-tp859876p859882.html +quietly <- function(x) { + sink(tempfile()) + on.exit(sink()) + invisible(force(suppressMessages(x))) +} + +# unexported fns from devtools, we include them here so +# we don't have to use ::: +# from https://github.com/hadley/devtools/blob/ba7a5a4abd8258c52cb156e7b26bb4bf47a79f0b/R/utils.r + + +is_dir <- function(x) file.info(x)$isdir + +render_template <- function(name, data = list()) { + path <- system.file("templates", name, package = "devtools") + template <- readLines(path) + whisker::whisker.render(template, data) +} + +read_dcf <- function(path) { + fields <- colnames(read.dcf(path)) + as.list(read.dcf(path, keep.white = fields)[1, ]) +} + +write_dcf <- function(path, desc) { + desc <- unlist(desc) + # Add back in continuation characters + desc <- gsub("\n[ \t]*\n", "\n .\n ", desc, perl = TRUE, useBytes = TRUE) + desc <- gsub("\n \\.([^\n])", "\n .\\1", desc, perl = TRUE, useBytes = TRUE) + + starts_with_whitespace <- grepl("^\\s", desc, perl = TRUE, useBytes = TRUE) + delimiters <- ifelse(starts_with_whitespace, ":", ": ") + text <- paste0(names(desc), delimiters, desc, collapse = "\n") + + # If the description file has a declared encoding, set it so nchar() works + # properly. + if ("Encoding" %in% names(desc)) { + Encoding(text) <- desc[["Encoding"]] + } + + if (substr(text, nchar(text), 1) != "\n") { + text <- paste0(text, "\n") + } + + cat(text, file = path) +} + +dots <- function(...) { + eval(substitute(alist(...))) +} + + +suggests_dep <- function(pkg) { + + suggests <- read_dcf(system.file("DESCRIPTION", package = "devtools"))$Suggests + deps <- parse_deps(suggests) + + found <- which(deps$name == pkg)[1L] + + if (!length(found)) { + stop(sQuote(pkg), " is not in Suggests: for devtools!", call. = FALSE) + } + deps[found, ] +} + + +is_installed <- function(pkg, version = 0) { + installed_version <- tryCatch(utils::packageVersion(pkg), error = function(e) NA) + !is.na(installed_version) && installed_version >= version +} + + + +check_suggested <- function(pkg, version = NULL, compare = NA) { + + if (is.null(version)) { + if (!is.na(compare)) { + stop("Cannot set ", sQuote(compare), " without setting ", + sQuote(version), call. = FALSE) + } + + dep <- suggests_dep(pkg) + + version <- dep$version + compare <- dep$compare + } + + if (!is_installed(pkg) || !check_dep_version(pkg, version, compare)) { + msg <- paste0(sQuote(pkg), + if (is.na(version)) "" else paste0(" >= ", version), + " must be installed for this functionality.") + + if (interactive()) { + message(msg, "\nWould you like to install it?") + if (menu(c("Yes", "No")) == 1) { + install.packages(pkg) + } else { + stop(msg, call. = FALSE) + } + } else { + stop(msg, call. = FALSE) + } + } +} + diff --git a/R/helpers_package.R b/R/helpers_package.R new file mode 100644 index 0000000..4b1542a --- /dev/null +++ b/R/helpers_package.R @@ -0,0 +1,198 @@ +# unexported fns from devtools, we include them here so +# we don't have to use ::: +# from https://raw.githubusercontent.com/hadley/devtools/26c507b128fdaa1911503348fedcf20d2dd30a1d/R/package.r + + + + +#' Coerce input to a package. +#' +#' Possible specifications of package: +#' \itemize{ +#' \item path +#' \item package object +#' } +#' @param x object to coerce to a package +#' @param create only relevant if a package structure does not exist yet: if +#' \code{TRUE}, create a package structure; if \code{NA}, ask the user +#' (in interactive mode only) +#' @export +#' @keywords internal +as.package <- function(x = NULL, create = NA) { + if (is.package(x)) return(x) + + x <- package_file(path = x) + load_pkg_description(x, create = create) +} + +#' Find file in a package. +#' +#' It always starts by finding by walking up the path until it finds the +#' root directory, i.e. a directory containing \code{DESCRIPTION}. If it +#' cannot find the root directory, or it can't find the specified path, it +#' will throw an error. +#' +#' @param ... Components of the path. +#' @param path Place to start search for package directory. +#' @export +#' @examples +#' \dontrun{ +#' package_file("figures", "figure_1") +#' } +package_file <- function(..., path = ".") { + if (!is.character(path) || length(path) != 1) { + stop("`path` must be a string.", call. = FALSE) + } + path <- strip_slashes(normalizePath(path, mustWork = FALSE)) + + if (!file.exists(path)) { + stop("Can't find '", path, "'.", call. = FALSE) + } + if (!file.info(path)$isdir) { + stop("'", path, "' is not a directory.", call. = FALSE) + } + + # Walk up to root directory + while (!has_description(path)) { + path <- dirname(path) + + if (is_root(path)) { + stop("Could not find package root.", call. = FALSE) + } + } + + file.path(path, ...) +} + +has_description <- function(path) { + file.exists(file.path(path, 'DESCRIPTION')) +} + +is_root <- function(path) { + identical(path, dirname(path)) +} + +strip_slashes <- function(x) { + x <- sub("/*$", "", x) + x +} + +# Load package DESCRIPTION into convenient form. +load_pkg_description <- function(path, create) { + path_desc <- file.path(path, "DESCRIPTION") + + if (!file.exists(path_desc)) { + if (is.na(create)) { + if (interactive()) { + message("No package infrastructure found in ", path, ". Create it?") + create <- (menu(c("Yes", "No")) == 1) + } else { + create <- FALSE + } + } + + if (create) { + setup(path = path) + } else { + stop("No description at ", path_desc, call. = FALSE) + } + } + + desc <- as.list(read.dcf(path_desc)[1, ]) + names(desc) <- tolower(names(desc)) + desc$path <- path + + structure(desc, class = "package") +} + + +#' Is the object a package? +#' +#' @keywords internal +#' @export +is.package <- function(x) inherits(x, "package") + +# Mockable variant of interactive +interactive <- function() .Primitive("interactive")() + + +# unexported fns from devtools, we include them here so +# we don't have to use ::: +# from https://github.com/hadley/devtools/blob/26c507b128fdaa1911503348fedcf20d2dd30a1d/R/package-deps.r + +#' Parse package dependency strings. +#' +#' @param string to parse. Should look like \code{"R (>= 3.0), ggplot2"} etc. +#' @return list of two character vectors: \code{name} package names, +#' and \code{version} package versions. If version is not specified, +#' it will be stored as NA. +#' @keywords internal +#' @export +#' @examples +#' parse_deps("httr (< 2.1),\nRCurl (>= 3)") +#' # only package dependencies are returned +#' parse_deps("utils (== 2.12.1),\ntools,\nR (>= 2.10),\nmemoise") +parse_deps <- function(string) { + if (is.null(string)) return() + stopifnot(is.character(string), length(string) == 1) + if (grepl("^\\s*$", string)) return() + + pieces <- strsplit(string, "[[:space:]]*,[[:space:]]*")[[1]] + + # Get the names + names <- gsub("\\s*\\(.*?\\)", "", pieces) + names <- gsub("^\\s+|\\s+$", "", names) + + # Get the versions and comparison operators + versions_str <- pieces + have_version <- grepl("\\(.*\\)", versions_str) + versions_str[!have_version] <- NA + + compare <- sub(".*\\((\\S+)\\s+.*\\)", "\\1", versions_str) + versions <- sub(".*\\(\\S+\\s+(.*)\\)", "\\1", versions_str) + + # Check that non-NA comparison operators are valid + compare_nna <- compare[!is.na(compare)] + compare_valid <- compare_nna %in% c(">", ">=", "==", "<=", "<") + if(!all(compare_valid)) { + stop("Invalid comparison operator in dependency: ", + paste(compare_nna[!compare_valid], collapse = ", ")) + } + + deps <- data.frame(name = names, compare = compare, + version = versions, stringsAsFactors = FALSE) + + # Remove R dependency + deps[names != "R", ] +} + + +#' Check that the version of an imported package satisfies the requirements +#' +#' @param dep_name The name of the package with objects to import +#' @param dep_ver The version of the package +#' @param dep_compare The comparison operator to use to check the version +#' @keywords internal +check_dep_version <- function(dep_name, dep_ver = NA, dep_compare = NA) { + if (!requireNamespace(dep_name, quietly = TRUE)) { + stop("Dependency package ", dep_name, " not available.") + } + + if (xor(is.na(dep_ver), is.na(dep_compare))) { + stop("dep_ver and dep_compare must be both NA or both non-NA") + + } else if(!is.na(dep_ver) && !is.na(dep_compare)) { + + compare <- match.fun(dep_compare) + if (!compare( + as.numeric_version(getNamespaceVersion(dep_name)), + as.numeric_version(dep_ver))) { + + warning("Need ", dep_name, " ", dep_compare, + " ", dep_ver, + " but loaded version is ", getNamespaceVersion(dep_name)) + } + } + return(TRUE) +} + diff --git a/R/infrastructure-git.R b/R/infrastructure-git.R deleted file mode 100644 index a4c9a81..0000000 --- a/R/infrastructure-git.R +++ /dev/null @@ -1,269 +0,0 @@ -# unexported fns from devtools, we include them here so -# we don't have to use ::: -# from -# https://raw.githubusercontent.com/hadley/devtools/6bb4b5f36cdfaee4d7e2f0a1f7f71ffeaf4aaf2f/R/infrastructure-git.R - - - -#' Initialise a git repository. -#' -#' @param message Message to use for first commit. -#' @param pkg Path to package. See \code{\link{as.package}} for more -#' information. -#' @family git infrastructure -#' @export -#' @examples -#' \dontrun{use_git()} -use_git <- function(message = "Initial commit", pkg = ".") { - use_git_with_config(message = message, pkg = pkg) -} - -use_git_with_config <- function(message, pkg, add_user_config = FALSE, quiet = FALSE) { - pkg <- as.package(pkg) - - if (uses_git(pkg$path)) { - usethis::ui_done("Git is already initialized") - return(invisible()) - } - - if (!quiet) { - usethis::ui_done("Initialising repo") - } - r <- git2r::init(pkg$path) - - if (add_user_config) { - git2r::config(r, global = FALSE, user.name = "user", user.email = "user@email.xx") - } - - use_git_ignore(c(".Rproj.user", ".Rhistory", ".RData"), pkg = pkg, quiet = quiet) - - if (!quiet) { - usethis::ui_done("Adding files and committing") - } - paths <- unlist(git2r::status(r)) - git2r::add(r, paths) - git2r::commit(r, message) - - invisible() -} - -#' Connect a local repo with GitHub. -#' -#' If the current repo does not use git, calls \code{\link{use_git}} -#' automatically. \code{\link{use_github_links}} is called to populate the -#' \code{URL} and \code{BugReports} fields of DESCRIPTION. -#' -#' @section Authentication: -#' -#' A new GitHub repo will be created via the GitHub API, therefore you must -#' provide a GitHub personal access token (PAT) via the argument -#' \code{auth_token}, which defaults to the value of the \code{GITHUB_PAT} -#' environment variable. Obtain a PAT from -#' \url{https://github.com/settings/tokens}. The "repo" scope is required -#' which is one of the default scopes for a new PAT. -#' -#' The argument \code{protocol} reflects how you wish to authenticate with -#' GitHub for this repo in the long run. For either \code{protocol}, a remote -#' named "origin" is created, an initial push is made using the specified -#' \code{protocol}, and a remote tracking branch is set. The URL of the -#' "origin" remote has the form \code{git@@github.com:/.git} -#' (\code{protocol = "ssh"}, the default) or -#' \code{https://github.com//.git} (\code{protocol = -#' "https"}). For \code{protocol = "ssh"}, it is assumed that public and -#' private keys are in the default locations, \code{~/.ssh/id_rsa.pub} and -#' \code{~/.ssh/id_rsa}, respectively, and that \code{ssh-agent} is configured -#' to manage any associated passphrase. Alternatively, specify a -#' \code{\link[git2r]{cred_ssh_key}} object via the \code{credentials} -#' parameter. -#' -#' @inheritParams use_git -#' @param auth_token Provide a personal access token (PAT) from -#' \url{https://github.com/settings/tokens}. Defaults to the \code{GITHUB_PAT} -#' environment variable. -#' @param private If \code{TRUE}, creates a private repository. -#' @param host GitHub API host to use. Override with the endpoint-root for your -#' GitHub enterprise instance, for example, -#' "https://github.hostname.com/api/v3". -#' @param protocol transfer protocol, either "ssh" (the default) or "https" -#' @param credentials A \code{\link[git2r]{cred_ssh_key}} specifying specific -#' ssh credentials or NULL for default ssh key and ssh-agent behaviour. -#' Default is NULL. -#' @family git infrastructure -#' @export -#' @examples -#' \dontrun{ -#' ## to use default ssh protocol -#' create("testpkg") -#' use_github(pkg = "testpkg") -#' -#' ## or use https -#' create("testpkg2") -#' use_github(pkg = "testpkg2", protocol = "https") -#' } -use_github <- function(auth_token = github_pat(), private = FALSE, pkg = ".", - host = "https://api.github.com", - protocol = c("ssh", "https"), credentials = NULL) { - - if (is.null(auth_token)) { - stop("GITHUB_PAT required to create new repo") - } - - protocol <- match.arg(protocol) - - pkg <- as.package(pkg) - use_git(pkg = pkg) - - if (uses_github(pkg$path)) { - usethis::ui_done("GitHub is already initialized") - return(invisible()) - } - - usethis::ui_done("Checking title and description") - usethis::ui_done(" Title: ", pkg$title) - usethis::ui_done(" Description: ", pkg$description) - if (interactive() && !yesno("Are title and description ok?")) { - TRUE - } else { - FALSE - } - - - message("* Creating GitHub repository") - create <- - github_POST( - "user/repos", - pat = auth_token, - body = list( - name = jsonlite::unbox(pkg$package), - description = jsonlite::unbox(gsub("\n", " ", pkg$title)), - private = jsonlite::unbox(private) - ), - host = host - ) - - usethis::ui_done("Adding GitHub remote") - r <- git2r::repository(pkg$path) - origin_url <- switch(protocol, https = create$clone_url, ssh = create$ssh_url) - git2r::remote_add(r, "origin", origin_url) - - usethis::ui_done("Adding GitHub links to DESCRIPTION") - use_github_links(pkg$path, auth_token = auth_token, host = host) - if (git_uncommitted(pkg$path)) { - git2r::add(r, "DESCRIPTION") - git2r::commit(r, "Add GitHub links to DESCRIPTION") - } - - message("* Pushing to GitHub and setting remote tracking branch") - if (protocol == "ssh") { - ## [1] push via ssh required for success setting remote tracking branch - ## [2] to get passphrase from ssh-agent, you must use NULL credentials - git2r::push(r, "origin", "refs/heads/master", credentials = credentials) - } else { ## protocol == "https" - ## in https case, when GITHUB_PAT is passed as password, - ## the username is immaterial, but git2r doesn't know that - cred <- git2r::cred_user_pass("EMAIL", auth_token) - git2r::push(r, "origin", "refs/heads/master", credentials = cred) - } - git2r::branch_set_upstream(git2r::head(r), "origin/master") - - usethis::ui_done("View repo at ", create$html_url) - - invisible(NULL) -} - - -#' Add a git hook. -#' -#' @param hook Hook name. One of "pre-commit", "prepare-commit-msg", -#' "commit-msg", "post-commit", "applypatch-msg", "pre-applypatch", -#' "post-applypatch", "pre-rebase", "post-rewrite", "post-checkout", -#' "post-merge", "pre-push", "pre-auto-gc". -#' @param script Text of script to run -#' @inheritParams use_git -#' @export -#' @family git infrastructure -#' @keywords internal -use_git_hook <- function(hook, script, pkg = ".") { - pkg <- as.package(pkg) - - git_dir <- file.path(pkg$path, ".git") - if (!file.exists(git_dir)) { - stop("This project doesn't use git", call. = FALSE) - } - - hook_dir <- file.path(git_dir, "hooks") - if (!file.exists(hook_dir)) { - dir.create(hook_dir) - } - - hook_path <- file.path(hook_dir, hook) - writeLines(script, hook_path) - Sys.chmod(hook_path, "0744") -} - - -use_git_ignore <- function(ignores, directory = ".", pkg = ".", quiet = FALSE) { - pkg <- as.package(pkg) - - paths <- paste0("`", ignores, "`", collapse = ", ") - if (!quiet) { - usethis::ui_done("Adding ", paths, " to ", file.path(directory, ".gitignore")) - } - - path <- file.path(pkg$path, directory, ".gitignore") - union_write(path, ignores) - - invisible(TRUE) -} - -#' Add GitHub links to DESCRIPTION. -#' -#' Populates the URL and BugReports fields of DESCRIPTION with -#' \code{https://github.com//} AND -#' \code{https://github.com///issues}, respectively, unless -#' those fields already exist. -#' -#' @inheritParams use_git -#' @param auth_token Provide a personal access token (PAT) from -#' \url{https://github.com/settings/tokens}. Defaults to the \code{GITHUB_PAT} -#' environment variable. -#' @param host GitHub API host to use. Override with the endpoint-root for your -#' GitHub enterprise instance, for example, -#' "https://github.hostname.com/api/v3". -#' @family git infrastructure -#' @keywords internal -#' @export -use_github_links <- function(pkg = ".", auth_token = github_pat(), - host = "https://api.github.com") { - - if (!uses_github(pkg)) { - stop("Cannot detect that package already uses GitHub.\n", - "You might want to run use_github().") - } - - gh_info <- github_info(pkg) - pkg <- as.package(pkg) - - desc_path <- file.path(pkg$path, "DESCRIPTION") - desc <- new_desc <- read_dcf(desc_path) - - path_to_repo <- paste("repos", gh_info$fullname, sep = "/") - res <- github_GET(path = path_to_repo, pat = auth_token, host = host) - github_URL <- res$html_url - - fill <- function(d, f, filler) { - if (is.null(d[[f]]) || identical(d[[f]], "")) { - d[[f]] <- filler - } else { - message("Existing ", f, " field found and preserved") - } - d - } - new_desc <- fill(new_desc, "URL", github_URL) - new_desc <- fill(new_desc, "BugReports", file.path(github_URL, "issues")) - - if (!identical(desc, new_desc)) - write_dcf(desc_path, new_desc) - - new_desc[c("URL", "BugReports")] -} diff --git a/R/infrastructure.R b/R/infrastructure.R deleted file mode 100644 index 5112170..0000000 --- a/R/infrastructure.R +++ /dev/null @@ -1,106 +0,0 @@ -# unexported fns from devtools, we include them here so -# we don't have to use ::: -# from https://github.com/hadley/devtools/blob/ad6f28ef9de6a02e1ea300af45d34deccc40bd2f/R/infrastructure.R - -yesno <- function(...) { - yeses <- c("Yes", "Definitely", "For sure", "Yup", "Yeah", "I agree", "Absolutely") - nos <- c("No way", "Not yet", "I forget", "No", "Nope", "Uhhhh... Maybe?") - - cat(paste0(..., collapse = "")) - qs <- c(sample(yeses, 1), sample(nos, 2)) - rand <- sample(length(qs)) - - menu(qs[rand]) != which(rand == 1) -} - -union_write <- function(path, new_lines) { - if (file.exists(path)) { - lines <- readLines(path, warn = FALSE) - } else { - lines <- character() - } - - all <- union(lines, new_lines) - writeLines(all, path) -} - - -add_desc_package <- function(pkg = ".", field, name) { - pkg <- as.package(pkg) - desc_path <- file.path(pkg$path, "DESCRIPTION") - - desc <- read_dcf(desc_path) - old <- desc[[field]] - if (is.null(old)) { - new <- name - changed <- TRUE - } else { - if (!grepl(paste0('\\b', name, '\\b'), old)) { - new <- paste0(old, ",\n ", name) - changed <- TRUE - } else { - changed <- FALSE - } - } - if (changed) { - desc[[field]] <- new - write_dcf(desc_path, desc) - } - invisible(changed) -} - - -#' Add a file to \code{.Rbuildignore} -#' -#' \code{.Rbuildignore} has a regular expression on each line, but it's -#' usually easier to work with specific file names. By default, will (crudely) -#' turn a filename into a regular expression that will only match that -#' path. Repeated entries will be silently removed. -#' -#' @param pkg package description, can be path or package name. See -#' \code{\link{as.package}} for more information -#' @param files Name of file. -#' @param escape If \code{TRUE}, the default, will escape \code{.} to -#' \code{\\.} and surround with \code{^} and \code{$}. -#' @return Nothing, called for its side effect. -#' @export -#' @aliases add_build_ignore -#' @family infrastructure -#' @keywords internal -use_build_ignore <- function(files, escape = TRUE, pkg = ".") { - pkg <- as.package(pkg) - - if (escape) { - files <- paste0("^", gsub("\\.", "\\\\.", files), "$") - } - - path <- file.path(pkg$path, ".Rbuildignore") - union_write(path, files) - - invisible(TRUE) -} - - -open_in_rstudio <- function(path) { - if (!rstudioapi::isAvailable()) - return() - - if (!rstudioapi::hasFun("navigateToFile")) - return() - - rstudioapi::navigateToFile(path) - -} - -can_overwrite <- function(path, ask = TRUE) { - name <- basename(path) - - if (!file.exists(path)) { - TRUE - } else if (ask && (interactive() && !yesno("Overwrite `", name, "`?"))) { - TRUE - } else { - FALSE - } -} - diff --git a/R/package-deps.R b/R/package-deps.R deleted file mode 100644 index f2344e1..0000000 --- a/R/package-deps.R +++ /dev/null @@ -1,79 +0,0 @@ -# unexported fns from devtools, we include them here so -# we don't have to use ::: -# from https://github.com/hadley/devtools/blob/26c507b128fdaa1911503348fedcf20d2dd30a1d/R/package-deps.r - -#' Parse package dependency strings. -#' -#' @param string to parse. Should look like \code{"R (>= 3.0), ggplot2"} etc. -#' @return list of two character vectors: \code{name} package names, -#' and \code{version} package versions. If version is not specified, -#' it will be stored as NA. -#' @keywords internal -#' @export -#' @examples -#' parse_deps("httr (< 2.1),\nRCurl (>= 3)") -#' # only package dependencies are returned -#' parse_deps("utils (== 2.12.1),\ntools,\nR (>= 2.10),\nmemoise") -parse_deps <- function(string) { - if (is.null(string)) return() - stopifnot(is.character(string), length(string) == 1) - if (grepl("^\\s*$", string)) return() - - pieces <- strsplit(string, "[[:space:]]*,[[:space:]]*")[[1]] - - # Get the names - names <- gsub("\\s*\\(.*?\\)", "", pieces) - names <- gsub("^\\s+|\\s+$", "", names) - - # Get the versions and comparison operators - versions_str <- pieces - have_version <- grepl("\\(.*\\)", versions_str) - versions_str[!have_version] <- NA - - compare <- sub(".*\\((\\S+)\\s+.*\\)", "\\1", versions_str) - versions <- sub(".*\\(\\S+\\s+(.*)\\)", "\\1", versions_str) - - # Check that non-NA comparison operators are valid - compare_nna <- compare[!is.na(compare)] - compare_valid <- compare_nna %in% c(">", ">=", "==", "<=", "<") - if(!all(compare_valid)) { - stop("Invalid comparison operator in dependency: ", - paste(compare_nna[!compare_valid], collapse = ", ")) - } - - deps <- data.frame(name = names, compare = compare, - version = versions, stringsAsFactors = FALSE) - - # Remove R dependency - deps[names != "R", ] -} - - -#' Check that the version of an imported package satisfies the requirements -#' -#' @param dep_name The name of the package with objects to import -#' @param dep_ver The version of the package -#' @param dep_compare The comparison operator to use to check the version -#' @keywords internal -check_dep_version <- function(dep_name, dep_ver = NA, dep_compare = NA) { - if (!requireNamespace(dep_name, quietly = TRUE)) { - stop("Dependency package ", dep_name, " not available.") - } - - if (xor(is.na(dep_ver), is.na(dep_compare))) { - stop("dep_ver and dep_compare must be both NA or both non-NA") - - } else if(!is.na(dep_ver) && !is.na(dep_compare)) { - - compare <- match.fun(dep_compare) - if (!compare( - as.numeric_version(getNamespaceVersion(dep_name)), - as.numeric_version(dep_ver))) { - - warning("Need ", dep_name, " ", dep_compare, - " ", dep_ver, - " but loaded version is ", getNamespaceVersion(dep_name)) - } - } - return(TRUE) -} diff --git a/R/package.R b/R/package.R deleted file mode 100644 index 37950f9..0000000 --- a/R/package.R +++ /dev/null @@ -1,116 +0,0 @@ -# unexported fns from devtools, we include them here so -# we don't have to use ::: -# from https://raw.githubusercontent.com/hadley/devtools/26c507b128fdaa1911503348fedcf20d2dd30a1d/R/package.r - - - - -#' Coerce input to a package. -#' -#' Possible specifications of package: -#' \itemize{ -#' \item path -#' \item package object -#' } -#' @param x object to coerce to a package -#' @param create only relevant if a package structure does not exist yet: if -#' \code{TRUE}, create a package structure; if \code{NA}, ask the user -#' (in interactive mode only) -#' @export -#' @keywords internal -as.package <- function(x = NULL, create = NA) { - if (is.package(x)) return(x) - - x <- package_file(path = x) - load_pkg_description(x, create = create) -} - -#' Find file in a package. -#' -#' It always starts by finding by walking up the path until it finds the -#' root directory, i.e. a directory containing \code{DESCRIPTION}. If it -#' cannot find the root directory, or it can't find the specified path, it -#' will throw an error. -#' -#' @param ... Components of the path. -#' @param path Place to start search for package directory. -#' @export -#' @examples -#' \dontrun{ -#' package_file("figures", "figure_1") -#' } -package_file <- function(..., path = ".") { - if (!is.character(path) || length(path) != 1) { - stop("`path` must be a string.", call. = FALSE) - } - path <- strip_slashes(normalizePath(path, mustWork = FALSE)) - - if (!file.exists(path)) { - stop("Can't find '", path, "'.", call. = FALSE) - } - if (!file.info(path)$isdir) { - stop("'", path, "' is not a directory.", call. = FALSE) - } - - # Walk up to root directory - while (!has_description(path)) { - path <- dirname(path) - - if (is_root(path)) { - stop("Could not find package root.", call. = FALSE) - } - } - - file.path(path, ...) -} - -has_description <- function(path) { - file.exists(file.path(path, 'DESCRIPTION')) -} - -is_root <- function(path) { - identical(path, dirname(path)) -} - -strip_slashes <- function(x) { - x <- sub("/*$", "", x) - x -} - -# Load package DESCRIPTION into convenient form. -load_pkg_description <- function(path, create) { - path_desc <- file.path(path, "DESCRIPTION") - - if (!file.exists(path_desc)) { - if (is.na(create)) { - if (interactive()) { - message("No package infrastructure found in ", path, ". Create it?") - create <- (menu(c("Yes", "No")) == 1) - } else { - create <- FALSE - } - } - - if (create) { - setup(path = path) - } else { - stop("No description at ", path_desc, call. = FALSE) - } - } - - desc <- as.list(read.dcf(path_desc)[1, ]) - names(desc) <- tolower(names(desc)) - desc$path <- path - - structure(desc, class = "package") -} - - -#' Is the object a package? -#' -#' @keywords internal -#' @export -is.package <- function(x) inherits(x, "package") - -# Mockable variant of interactive -interactive <- function() .Primitive("interactive")() From 26ce59f9abeba5117679a80f21a1baefa69ee155 Mon Sep 17 00:00:00 2001 From: nevrome Date: Mon, 24 Jun 2019 23:29:34 +0200 Subject: [PATCH 03/12] update of documentation --- NAMESPACE | 2 - man/add_dependencies_to_description.Rd | 2 +- man/as.package.Rd | 2 +- man/check_dep_version.Rd | 2 +- man/create_compendium.Rd | 2 +- man/github_pat.Rd | 2 +- man/is.package.Rd | 2 +- man/package_file.Rd | 2 +- man/parse_deps.Rd | 2 +- man/use_analysis.Rd | 2 +- man/use_build_ignore.Rd | 2 +- man/use_circleci.Rd | 2 +- man/use_compendium.Rd | 2 +- man/use_dockerfile.Rd | 2 +- man/use_git.Rd | 25 --------- man/use_git_hook.Rd | 8 +-- man/use_git_quietly.Rd | 2 +- man/use_github.Rd | 76 -------------------------- man/use_github_links.Rd | 8 +-- man/use_readme_rmd.Rd | 2 +- man/use_travis.Rd | 2 +- 21 files changed, 20 insertions(+), 131 deletions(-) delete mode 100644 man/use_git.Rd delete mode 100644 man/use_github.Rd diff --git a/NAMESPACE b/NAMESPACE index b28be9b..b564355 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,10 +12,8 @@ export(use_build_ignore) export(use_circleci) export(use_compendium) export(use_dockerfile) -export(use_git) export(use_git_hook) export(use_git_quietly) -export(use_github) export(use_github_links) export(use_readme_rmd) export(use_travis) diff --git a/man/add_dependencies_to_description.Rd b/man/add_dependencies_to_description.Rd index 9cf3c7b..94931f8 100644 --- a/man/add_dependencies_to_description.Rd +++ b/man/add_dependencies_to_description.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/manage_dependencies.R +% Please edit documentation in R/core_manage_dependencies.R \name{add_dependencies_to_description} \alias{add_dependencies_to_description} \title{Searches for external packages and adds them to the Imports field in the description} diff --git a/man/as.package.Rd b/man/as.package.Rd index a6dd63a..b5b0499 100644 --- a/man/as.package.Rd +++ b/man/as.package.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/package.R +% Please edit documentation in R/helpers_package.R \name{as.package} \alias{as.package} \title{Coerce input to a package.} diff --git a/man/check_dep_version.Rd b/man/check_dep_version.Rd index 8143e3d..f07e450 100644 --- a/man/check_dep_version.Rd +++ b/man/check_dep_version.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/package-deps.R +% Please edit documentation in R/helpers_package.R \name{check_dep_version} \alias{check_dep_version} \title{Check that the version of an imported package satisfies the requirements} diff --git a/man/create_compendium.Rd b/man/create_compendium.Rd index 24b5704..46c291a 100644 --- a/man/create_compendium.Rd +++ b/man/create_compendium.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hello.R +% Please edit documentation in R/core_create_compendium.R \name{create_compendium} \alias{create_compendium} \title{Quickly create a basic research compendium by combining several rrtools functions into one.} diff --git a/man/github_pat.Rd b/man/github_pat.Rd index 09ce268..10449a6 100644 --- a/man/github_pat.Rd +++ b/man/github_pat.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/github.R +% Please edit documentation in R/helpers_github.R \name{github_pat} \alias{github_pat} \title{Retrieve Github personal access token.} diff --git a/man/is.package.Rd b/man/is.package.Rd index fef86c2..961cdf0 100644 --- a/man/is.package.Rd +++ b/man/is.package.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/package.R +% Please edit documentation in R/helpers_package.R \name{is.package} \alias{is.package} \title{Is the object a package?} diff --git a/man/package_file.Rd b/man/package_file.Rd index 2b2fc65..2267e56 100644 --- a/man/package_file.Rd +++ b/man/package_file.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/package.R +% Please edit documentation in R/helpers_package.R \name{package_file} \alias{package_file} \title{Find file in a package.} diff --git a/man/parse_deps.Rd b/man/parse_deps.Rd index f2478be..9b57975 100644 --- a/man/parse_deps.Rd +++ b/man/parse_deps.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/package-deps.R +% Please edit documentation in R/helpers_package.R \name{parse_deps} \alias{parse_deps} \title{Parse package dependency strings.} diff --git a/man/use_analysis.Rd b/man/use_analysis.Rd index fa756d5..9de9829 100644 --- a/man/use_analysis.Rd +++ b/man/use_analysis.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hello.R +% Please edit documentation in R/core_use_analysis.R \name{use_analysis} \alias{use_analysis} \alias{add_analysis} diff --git a/man/use_build_ignore.Rd b/man/use_build_ignore.Rd index 87bf909..0150b21 100644 --- a/man/use_build_ignore.Rd +++ b/man/use_build_ignore.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/infrastructure.R +% Please edit documentation in R/helpers_infrastructure.R \name{use_build_ignore} \alias{use_build_ignore} \alias{add_build_ignore} diff --git a/man/use_circleci.Rd b/man/use_circleci.Rd index d6f6f8f..d260796 100644 --- a/man/use_circleci.Rd +++ b/man/use_circleci.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hello.R +% Please edit documentation in R/core_use_circleci.R \name{use_circleci} \alias{use_circleci} \title{Add a circleci config file} diff --git a/man/use_compendium.Rd b/man/use_compendium.Rd index b496a92..8d586a3 100644 --- a/man/use_compendium.Rd +++ b/man/use_compendium.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hello.R +% Please edit documentation in R/core_use_compendium.R \name{use_compendium} \alias{use_compendium} \title{Creates an R package suitable to use as a research compendium, and diff --git a/man/use_dockerfile.Rd b/man/use_dockerfile.Rd index 00febeb..9cd7a6b 100644 --- a/man/use_dockerfile.Rd +++ b/man/use_dockerfile.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hello.R +% Please edit documentation in R/core_use_dockerfile.R \name{use_dockerfile} \alias{use_dockerfile} \title{Add a Dockerfile} diff --git a/man/use_git.Rd b/man/use_git.Rd deleted file mode 100644 index a4f0425..0000000 --- a/man/use_git.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/infrastructure-git.R -\name{use_git} -\alias{use_git} -\title{Initialise a git repository.} -\usage{ -use_git(message = "Initial commit", pkg = ".") -} -\arguments{ -\item{message}{Message to use for first commit.} - -\item{pkg}{Path to package. See \code{\link{as.package}} for more -information.} -} -\description{ -Initialise a git repository. -} -\examples{ -\dontrun{use_git()} -} -\seealso{ -Other git infrastructure: \code{\link{use_git_hook}}, - \code{\link{use_github_links}}, \code{\link{use_github}} -} -\concept{git infrastructure} diff --git a/man/use_git_hook.Rd b/man/use_git_hook.Rd index d3950f9..3e98dc1 100644 --- a/man/use_git_hook.Rd +++ b/man/use_git_hook.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/infrastructure-git.R +% Please edit documentation in R/helpers_git.R \name{use_git_hook} \alias{use_git_hook} \title{Add a git hook.} @@ -13,16 +13,12 @@ use_git_hook(hook, script, pkg = ".") "post-merge", "pre-push", "pre-auto-gc".} \item{script}{Text of script to run} - -\item{pkg}{Path to package. See \code{\link{as.package}} for more -information.} } \description{ Add a git hook. } \seealso{ -Other git infrastructure: \code{\link{use_github_links}}, - \code{\link{use_github}}, \code{\link{use_git}} +Other git infrastructure: \code{\link{use_github_links}} } \concept{git infrastructure} \keyword{internal} diff --git a/man/use_git_quietly.Rd b/man/use_git_quietly.Rd index c86c5a6..cff8827 100644 --- a/man/use_git_quietly.Rd +++ b/man/use_git_quietly.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/git.R +% Please edit documentation in R/helpers_git.R \name{use_git_quietly} \alias{use_git_quietly} \title{Initialise a git repository without asking questions} diff --git a/man/use_github.Rd b/man/use_github.Rd deleted file mode 100644 index fbb9141..0000000 --- a/man/use_github.Rd +++ /dev/null @@ -1,76 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/infrastructure-git.R -\name{use_github} -\alias{use_github} -\title{Connect a local repo with GitHub.} -\usage{ -use_github(auth_token = github_pat(), private = FALSE, pkg = ".", - host = "https://api.github.com", protocol = c("ssh", "https"), - credentials = NULL) -} -\arguments{ -\item{auth_token}{Provide a personal access token (PAT) from -\url{https://github.com/settings/tokens}. Defaults to the \code{GITHUB_PAT} -environment variable.} - -\item{private}{If \code{TRUE}, creates a private repository.} - -\item{pkg}{Path to package. See \code{\link{as.package}} for more -information.} - -\item{host}{GitHub API host to use. Override with the endpoint-root for your -GitHub enterprise instance, for example, -"https://github.hostname.com/api/v3".} - -\item{protocol}{transfer protocol, either "ssh" (the default) or "https"} - -\item{credentials}{A \code{\link[git2r]{cred_ssh_key}} specifying specific -ssh credentials or NULL for default ssh key and ssh-agent behaviour. -Default is NULL.} -} -\description{ -If the current repo does not use git, calls \code{\link{use_git}} -automatically. \code{\link{use_github_links}} is called to populate the -\code{URL} and \code{BugReports} fields of DESCRIPTION. -} -\section{Authentication}{ - - - A new GitHub repo will be created via the GitHub API, therefore you must - provide a GitHub personal access token (PAT) via the argument - \code{auth_token}, which defaults to the value of the \code{GITHUB_PAT} - environment variable. Obtain a PAT from - \url{https://github.com/settings/tokens}. The "repo" scope is required - which is one of the default scopes for a new PAT. - - The argument \code{protocol} reflects how you wish to authenticate with - GitHub for this repo in the long run. For either \code{protocol}, a remote - named "origin" is created, an initial push is made using the specified - \code{protocol}, and a remote tracking branch is set. The URL of the - "origin" remote has the form \code{git@github.com:/.git} - (\code{protocol = "ssh"}, the default) or - \code{https://github.com//.git} (\code{protocol = - "https"}). For \code{protocol = "ssh"}, it is assumed that public and - private keys are in the default locations, \code{~/.ssh/id_rsa.pub} and - \code{~/.ssh/id_rsa}, respectively, and that \code{ssh-agent} is configured - to manage any associated passphrase. Alternatively, specify a - \code{\link[git2r]{cred_ssh_key}} object via the \code{credentials} - parameter. -} - -\examples{ -\dontrun{ -## to use default ssh protocol -create("testpkg") -use_github(pkg = "testpkg") - -## or use https -create("testpkg2") -use_github(pkg = "testpkg2", protocol = "https") -} -} -\seealso{ -Other git infrastructure: \code{\link{use_git_hook}}, - \code{\link{use_github_links}}, \code{\link{use_git}} -} -\concept{git infrastructure} diff --git a/man/use_github_links.Rd b/man/use_github_links.Rd index c7b4657..71a23b8 100644 --- a/man/use_github_links.Rd +++ b/man/use_github_links.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/infrastructure-git.R +% Please edit documentation in R/helpers_github.R \name{use_github_links} \alias{use_github_links} \title{Add GitHub links to DESCRIPTION.} @@ -8,9 +8,6 @@ use_github_links(pkg = ".", auth_token = github_pat(), host = "https://api.github.com") } \arguments{ -\item{pkg}{Path to package. See \code{\link{as.package}} for more -information.} - \item{auth_token}{Provide a personal access token (PAT) from \url{https://github.com/settings/tokens}. Defaults to the \code{GITHUB_PAT} environment variable.} @@ -26,8 +23,7 @@ Populates the URL and BugReports fields of DESCRIPTION with those fields already exist. } \seealso{ -Other git infrastructure: \code{\link{use_git_hook}}, - \code{\link{use_github}}, \code{\link{use_git}} +Other git infrastructure: \code{\link{use_git_hook}} } \concept{git infrastructure} \keyword{internal} diff --git a/man/use_readme_rmd.Rd b/man/use_readme_rmd.Rd index 371c388..be7a53f 100644 --- a/man/use_readme_rmd.Rd +++ b/man/use_readme_rmd.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hello.R +% Please edit documentation in R/core_use_readme_rmd.R \name{use_readme_rmd} \alias{use_readme_rmd} \title{Creates skeleton README files} diff --git a/man/use_travis.Rd b/man/use_travis.Rd index 481550d..688914f 100644 --- a/man/use_travis.Rd +++ b/man/use_travis.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hello.R +% Please edit documentation in R/core_use_travis.R \name{use_travis} \alias{use_travis} \alias{add_travis} From bedd28785f63a33923da8260abc0f9c4e82a1abe Mon Sep 17 00:00:00 2001 From: nevrome Date: Mon, 24 Jun 2019 23:37:42 +0200 Subject: [PATCH 04/12] small refactoring steps --- R/core_create_compendium.R | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/R/core_create_compendium.R b/R/core_create_compendium.R index 4230ce9..a50e171 100644 --- a/R/core_create_compendium.R +++ b/R/core_create_compendium.R @@ -9,15 +9,21 @@ #' @importFrom usethis use_mit_license use_git #' @export -create_compendium <- function(pkgname, data_in_git = TRUE){ +create_compendium <- function(pkgname, data_in_git = TRUE) { + + # create new project rrtools::use_compendium(pkgname) + # move us into the new project setwd(pkgname) - my_name <- usethis::use_git_config()$`user.name` - usethis::use_mit_license(name = my_name) + + # initialize the new project with useful features + usethis::use_mit_license(name = usethis::use_git_config()$`user.name`) rrtools::use_readme_rmd() rrtools::use_git_quietly() rrtools::use_analysis(data_in_git = data_in_git) + + # install the package and its dependencies devtools::install(quiet = TRUE) } From 077aaa3f90d17cb4d92855801c11ccdbf79201e0 Mon Sep 17 00:00:00 2001 From: nevrome Date: Mon, 24 Jun 2019 23:53:00 +0200 Subject: [PATCH 05/12] more work on the reorganisation of helper functions --- R/core_use_analysis.R | 55 ++++++++++++ R/core_use_readme_rmd.R | 17 ++++ R/helpers_file_system.R | 27 ++++++ R/helpers_general.R | 173 ------------------------------------- R/helpers_infrastructure.R | 3 + R/helpers_templates.R | 73 ++++++++++++++++ 6 files changed, 175 insertions(+), 173 deletions(-) create mode 100644 R/helpers_file_system.R delete mode 100644 R/helpers_general.R create mode 100644 R/helpers_templates.R diff --git a/R/core_use_analysis.R b/R/core_use_analysis.R index ca81834..8dc78ad 100644 --- a/R/core_use_analysis.R +++ b/R/core_use_analysis.R @@ -67,3 +67,58 @@ use_analysis <- function(pkg = ".", location = "top_level", template = 'paper.Rm invisible(TRUE) } + + + +#### directly related helpers #### + +create_directories <- function(location, pkg){ + + if (location %in% c("analysis", "vignettes", "inst")) { + usethis::ui_done("Creating {usethis::ui_value(location)} directory and contents") + use_directory(location, pkg = pkg) + use_directory(paste0(location, "/paper"), pkg = pkg) + use_directory(paste0(location, "/figures"), pkg = pkg) + use_directory(paste0(location, "/templates"), pkg = pkg) + use_directory(paste0(location, "/data"), pkg = pkg) + use_directory(paste0(location, "/data/raw_data"), pkg = pkg) + use_directory(paste0(location, "/data/derived_data"), pkg = pkg) + + # create a file that inform of best practices + invisible(file.create(paste0(pkg$path, "/", location, "/data/DO-NOT-EDIT-ANY-FILES-IN-HERE-BY-HAND"))) + + # move templates for MS Word output + invisible(file.copy(from = list.files(system.file("templates/word_templates/", + package = "rrtools", + mustWork = TRUE), + full.names = TRUE), + to = paste0(pkg$path, "/", location, "/templates"), + recursive = TRUE)) + + # move csl file + invisible(file.copy(from = system.file("templates/journal-of-archaeological-science.csl", + package = "rrtools", + mustWork = TRUE), + to = paste0(pkg$path, "/", location, "/templates"), + recursive = TRUE)) + + + # move bib file in there also + use_template("references.bib", pkg = pkg, data = gh, + out_path = file.path(location, "paper")) + + } else # else do this.. + { + # BM: I think we want to let the user have some more control + # over this, and leave thesis/book out of here? + # message("* Creating ", location, "/ directory and contents") + # use_directory(location, pkg = pkg) + # invisible(file.copy(from = system.file("templates/thesis_template/.", + # package = "rrtools", + # mustWork = TRUE), + # to = paste0(location), + # recursive = TRUE)) + + + } +} diff --git a/R/core_use_readme_rmd.R b/R/core_use_readme_rmd.R index ed7585d..cc9cdea 100644 --- a/R/core_use_readme_rmd.R +++ b/R/core_use_readme_rmd.R @@ -61,3 +61,20 @@ use_readme_rmd <- function(pkg = ".", render_readme = TRUE) { invisible(TRUE) } + + + +#### directly related helpers #### + +use_code_of_conduct <- function(pkg){ + pkg <- as.package(pkg) + use_template("CONDUCT.md", ignore = TRUE, pkg = pkg, + out_path = "") +} + +use_contributing <- function(pkg){ + pkg <- as.package(pkg) + gh <- github_info(pkg$path) + use_template("CONTRIBUTING.md", ignore = TRUE, pkg = pkg, data = gh, + out_path = "") +} diff --git a/R/helpers_file_system.R b/R/helpers_file_system.R new file mode 100644 index 0000000..a17ed34 --- /dev/null +++ b/R/helpers_file_system.R @@ -0,0 +1,27 @@ +# Given the name or vector of names, returns a named vector reporting +# whether each exists and is a directory. +dir.exists <- function(x) { + res <- file.exists(x) & file.info(x)$isdir + stats::setNames(res, x) +} + +use_directory <- function(path, ignore = FALSE, pkg = ".") { + pkg <- as.package(pkg) + pkg_path <- file.path(pkg$path, path) + + if (file.exists(pkg_path)) { + if (!is_dir(pkg_path)) { + stop("`", path, "` exists but is not a directory.", call. = FALSE) + } + } else { + usethis::ui_done("Creating {usethis::ui_value(path)}") + dir.create(pkg_path, showWarnings = FALSE, recursive = TRUE, mode = "0777") + } + + if (ignore) { + usethis::ui_done("Adding {usethis::ui_value(path)} to `.Rbuildignore`") + use_build_ignore(path, pkg = pkg) + } + + invisible(TRUE) +} diff --git a/R/helpers_general.R b/R/helpers_general.R deleted file mode 100644 index 2916e84..0000000 --- a/R/helpers_general.R +++ /dev/null @@ -1,173 +0,0 @@ -# helpers, not exported ------------------------------------------------------- - -use_code_of_conduct <- function(pkg){ - pkg <- as.package(pkg) - use_template("CONDUCT.md", ignore = TRUE, pkg = pkg, - out_path = "") -} - -use_contributing <- function(pkg){ - pkg <- as.package(pkg) - gh <- github_info(pkg$path) - use_template("CONTRIBUTING.md", ignore = TRUE, pkg = pkg, data = gh, - out_path = "") -} - - -# Given the name or vector of names, returns a named vector reporting -# whether each exists and is a directory. -dir.exists <- function(x) { - res <- file.exists(x) & file.info(x)$isdir - stats::setNames(res, x) -} - - -use_template <- function(template, save_as = template, data = list(), - ignore = FALSE, open = FALSE, pkg = ".", - out_path, ask = TRUE) { - pkg <- as.package(pkg) - - path <- file.path(pkg$path, out_path, save_as) - if (!can_overwrite(path, ask = ask)) { - stop("`", save_as, "` already exists.", call. = FALSE) - } - - template_path <- template_path_fn(template) - - template_out <- whisker::whisker.render(readLines(template_path), data) - - usethis::ui_done("Creating {usethis::ui_value(save_as)} from template.") - writeLines(template_out, path) - - if (ignore) { - usethis::ui_done("Adding {usethis::ui_value(save_as)} to `.Rbuildignore`.") - use_build_ignore(save_as, pkg = pkg) - } - - if (open) { - usethis::ui_todo("Modify ", usethis::ui_value(save_as)) - open_in_rstudio(path) - } - - invisible(TRUE) -} - -use_directory <- function(path, ignore = FALSE, pkg = ".") { - pkg <- as.package(pkg) - pkg_path <- file.path(pkg$path, path) - - if (file.exists(pkg_path)) { - if (!is_dir(pkg_path)) { - stop("`", path, "` exists but is not a directory.", call. = FALSE) - } - } else { - usethis::ui_done("Creating {usethis::ui_value(path)}") - dir.create(pkg_path, showWarnings = FALSE, recursive = TRUE, mode = "0777") - } - - if (ignore) { - usethis::ui_done("Adding {usethis::ui_value(path)} to `.Rbuildignore`") - use_build_ignore(path, pkg = pkg) - } - - invisible(TRUE) -} - - -create_directories <- function(location, pkg){ - - if (location %in% c("analysis", "vignettes", "inst")) { - usethis::ui_done("Creating {usethis::ui_value(location)} directory and contents") - use_directory(location, pkg = pkg) - use_directory(paste0(location, "/paper"), pkg = pkg) - use_directory(paste0(location, "/figures"), pkg = pkg) - use_directory(paste0(location, "/templates"), pkg = pkg) - use_directory(paste0(location, "/data"), pkg = pkg) - use_directory(paste0(location, "/data/raw_data"), pkg = pkg) - use_directory(paste0(location, "/data/derived_data"), pkg = pkg) - - # create a file that inform of best practices - invisible(file.create(paste0(pkg$path, "/", location, "/data/DO-NOT-EDIT-ANY-FILES-IN-HERE-BY-HAND"))) - - # move templates for MS Word output - invisible(file.copy(from = list.files(system.file("templates/word_templates/", - package = "rrtools", - mustWork = TRUE), - full.names = TRUE), - to = paste0(pkg$path, "/", location, "/templates"), - recursive = TRUE)) - - # move csl file - invisible(file.copy(from = system.file("templates/journal-of-archaeological-science.csl", - package = "rrtools", - mustWork = TRUE), - to = paste0(pkg$path, "/", location, "/templates"), - recursive = TRUE)) - - - # move bib file in there also - use_template("references.bib", pkg = pkg, data = gh, - out_path = file.path(location, "paper")) - - } else # else do this.. - { - # BM: I think we want to let the user have some more control - # over this, and leave thesis/book out of here? - # message("* Creating ", location, "/ directory and contents") - # use_directory(location, pkg = pkg) - # invisible(file.copy(from = system.file("templates/thesis_template/.", - # package = "rrtools", - # mustWork = TRUE), - # to = paste0(location), - # recursive = TRUE)) - - - } -} - - -use_paper_rmd <- function(pkg, location, gh, template){ - - use_template("paper.Rmd", pkg = pkg, data = list(gh), - out_path = location) - - # in case we want to inject some text in the Rmd, we can do that here - rmd <- readLines(file.path(pkg$path, location, "paper.Rmd")) - # use_template doesn't seem to work for this... - writeLines(rmd, file.path(pkg$path, location, "paper.Rmd")) - closeAllConnections() - - -} - - -use_vignette_rmd <- function(location, pkg, gh, template, vignette_yml = "vignette-yaml"){ - - pkg <- as.package(pkg) - check_suggested("rmarkdown") - add_desc_package(pkg, "Suggests", "knitr") - add_desc_package(pkg, "Suggests", "rmarkdown") - add_desc_package(pkg, "VignetteBuilder", "knitr") - use_directory("vignettes", pkg = pkg) - use_git_ignore("inst/doc", pkg = pkg) - - template_path <- template_path_fn(template) - rmd <- readLines(template_path) - vignette_yml <- readLines(template_path_fn(vignette_yml)) - - # we inject a bit of vignette yml in our main paper.Rmd template: - rmd <- c(rmd[1:18], vignette_yml, rmd[19:32], paste0("\nlibrary(", pkg$package, ")"), rmd[33:length(rmd)]) - # use_template doesn't seem to work for this... - writeLines(rmd, file(paste0(location, "/paper/paper.Rmd"))) - closeAllConnections() - - open_in_rstudio(paste0(location, "/paper/paper.Rmd")) -} - - -template_path_fn <- function(template){ - system.file("templates", - template, - package = "rrtools", - mustWork = TRUE) -} diff --git a/R/helpers_infrastructure.R b/R/helpers_infrastructure.R index 63879ce..3b16b50 100644 --- a/R/helpers_infrastructure.R +++ b/R/helpers_infrastructure.R @@ -1,3 +1,6 @@ +#### helper functions +# - + # unexported fns from devtools, we include them here so # we don't have to use ::: # from https://github.com/hadley/devtools/blob/ad6f28ef9de6a02e1ea300af45d34deccc40bd2f/R/infrastructure.R diff --git a/R/helpers_templates.R b/R/helpers_templates.R new file mode 100644 index 0000000..c68173a --- /dev/null +++ b/R/helpers_templates.R @@ -0,0 +1,73 @@ +use_template <- function(template, save_as = template, data = list(), + ignore = FALSE, open = FALSE, pkg = ".", + out_path, ask = TRUE) { + pkg <- as.package(pkg) + + path <- file.path(pkg$path, out_path, save_as) + if (!can_overwrite(path, ask = ask)) { + stop("`", save_as, "` already exists.", call. = FALSE) + } + + template_path <- template_path_fn(template) + + template_out <- whisker::whisker.render(readLines(template_path), data) + + usethis::ui_done("Creating {usethis::ui_value(save_as)} from template.") + writeLines(template_out, path) + + if (ignore) { + usethis::ui_done("Adding {usethis::ui_value(save_as)} to `.Rbuildignore`.") + use_build_ignore(save_as, pkg = pkg) + } + + if (open) { + usethis::ui_todo("Modify ", usethis::ui_value(save_as)) + open_in_rstudio(path) + } + + invisible(TRUE) +} + +template_path_fn <- function(template){ + system.file("templates", + template, + package = "rrtools", + mustWork = TRUE) +} + +use_paper_rmd <- function(pkg, location, gh, template){ + + use_template("paper.Rmd", pkg = pkg, data = list(gh), + out_path = location) + + # in case we want to inject some text in the Rmd, we can do that here + rmd <- readLines(file.path(pkg$path, location, "paper.Rmd")) + # use_template doesn't seem to work for this... + writeLines(rmd, file.path(pkg$path, location, "paper.Rmd")) + closeAllConnections() + + +} + +use_vignette_rmd <- function(location, pkg, gh, template, vignette_yml = "vignette-yaml"){ + + pkg <- as.package(pkg) + check_suggested("rmarkdown") + add_desc_package(pkg, "Suggests", "knitr") + add_desc_package(pkg, "Suggests", "rmarkdown") + add_desc_package(pkg, "VignetteBuilder", "knitr") + use_directory("vignettes", pkg = pkg) + use_git_ignore("inst/doc", pkg = pkg) + + template_path <- template_path_fn(template) + rmd <- readLines(template_path) + vignette_yml <- readLines(template_path_fn(vignette_yml)) + + # we inject a bit of vignette yml in our main paper.Rmd template: + rmd <- c(rmd[1:18], vignette_yml, rmd[19:32], paste0("\nlibrary(", pkg$package, ")"), rmd[33:length(rmd)]) + # use_template doesn't seem to work for this... + writeLines(rmd, file(paste0(location, "/paper/paper.Rmd"))) + closeAllConnections() + + open_in_rstudio(paste0(location, "/paper/paper.Rmd")) +} From 70344aa79f70d9b2e7a9481f6461273197f20c24 Mon Sep 17 00:00:00 2001 From: nevrome Date: Tue, 25 Jun 2019 00:03:31 +0200 Subject: [PATCH 06/12] started to organise git and github helpers --- R/helpers_git.R | 78 +++++------------------------------------- R/helpers_github.R | 62 ++++++++++++++++++++++++++++++++- man/use_git_quietly.Rd | 1 + 3 files changed, 70 insertions(+), 71 deletions(-) diff --git a/R/helpers_git.R b/R/helpers_git.R index c768627..a6485ce 100644 --- a/R/helpers_git.R +++ b/R/helpers_git.R @@ -1,7 +1,6 @@ -# From usethis, modified to be non-interactive - #' Initialise a git repository without asking questions #' +#' From usethis, modified to be non-interactive. #' `use_git_quietly()` initialises a Git repository and adds important files to #' `.gitignore`. If user consents, it also makes an initial commit. #' @@ -38,16 +37,12 @@ usethis::ui_todo( } - -# unexported fns from devtools, we include them here so -# we don't have to use ::: # from https://github.com/hadley/devtools/blob/master/R/git.R - - uses_git <- function(path = ".") { !is.null(git2r::discover_repository(path, ceiling = 0)) } +# from https://github.com/hadley/devtools/blob/master/R/git.R # sha of most recent commit git_repo_sha1 <- function(r) { rev <- git2r::head(r) @@ -62,18 +57,21 @@ git_repo_sha1 <- function(r) { } } +# from https://github.com/hadley/devtools/blob/master/R/git.R git_sha1 <- function(n = 10, path = ".") { r <- git2r::repository(path, discover = TRUE) sha <- git_repo_sha1(r) substr(sha, 1, n) } +# from https://github.com/hadley/devtools/blob/master/R/git.R git_uncommitted <- function(path = ".") { r <- git2r::repository(path, discover = TRUE) st <- vapply(git2r::status(r), length, integer(1)) any(st != 0) } +# from https://github.com/hadley/devtools/blob/master/R/git.R git_sync_status <- function(path = ".", check_ahead = TRUE, check_behind = TRUE) { r <- git2r::repository(path, discover = TRUE) @@ -93,17 +91,13 @@ git_sync_status <- function(path = ".", check_ahead = TRUE, check_behind = TRUE) c2 <- git2r::lookup(r, git2r::branch_target(upstream)) ab <- git2r::ahead_behind(c1, c2) - # if (ab[1] > 0) - # message(ab[1], " ahead of remote") - # if (ab[2] > 0) - # message(ab[2], " behind remote") - is_ahead <- ab[[1]] != 0 is_behind <- ab[[2]] != 0 check <- (check_ahead && is_ahead) || (check_behind && is_behind) check } +# from https://github.com/hadley/devtools/blob/master/R/git.R # Retrieve the current running path of the git binary. # @param git_binary_name The name of the binary depending on the OS. git_path <- function(git_binary_name = NULL) { @@ -132,6 +126,7 @@ git_path <- function(git_binary_name = NULL) { stop("Git does not seem to be installed on your system.", call. = FALSE) } +# from https://github.com/hadley/devtools/blob/master/R/git.R git_branch <- function(path = ".") { r <- git2r::repository(path, discover = TRUE) @@ -142,64 +137,7 @@ git_branch <- function(path = ".") { git2r::head(r)@name } -# GitHub ------------------------------------------------------------------ - -uses_github <- function(path = ".") { - if (!uses_git(path)) - return(FALSE) - - r <- git2r::repository(path, discover = TRUE) - r_remote_urls <- git2r::remote_url(r) - - any(grepl("github", r_remote_urls)) -} - -github_info <- function(path = ".", remote_name = NULL) { - if (!uses_github(path)) - return(github_dummy) - - r <- git2r::repository(path, discover = TRUE) - r_remote_urls <- grep("github", remote_urls(r), value = TRUE) - - if (!is.null(remote_name) && !remote_name %in% names(r_remote_urls)) - stop("no github-related remote named ", remote_name, " found") - - remote_name <- c(remote_name, "origin", names(r_remote_urls)) - x <- r_remote_urls[remote_name] - x <- x[!is.na(x)][1] - - github_remote_parse(x) -} - -github_dummy <- list(username = "", repo = "", fullname = "/") - -remote_urls <- function(r) { - remotes <- git2r::remotes(r) - stats::setNames(git2r::remote_url(r, remotes), remotes) -} - -github_remote_parse <- function(x) { - if (length(x) == 0) return(github_dummy) - if (!grepl("github", x)) return(github_dummy) - - if (grepl("^(https|git)", x)) { - # https://github.com/hadley/devtools.git - # https://github.com/hadley/devtools - # git@github.com:hadley/devtools.git - re <- "github[^/:]*[/:]([^/]+)/(.*?)(?:\\.git)?$" - } else { - stop("Unknown GitHub repo format", call. = FALSE) - } - - m <- regexec(re, x) - match <- regmatches(x, m)[[1]] - list( - username = match[2], - repo = match[3], - fullname = paste0(match[2], "/", match[3]) - ) -} - +# from https://github.com/hadley/devtools/blob/master/R/git.R # Extract the commit hash from a git archive. Git archives include the SHA1 # hash as the comment field of the zip central directory record # (see https://www.kernel.org/pub/software/scm/git/docs/git-archive.html) diff --git a/R/helpers_github.R b/R/helpers_github.R index 8f33dcc..4caf066 100644 --- a/R/helpers_github.R +++ b/R/helpers_github.R @@ -1,5 +1,65 @@ -# from https://raw.githubusercontent.com/hadley/devtools/26c507b128fdaa1911503348fedcf20d2dd30a1d/R/github.R +# from https://github.com/hadley/devtools/blob/master/R/git.R +uses_github <- function(path = ".") { + if (!uses_git(path)) + return(FALSE) + + r <- git2r::repository(path, discover = TRUE) + r_remote_urls <- git2r::remote_url(r) + + any(grepl("github", r_remote_urls)) +} + +# from https://github.com/hadley/devtools/blob/master/R/git.R +github_info <- function(path = ".", remote_name = NULL) { + if (!uses_github(path)) + return(github_dummy) + + r <- git2r::repository(path, discover = TRUE) + r_remote_urls <- grep("github", remote_urls(r), value = TRUE) + + if (!is.null(remote_name) && !remote_name %in% names(r_remote_urls)) + stop("no github-related remote named ", remote_name, " found") + + remote_name <- c(remote_name, "origin", names(r_remote_urls)) + x <- r_remote_urls[remote_name] + x <- x[!is.na(x)][1] + + github_remote_parse(x) +} +# from https://github.com/hadley/devtools/blob/master/R/git.R +github_dummy <- list(username = "", repo = "", fullname = "/") + +# from https://github.com/hadley/devtools/blob/master/R/git.R +remote_urls <- function(r) { + remotes <- git2r::remotes(r) + stats::setNames(git2r::remote_url(r, remotes), remotes) +} + +# from https://github.com/hadley/devtools/blob/master/R/git.R +github_remote_parse <- function(x) { + if (length(x) == 0) return(github_dummy) + if (!grepl("github", x)) return(github_dummy) + + if (grepl("^(https|git)", x)) { + # https://github.com/hadley/devtools.git + # https://github.com/hadley/devtools + # git@github.com:hadley/devtools.git + re <- "github[^/:]*[/:]([^/]+)/(.*?)(?:\\.git)?$" + } else { + stop("Unknown GitHub repo format", call. = FALSE) + } + + m <- regexec(re, x) + match <- regmatches(x, m)[[1]] + list( + username = match[2], + repo = match[3], + fullname = paste0(match[2], "/", match[3]) + ) +} + +# from https://raw.githubusercontent.com/hadley/devtools/26c507b128fdaa1911503348fedcf20d2dd30a1d/R/github.R github_auth <- function(token) { if (is.null(token)) { NULL diff --git a/man/use_git_quietly.Rd b/man/use_git_quietly.Rd index cff8827..1c8f563 100644 --- a/man/use_git_quietly.Rd +++ b/man/use_git_quietly.Rd @@ -10,6 +10,7 @@ use_git_quietly(message = "Initial commit") \item{message}{Message to use for first commit.} } \description{ +From usethis, modified to be non-interactive. `use_git_quietly()` initialises a Git repository and adds important files to `.gitignore`. If user consents, it also makes an initial commit. } From 5510db41adff3eeb06421d334400a498e0c2bbe2 Mon Sep 17 00:00:00 2001 From: nevrome Date: Tue, 25 Jun 2019 21:49:35 +0200 Subject: [PATCH 07/12] harmonization of helpers scripts --- R/helpers_file_system.R | 15 +++++++------ R/helpers_git.R | 48 ++++++++++++++--------------------------- 2 files changed, 24 insertions(+), 39 deletions(-) diff --git a/R/helpers_file_system.R b/R/helpers_file_system.R index a17ed34..de8ab92 100644 --- a/R/helpers_file_system.R +++ b/R/helpers_file_system.R @@ -1,10 +1,3 @@ -# Given the name or vector of names, returns a named vector reporting -# whether each exists and is a directory. -dir.exists <- function(x) { - res <- file.exists(x) & file.info(x)$isdir - stats::setNames(res, x) -} - use_directory <- function(path, ignore = FALSE, pkg = ".") { pkg <- as.package(pkg) pkg_path <- file.path(pkg$path, path) @@ -25,3 +18,11 @@ use_directory <- function(path, ignore = FALSE, pkg = ".") { invisible(TRUE) } + +# from https://github.com/r-lib/devtools/blob/master/R/utils.R +# Given the name or vector of names, returns a named vector reporting +# whether each exists and is a directory. +dir.exists <- function(x) { + res <- file.exists(x) & file.info(x)$isdir + stats::setNames(res, x) +} diff --git a/R/helpers_git.R b/R/helpers_git.R index a6485ce..b25e2fa 100644 --- a/R/helpers_git.R +++ b/R/helpers_git.R @@ -1,16 +1,10 @@ -#' Initialise a git repository without asking questions -#' -#' From usethis, modified to be non-interactive. -#' `use_git_quietly()` initialises a Git repository and adds important files to -#' `.gitignore`. If user consents, it also makes an initial commit. -#' -#' @param message Message to use for first commit. -#' @family git helpers -#' @export -#' @examples -#' \dontrun{ -#' use_git_quietly() -#' } +# Initialise a git repository without asking questions +# +# From usethis, modified to be non-interactive. +# `use_git_quietly()` initialises a Git repository and adds important files to +# `.gitignore`. If user consents, it also makes an initial commit. +# +# @param message Message to use for first commit. use_git_quietly <- function(message = "Initial commit") { if (uses_git()) { return(invisible()) @@ -30,11 +24,10 @@ use_git_quietly <- function(message = "Initial commit") { } -usethis::ui_todo( + usethis::ui_todo( "A restart of RStudio is required to activate the Git pane" ) invisible(TRUE) - } # from https://github.com/hadley/devtools/blob/master/R/git.R @@ -162,22 +155,13 @@ git_extract_sha1 <- function(bundle) { } } -# unexported fns from devtools, we include them here so -# we don't have to use ::: -# from -# https://raw.githubusercontent.com/hadley/devtools/6bb4b5f36cdfaee4d7e2f0a1f7f71ffeaf4aaf2f/R/infrastructure-git.R - -#' Add a git hook. -#' -#' @param hook Hook name. One of "pre-commit", "prepare-commit-msg", -#' "commit-msg", "post-commit", "applypatch-msg", "pre-applypatch", -#' "post-applypatch", "pre-rebase", "post-rewrite", "post-checkout", -#' "post-merge", "pre-push", "pre-auto-gc". -#' @param script Text of script to run -#' @inheritParams use_git -#' @export -#' @family git infrastructure -#' @keywords internal +# from https://github.com/r-lib/devtools/blob/master/R/infrastructure-git.R +# Add a git hook. +# @param hook Hook name. One of "pre-commit", "prepare-commit-msg", +# "commit-msg", "post-commit", "applypatch-msg", "pre-applypatch", +# "post-applypatch", "pre-rebase", "post-rewrite", "post-checkout", +# "post-merge", "pre-push", "pre-auto-gc". +# @param script Text of script to run use_git_hook <- function(hook, script, pkg = ".") { pkg <- as.package(pkg) @@ -196,7 +180,7 @@ use_git_hook <- function(hook, script, pkg = ".") { Sys.chmod(hook_path, "0744") } - +# from https://github.com/r-lib/devtools/blob/master/R/infrastructure-git.R use_git_ignore <- function(ignores, directory = ".", pkg = ".", quiet = FALSE) { pkg <- as.package(pkg) From 4219f973fa6eec1e7e9b8c91e09949a9da6aec15 Mon Sep 17 00:00:00 2001 From: nevrome Date: Tue, 25 Jun 2019 21:57:10 +0200 Subject: [PATCH 08/12] more harmonization and cleaning --- R/helpers_git.R | 9 ++---- R/helpers_github.R | 74 ++++++++-------------------------------------- 2 files changed, 16 insertions(+), 67 deletions(-) diff --git a/R/helpers_git.R b/R/helpers_git.R index b25e2fa..12f1e19 100644 --- a/R/helpers_git.R +++ b/R/helpers_git.R @@ -1,9 +1,7 @@ # Initialise a git repository without asking questions -# # From usethis, modified to be non-interactive. # `use_git_quietly()` initialises a Git repository and adds important files to # `.gitignore`. If user consents, it also makes an initial commit. -# # @param message Message to use for first commit. use_git_quietly <- function(message = "Initial commit") { if (uses_git()) { @@ -21,7 +19,6 @@ use_git_quietly <- function(message = "Initial commit") { usethis::ui_done("Adding files and committing") git2r::add(r, paths) git2r::commit(r, message) - } usethis::ui_todo( @@ -158,9 +155,9 @@ git_extract_sha1 <- function(bundle) { # from https://github.com/r-lib/devtools/blob/master/R/infrastructure-git.R # Add a git hook. # @param hook Hook name. One of "pre-commit", "prepare-commit-msg", -# "commit-msg", "post-commit", "applypatch-msg", "pre-applypatch", -# "post-applypatch", "pre-rebase", "post-rewrite", "post-checkout", -# "post-merge", "pre-push", "pre-auto-gc". +# "commit-msg", "post-commit", "applypatch-msg", "pre-applypatch", +# "post-applypatch", "pre-rebase", "post-rewrite", "post-checkout", +# "post-merge", "pre-push", "pre-auto-gc". # @param script Text of script to run use_git_hook <- function(hook, script, pkg = ".") { pkg <- as.package(pkg) diff --git a/R/helpers_github.R b/R/helpers_github.R index 4caf066..973f50a 100644 --- a/R/helpers_github.R +++ b/R/helpers_github.R @@ -59,7 +59,7 @@ github_remote_parse <- function(x) { ) } -# from https://raw.githubusercontent.com/hadley/devtools/26c507b128fdaa1911503348fedcf20d2dd30a1d/R/github.R +# from https://github.com/r-lib/devtools/blob/master/R/github.R github_auth <- function(token) { if (is.null(token)) { NULL @@ -68,6 +68,7 @@ github_auth <- function(token) { } } +# from https://github.com/r-lib/devtools/blob/master/R/github.R github_response <- function(req) { text <- httr::content(req, as = "text") parsed <- jsonlite::fromJSON(text, simplifyVector = FALSE) @@ -79,6 +80,7 @@ github_response <- function(req) { parsed } +# from https://github.com/r-lib/devtools/blob/master/R/github.R github_error <- function(req) { text <- httr::content(req, as = "text", encoding = "UTF-8") parsed <- tryCatch(jsonlite::fromJSON(text, simplifyVector = FALSE), @@ -97,6 +99,7 @@ github_error <- function(req) { ), class = c("condition", "error", "github_error")) } +# from https://github.com/r-lib/devtools/blob/master/R/github.R github_GET <- function(path, ..., pat = github_pat(), host = "https://api.github.com") { @@ -109,6 +112,7 @@ github_GET <- function(path, ..., pat = github_pat(), github_response(req) } +# from https://github.com/r-lib/devtools/blob/master/R/github.R github_POST <- function(path, body, ..., pat = github_pat(), host = "https://api.github.com") { @@ -121,6 +125,7 @@ github_POST <- function(path, body, ..., pat = github_pat(), github_response(req) } +# from https://github.com/r-lib/devtools/blob/master/R/github.R github_rate_limit <- function() { req <- github_GET("rate_limit") core <- req$resources$core @@ -130,21 +135,20 @@ github_rate_limit <- function() { " (Reset ", strftime(reset, "%H:%M:%S"), ")\n", sep = "") } +# from https://github.com/r-lib/devtools/blob/master/R/github.R github_commit <- function(username, repo, ref = "master") { github_GET(file.path("repos", username, repo, "commits", ref)) } +# from https://github.com/r-lib/devtools/blob/master/R/github.R github_tag <- function(username, repo, ref = "master") { github_GET(file.path("repos", username, repo, "tags", ref)) } -#' Retrieve Github personal access token. -#' -#' A github personal access token -#' Looks in env var \code{GITHUB_PAT} -#' -#' @keywords internal -#' @export +# from https://github.com/r-lib/devtools/blob/master/R/github.R +# Retrieve Github personal access token. +# A github personal access token +# Looks in env var \code{GITHUB_PAT} github_pat <- function(quiet = FALSE) { pat <- Sys.getenv("GITHUB_PAT") if (nzchar(pat)) { @@ -167,59 +171,7 @@ github_pat <- function(quiet = FALSE) { return(NULL) } +# from https://github.com/r-lib/devtools/blob/master/R/github.R in_ci <- function() { nzchar(Sys.getenv("CI")) } - -#' Add GitHub links to DESCRIPTION. -#' -#' Populates the URL and BugReports fields of DESCRIPTION with -#' \code{https://github.com//} AND -#' \code{https://github.com///issues}, respectively, unless -#' those fields already exist. -#' -#' @inheritParams use_git -#' @param auth_token Provide a personal access token (PAT) from -#' \url{https://github.com/settings/tokens}. Defaults to the \code{GITHUB_PAT} -#' environment variable. -#' @param host GitHub API host to use. Override with the endpoint-root for your -#' GitHub enterprise instance, for example, -#' "https://github.hostname.com/api/v3". -#' @family git infrastructure -#' @keywords internal -#' @export -use_github_links <- function(pkg = ".", auth_token = github_pat(), - host = "https://api.github.com") { - - if (!uses_github(pkg)) { - stop("Cannot detect that package already uses GitHub.\n", - "You might want to run use_github().") - } - - gh_info <- github_info(pkg) - pkg <- as.package(pkg) - - desc_path <- file.path(pkg$path, "DESCRIPTION") - desc <- new_desc <- read_dcf(desc_path) - - path_to_repo <- paste("repos", gh_info$fullname, sep = "/") - res <- github_GET(path = path_to_repo, pat = auth_token, host = host) - github_URL <- res$html_url - - fill <- function(d, f, filler) { - if (is.null(d[[f]]) || identical(d[[f]], "")) { - d[[f]] <- filler - } else { - message("Existing ", f, " field found and preserved") - } - d - } - new_desc <- fill(new_desc, "URL", github_URL) - new_desc <- fill(new_desc, "BugReports", file.path(github_URL, "issues")) - - if (!identical(desc, new_desc)) - write_dcf(desc_path, new_desc) - - new_desc[c("URL", "BugReports")] -} - From cbdf9e7d64dcf95b99d9d5e629d906f706e01a5f Mon Sep 17 00:00:00 2001 From: nevrome Date: Tue, 25 Jun 2019 22:34:36 +0200 Subject: [PATCH 09/12] and more --- R/helpers_file_system.R | 28 +++++ R/helpers_infrastructure.R | 210 +++---------------------------------- R/helpers_package.R | 203 ++++++++++++++++++++++++----------- R/helpers_templates.R | 37 +++++++ 4 files changed, 217 insertions(+), 261 deletions(-) diff --git a/R/helpers_file_system.R b/R/helpers_file_system.R index de8ab92..babadba 100644 --- a/R/helpers_file_system.R +++ b/R/helpers_file_system.R @@ -19,6 +19,9 @@ use_directory <- function(path, ignore = FALSE, pkg = ".") { invisible(TRUE) } +# from https://github.com/r-lib/devtools/blob/master/R/utils.R +is_dir <- function(x) file.info(x)$isdir + # from https://github.com/r-lib/devtools/blob/master/R/utils.R # Given the name or vector of names, returns a named vector reporting # whether each exists and is a directory. @@ -26,3 +29,28 @@ dir.exists <- function(x) { res <- file.exists(x) & file.info(x)$isdir stats::setNames(res, x) } + +# from https://github.com/r-lib/devtools/blob/master/R/infrastructure.R +union_write <- function(path, new_lines) { + if (file.exists(path)) { + lines <- readLines(path, warn = FALSE) + } else { + lines <- character() + } + + all <- union(lines, new_lines) + writeLines(all, path) +} + +# from https://github.com/r-lib/devtools/blob/master/R/infrastructure.R +can_overwrite <- function(path, ask = TRUE) { + name <- basename(path) + + if (!file.exists(path)) { + TRUE + } else if (ask && (interactive() && !yesno("Overwrite `", name, "`?"))) { + TRUE + } else { + FALSE + } +} diff --git a/R/helpers_infrastructure.R b/R/helpers_infrastructure.R index 3b16b50..994e690 100644 --- a/R/helpers_infrastructure.R +++ b/R/helpers_infrastructure.R @@ -1,10 +1,16 @@ -#### helper functions -# - +warning_bullet <- function() crayon::yellow(clisymbols::symbol$warning) +red_cross <- function() crayon::red(clisymbols::symbol$cross) +green_tick <- function() crayon::green(clisymbols::symbol$tick) -# unexported fns from devtools, we include them here so -# we don't have to use ::: -# from https://github.com/hadley/devtools/blob/ad6f28ef9de6a02e1ea300af45d34deccc40bd2f/R/infrastructure.R +# from http://r.789695.n4.nabble.com/Suppressing-output-e-g-from-cat-tp859876p859882.html +# capture the cat & message output +quietly <- function(x) { + sink(tempfile()) + on.exit(sink()) + invisible(force(suppressMessages(x))) +} +# from https://github.com/poissonconsulting/yesno/blob/master/R/yesno.R yesno <- function(...) { yeses <- c("Yes", "Definitely", "For sure", "Yup", "Yeah", "I agree", "Absolutely") nos <- c("No way", "Not yet", "I forget", "No", "Nope", "Uhhhh... Maybe?") @@ -16,74 +22,7 @@ yesno <- function(...) { menu(qs[rand]) != which(rand == 1) } -union_write <- function(path, new_lines) { - if (file.exists(path)) { - lines <- readLines(path, warn = FALSE) - } else { - lines <- character() - } - - all <- union(lines, new_lines) - writeLines(all, path) -} - - -add_desc_package <- function(pkg = ".", field, name) { - pkg <- as.package(pkg) - desc_path <- file.path(pkg$path, "DESCRIPTION") - - desc <- read_dcf(desc_path) - old <- desc[[field]] - if (is.null(old)) { - new <- name - changed <- TRUE - } else { - if (!grepl(paste0('\\b', name, '\\b'), old)) { - new <- paste0(old, ",\n ", name) - changed <- TRUE - } else { - changed <- FALSE - } - } - if (changed) { - desc[[field]] <- new - write_dcf(desc_path, desc) - } - invisible(changed) -} - - -#' Add a file to \code{.Rbuildignore} -#' -#' \code{.Rbuildignore} has a regular expression on each line, but it's -#' usually easier to work with specific file names. By default, will (crudely) -#' turn a filename into a regular expression that will only match that -#' path. Repeated entries will be silently removed. -#' -#' @param pkg package description, can be path or package name. See -#' \code{\link{as.package}} for more information -#' @param files Name of file. -#' @param escape If \code{TRUE}, the default, will escape \code{.} to -#' \code{\\.} and surround with \code{^} and \code{$}. -#' @return Nothing, called for its side effect. -#' @export -#' @aliases add_build_ignore -#' @family infrastructure -#' @keywords internal -use_build_ignore <- function(files, escape = TRUE, pkg = ".") { - pkg <- as.package(pkg) - - if (escape) { - files <- paste0("^", gsub("\\.", "\\\\.", files), "$") - } - - path <- file.path(pkg$path, ".Rbuildignore") - union_write(path, files) - - invisible(TRUE) -} - - +# from https://github.com/r-lib/devtools/blob/master/R/infrastructure.R open_in_rstudio <- function(path) { if (!rstudioapi::isAvailable()) return() @@ -95,130 +34,7 @@ open_in_rstudio <- function(path) { } -can_overwrite <- function(path, ask = TRUE) { - name <- basename(path) - - if (!file.exists(path)) { - TRUE - } else if (ask && (interactive() && !yesno("Overwrite `", name, "`?"))) { - TRUE - } else { - FALSE - } -} - -### - -warning_bullet <- function() crayon::yellow(clisymbols::symbol$warning) -red_cross <- function() crayon::red(clisymbols::symbol$cross) -green_tick <- function() crayon::green(clisymbols::symbol$tick) - - - -# capture the cat & message output -# from http://r.789695.n4.nabble.com/Suppressing-output-e-g-from-cat-tp859876p859882.html -quietly <- function(x) { - sink(tempfile()) - on.exit(sink()) - invisible(force(suppressMessages(x))) -} - -# unexported fns from devtools, we include them here so -# we don't have to use ::: -# from https://github.com/hadley/devtools/blob/ba7a5a4abd8258c52cb156e7b26bb4bf47a79f0b/R/utils.r - - -is_dir <- function(x) file.info(x)$isdir - -render_template <- function(name, data = list()) { - path <- system.file("templates", name, package = "devtools") - template <- readLines(path) - whisker::whisker.render(template, data) -} - -read_dcf <- function(path) { - fields <- colnames(read.dcf(path)) - as.list(read.dcf(path, keep.white = fields)[1, ]) -} - -write_dcf <- function(path, desc) { - desc <- unlist(desc) - # Add back in continuation characters - desc <- gsub("\n[ \t]*\n", "\n .\n ", desc, perl = TRUE, useBytes = TRUE) - desc <- gsub("\n \\.([^\n])", "\n .\\1", desc, perl = TRUE, useBytes = TRUE) - - starts_with_whitespace <- grepl("^\\s", desc, perl = TRUE, useBytes = TRUE) - delimiters <- ifelse(starts_with_whitespace, ":", ": ") - text <- paste0(names(desc), delimiters, desc, collapse = "\n") - - # If the description file has a declared encoding, set it so nchar() works - # properly. - if ("Encoding" %in% names(desc)) { - Encoding(text) <- desc[["Encoding"]] - } - - if (substr(text, nchar(text), 1) != "\n") { - text <- paste0(text, "\n") - } - - cat(text, file = path) -} - +# from https://github.com/r-lib/devtools/blob/master/R/utils.R dots <- function(...) { eval(substitute(alist(...))) } - - -suggests_dep <- function(pkg) { - - suggests <- read_dcf(system.file("DESCRIPTION", package = "devtools"))$Suggests - deps <- parse_deps(suggests) - - found <- which(deps$name == pkg)[1L] - - if (!length(found)) { - stop(sQuote(pkg), " is not in Suggests: for devtools!", call. = FALSE) - } - deps[found, ] -} - - -is_installed <- function(pkg, version = 0) { - installed_version <- tryCatch(utils::packageVersion(pkg), error = function(e) NA) - !is.na(installed_version) && installed_version >= version -} - - - -check_suggested <- function(pkg, version = NULL, compare = NA) { - - if (is.null(version)) { - if (!is.na(compare)) { - stop("Cannot set ", sQuote(compare), " without setting ", - sQuote(version), call. = FALSE) - } - - dep <- suggests_dep(pkg) - - version <- dep$version - compare <- dep$compare - } - - if (!is_installed(pkg) || !check_dep_version(pkg, version, compare)) { - msg <- paste0(sQuote(pkg), - if (is.na(version)) "" else paste0(" >= ", version), - " must be installed for this functionality.") - - if (interactive()) { - message(msg, "\nWould you like to install it?") - if (menu(c("Yes", "No")) == 1) { - install.packages(pkg) - } else { - stop(msg, call. = FALSE) - } - } else { - stop(msg, call. = FALSE) - } - } -} - diff --git a/R/helpers_package.R b/R/helpers_package.R index 4b1542a..5930eb0 100644 --- a/R/helpers_package.R +++ b/R/helpers_package.R @@ -1,23 +1,116 @@ -# unexported fns from devtools, we include them here so -# we don't have to use ::: -# from https://raw.githubusercontent.com/hadley/devtools/26c507b128fdaa1911503348fedcf20d2dd30a1d/R/package.r - - - - -#' Coerce input to a package. -#' -#' Possible specifications of package: -#' \itemize{ -#' \item path -#' \item package object -#' } -#' @param x object to coerce to a package -#' @param create only relevant if a package structure does not exist yet: if -#' \code{TRUE}, create a package structure; if \code{NA}, ask the user -#' (in interactive mode only) -#' @export -#' @keywords internal +# from https://github.com/r-lib/usethis/blob/master/R/ignore.R +# Add a file to \code{.Rbuildignore} +# \code{.Rbuildignore} has a regular expression on each line, but it's +# usually easier to work with specific file names. By default, will (crudely) +# turn a filename into a regular expression that will only match that +# path. Repeated entries will be silently removed. +# @param pkg package description, can be path or package name. See +# \code{\link{as.package}} for more information +# @param files Name of file. +# @param escape If \code{TRUE}, the default, will escape \code{.} to +# \code{\\.} and surround with \code{^} and \code{$}. +use_build_ignore <- function(files, escape = TRUE, pkg = ".") { + pkg <- as.package(pkg) + + if (escape) { + files <- paste0("^", gsub("\\.", "\\\\.", files), "$") + } + + path <- file.path(pkg$path, ".Rbuildignore") + union_write(path, files) + + invisible(TRUE) +} + +# from https://github.com/r-lib/devtools/blob/master/R/infrastructure.R +add_desc_package <- function(pkg = ".", field, name) { + pkg <- as.package(pkg) + desc_path <- file.path(pkg$path, "DESCRIPTION") + + desc <- read_dcf(desc_path) + old <- desc[[field]] + if (is.null(old)) { + new <- name + changed <- TRUE + } else { + if (!grepl(paste0('\\b', name, '\\b'), old)) { + new <- paste0(old, ",\n ", name) + changed <- TRUE + } else { + changed <- FALSE + } + } + if (changed) { + desc[[field]] <- new + write_dcf(desc_path, desc) + } + invisible(changed) +} + +# from https://github.com/r-lib/devtools/blob/master/R/utils.R +suggests_dep <- function(pkg) { + + suggests <- read_dcf(system.file("DESCRIPTION", package = "devtools"))$Suggests + deps <- parse_deps(suggests) + + found <- which(deps$name == pkg)[1L] + + if (!length(found)) { + stop(sQuote(pkg), " is not in Suggests: for devtools!", call. = FALSE) + } + deps[found, ] +} + +# from https://github.com/r-lib/devtools/blob/master/R/utils.R +is_installed <- function(pkg, version = 0) { + installed_version <- tryCatch(utils::packageVersion(pkg), error = function(e) NA) + !is.na(installed_version) && installed_version >= version +} + +# from https://github.com/r-lib/devtools/blob/master/R/pkgload.R +check_suggested <- function(pkg, version = NULL, compare = NA) { + + if (is.null(version)) { + if (!is.na(compare)) { + stop("Cannot set ", sQuote(compare), " without setting ", + sQuote(version), call. = FALSE) + } + + dep <- suggests_dep(pkg) + + version <- dep$version + compare <- dep$compare + } + + if (!is_installed(pkg) || !check_dep_version(pkg, version, compare)) { + msg <- paste0(sQuote(pkg), + if (is.na(version)) "" else paste0(" >= ", version), + " must be installed for this functionality.") + + if (interactive()) { + message(msg, "\nWould you like to install it?") + if (menu(c("Yes", "No")) == 1) { + install.packages(pkg) + } else { + stop(msg, call. = FALSE) + } + } else { + stop(msg, call. = FALSE) + } + } +} + +# from https://github.com/r-lib/devtools/blob/master/R/package.R +# Coerce input to a package. +# Possible specifications of package: +# \itemize{ +# \item path +# \item package object +# } +# @param x object to coerce to a package +# @param create only relevant if a package structure does not exist yet: if +# \code{TRUE}, create a package structure; if \code{NA}, ask the user +# (in interactive mode only) as.package <- function(x = NULL, create = NA) { if (is.package(x)) return(x) @@ -25,20 +118,14 @@ as.package <- function(x = NULL, create = NA) { load_pkg_description(x, create = create) } -#' Find file in a package. -#' -#' It always starts by finding by walking up the path until it finds the -#' root directory, i.e. a directory containing \code{DESCRIPTION}. If it -#' cannot find the root directory, or it can't find the specified path, it -#' will throw an error. -#' -#' @param ... Components of the path. -#' @param path Place to start search for package directory. -#' @export -#' @examples -#' \dontrun{ -#' package_file("figures", "figure_1") -#' } +# from https://github.com/r-lib/devtools/blob/master/R/package.R +# Find file in a package. +# It always starts by finding by walking up the path until it finds the +# root directory, i.e. a directory containing \code{DESCRIPTION}. If it +# cannot find the root directory, or it can't find the specified path, it +# will throw an error. +# @param ... Components of the path. +# @param path Place to start search for package directory. package_file <- function(..., path = ".") { if (!is.character(path) || length(path) != 1) { stop("`path` must be a string.", call. = FALSE) @@ -64,19 +151,23 @@ package_file <- function(..., path = ".") { file.path(path, ...) } +# from https://github.com/r-lib/devtools/blob/master/R/package.R has_description <- function(path) { file.exists(file.path(path, 'DESCRIPTION')) } +# from https://github.com/r-lib/devtools/blob/master/R/package.R is_root <- function(path) { identical(path, dirname(path)) } +# from https://github.com/r-lib/devtools/blob/master/R/package.R strip_slashes <- function(x) { x <- sub("/*$", "", x) x } +# from https://github.com/r-lib/devtools/blob/master/R/package.R # Load package DESCRIPTION into convenient form. load_pkg_description <- function(path, create) { path_desc <- file.path(path, "DESCRIPTION") @@ -105,33 +196,20 @@ load_pkg_description <- function(path, create) { structure(desc, class = "package") } - -#' Is the object a package? -#' -#' @keywords internal -#' @export +# from https://github.com/r-lib/devtools/blob/master/R/package.R +# Is the object a package? is.package <- function(x) inherits(x, "package") +# from https://github.com/r-lib/devtools/blob/master/R/package.R # Mockable variant of interactive interactive <- function() .Primitive("interactive")() - -# unexported fns from devtools, we include them here so -# we don't have to use ::: -# from https://github.com/hadley/devtools/blob/26c507b128fdaa1911503348fedcf20d2dd30a1d/R/package-deps.r - -#' Parse package dependency strings. -#' -#' @param string to parse. Should look like \code{"R (>= 3.0), ggplot2"} etc. -#' @return list of two character vectors: \code{name} package names, -#' and \code{version} package versions. If version is not specified, -#' it will be stored as NA. -#' @keywords internal -#' @export -#' @examples -#' parse_deps("httr (< 2.1),\nRCurl (>= 3)") -#' # only package dependencies are returned -#' parse_deps("utils (== 2.12.1),\ntools,\nR (>= 2.10),\nmemoise") +# from https://github.com/r-lib/devtools/blob/master/R/package-deps.R +# Parse package dependency strings. +# @param string to parse. Should look like \code{"R (>= 3.0), ggplot2"} etc. +# @return list of two character vectors: \code{name} package names, +# and \code{version} package versions. If version is not specified, +# it will be stored as NA. parse_deps <- function(string) { if (is.null(string)) return() stopifnot(is.character(string), length(string) == 1) @@ -166,13 +244,11 @@ parse_deps <- function(string) { deps[names != "R", ] } - -#' Check that the version of an imported package satisfies the requirements -#' -#' @param dep_name The name of the package with objects to import -#' @param dep_ver The version of the package -#' @param dep_compare The comparison operator to use to check the version -#' @keywords internal +# from https://github.com/r-lib/devtools/blob/master/R/package-deps.R +# Check that the version of an imported package satisfies the requirements +# @param dep_name The name of the package with objects to import +# @param dep_ver The version of the package +# @param dep_compare The comparison operator to use to check the version check_dep_version <- function(dep_name, dep_ver = NA, dep_compare = NA) { if (!requireNamespace(dep_name, quietly = TRUE)) { stop("Dependency package ", dep_name, " not available.") @@ -195,4 +271,3 @@ check_dep_version <- function(dep_name, dep_ver = NA, dep_compare = NA) { } return(TRUE) } - diff --git a/R/helpers_templates.R b/R/helpers_templates.R index c68173a..bada055 100644 --- a/R/helpers_templates.R +++ b/R/helpers_templates.R @@ -71,3 +71,40 @@ use_vignette_rmd <- function(location, pkg, gh, template, vignette_yml = "vignet open_in_rstudio(paste0(location, "/paper/paper.Rmd")) } + +# from https://github.com/r-lib/devtools/blob/master/R/utils.R +render_template <- function(name, data = list()) { + path <- system.file("templates", name, package = "devtools") + template <- readLines(path) + whisker::whisker.render(template, data) +} + +# from https://github.com/r-lib/devtools/blob/master/R/utils.R +read_dcf <- function(path) { + fields <- colnames(read.dcf(path)) + as.list(read.dcf(path, keep.white = fields)[1, ]) +} + +# from https://github.com/r-lib/devtools/blob/master/R/utils.R +write_dcf <- function(path, desc) { + desc <- unlist(desc) + # Add back in continuation characters + desc <- gsub("\n[ \t]*\n", "\n .\n ", desc, perl = TRUE, useBytes = TRUE) + desc <- gsub("\n \\.([^\n])", "\n .\\1", desc, perl = TRUE, useBytes = TRUE) + + starts_with_whitespace <- grepl("^\\s", desc, perl = TRUE, useBytes = TRUE) + delimiters <- ifelse(starts_with_whitespace, ":", ": ") + text <- paste0(names(desc), delimiters, desc, collapse = "\n") + + # If the description file has a declared encoding, set it so nchar() works + # properly. + if ("Encoding" %in% names(desc)) { + Encoding(text) <- desc[["Encoding"]] + } + + if (substr(text, nchar(text), 1) != "\n") { + text <- paste0(text, "\n") + } + + cat(text, file = path) +} From 26e94d94361b748560e86c289f5491e283ee050e Mon Sep 17 00:00:00 2001 From: nevrome Date: Tue, 25 Jun 2019 22:42:04 +0200 Subject: [PATCH 10/12] more --- R/core_use_analysis.R | 35 +++++++++++++++++++++++++++++++++++ R/helpers_templates.R | 37 ------------------------------------- 2 files changed, 35 insertions(+), 37 deletions(-) diff --git a/R/core_use_analysis.R b/R/core_use_analysis.R index 8dc78ad..3319964 100644 --- a/R/core_use_analysis.R +++ b/R/core_use_analysis.R @@ -122,3 +122,38 @@ create_directories <- function(location, pkg){ } } + +use_paper_rmd <- function(pkg, location, gh, template){ + + use_template("paper.Rmd", pkg = pkg, data = list(gh), + out_path = location) + + # in case we want to inject some text in the Rmd, we can do that here + rmd <- readLines(file.path(pkg$path, location, "paper.Rmd")) + # use_template doesn't seem to work for this... + writeLines(rmd, file.path(pkg$path, location, "paper.Rmd")) + closeAllConnections() +} + +use_vignette_rmd <- function(location, pkg, gh, template, vignette_yml = "vignette-yaml"){ + + pkg <- as.package(pkg) + check_suggested("rmarkdown") + add_desc_package(pkg, "Suggests", "knitr") + add_desc_package(pkg, "Suggests", "rmarkdown") + add_desc_package(pkg, "VignetteBuilder", "knitr") + use_directory("vignettes", pkg = pkg) + use_git_ignore("inst/doc", pkg = pkg) + + template_path <- template_path_fn(template) + rmd <- readLines(template_path) + vignette_yml <- readLines(template_path_fn(vignette_yml)) + + # we inject a bit of vignette yml in our main paper.Rmd template: + rmd <- c(rmd[1:18], vignette_yml, rmd[19:32], paste0("\nlibrary(", pkg$package, ")"), rmd[33:length(rmd)]) + # use_template doesn't seem to work for this... + writeLines(rmd, file(paste0(location, "/paper/paper.Rmd"))) + closeAllConnections() + + open_in_rstudio(paste0(location, "/paper/paper.Rmd")) +} diff --git a/R/helpers_templates.R b/R/helpers_templates.R index bada055..2d0a805 100644 --- a/R/helpers_templates.R +++ b/R/helpers_templates.R @@ -35,43 +35,6 @@ template_path_fn <- function(template){ mustWork = TRUE) } -use_paper_rmd <- function(pkg, location, gh, template){ - - use_template("paper.Rmd", pkg = pkg, data = list(gh), - out_path = location) - - # in case we want to inject some text in the Rmd, we can do that here - rmd <- readLines(file.path(pkg$path, location, "paper.Rmd")) - # use_template doesn't seem to work for this... - writeLines(rmd, file.path(pkg$path, location, "paper.Rmd")) - closeAllConnections() - - -} - -use_vignette_rmd <- function(location, pkg, gh, template, vignette_yml = "vignette-yaml"){ - - pkg <- as.package(pkg) - check_suggested("rmarkdown") - add_desc_package(pkg, "Suggests", "knitr") - add_desc_package(pkg, "Suggests", "rmarkdown") - add_desc_package(pkg, "VignetteBuilder", "knitr") - use_directory("vignettes", pkg = pkg) - use_git_ignore("inst/doc", pkg = pkg) - - template_path <- template_path_fn(template) - rmd <- readLines(template_path) - vignette_yml <- readLines(template_path_fn(vignette_yml)) - - # we inject a bit of vignette yml in our main paper.Rmd template: - rmd <- c(rmd[1:18], vignette_yml, rmd[19:32], paste0("\nlibrary(", pkg$package, ")"), rmd[33:length(rmd)]) - # use_template doesn't seem to work for this... - writeLines(rmd, file(paste0(location, "/paper/paper.Rmd"))) - closeAllConnections() - - open_in_rstudio(paste0(location, "/paper/paper.Rmd")) -} - # from https://github.com/r-lib/devtools/blob/master/R/utils.R render_template <- function(name, data = list()) { path <- system.file("templates", name, package = "devtools") From c662dbcc40ca69c3694b4a6b6fb5671eda684d53 Mon Sep 17 00:00:00 2001 From: nevrome Date: Tue, 25 Jun 2019 22:43:51 +0200 Subject: [PATCH 11/12] update of documentation --- NAMESPACE | 9 --------- man/as.package.Rd | 23 ----------------------- man/check_dep_version.Rd | 19 ------------------- man/github_pat.Rd | 13 ------------- man/is.package.Rd | 12 ------------ man/package_file.Rd | 24 ------------------------ man/parse_deps.Rd | 25 ------------------------- man/use_build_ignore.Rd | 32 -------------------------------- man/use_git_hook.Rd | 24 ------------------------ man/use_git_quietly.Rd | 22 ---------------------- man/use_github_links.Rd | 29 ----------------------------- man/use_readme_rmd.Rd | 3 --- 12 files changed, 235 deletions(-) delete mode 100644 man/as.package.Rd delete mode 100644 man/check_dep_version.Rd delete mode 100644 man/github_pat.Rd delete mode 100644 man/is.package.Rd delete mode 100644 man/package_file.Rd delete mode 100644 man/parse_deps.Rd delete mode 100644 man/use_build_ignore.Rd delete mode 100644 man/use_git_hook.Rd delete mode 100644 man/use_git_quietly.Rd delete mode 100644 man/use_github_links.Rd diff --git a/NAMESPACE b/NAMESPACE index b564355..c67698a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,20 +1,11 @@ # Generated by roxygen2: do not edit by hand export(add_dependencies_to_description) -export(as.package) export(create_compendium) -export(github_pat) -export(is.package) -export(package_file) -export(parse_deps) export(use_analysis) -export(use_build_ignore) export(use_circleci) export(use_compendium) export(use_dockerfile) -export(use_git_hook) -export(use_git_quietly) -export(use_github_links) export(use_readme_rmd) export(use_travis) import(bookdown) diff --git a/man/as.package.Rd b/man/as.package.Rd deleted file mode 100644 index b5b0499..0000000 --- a/man/as.package.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers_package.R -\name{as.package} -\alias{as.package} -\title{Coerce input to a package.} -\usage{ -as.package(x = NULL, create = NA) -} -\arguments{ -\item{x}{object to coerce to a package} - -\item{create}{only relevant if a package structure does not exist yet: if -\code{TRUE}, create a package structure; if \code{NA}, ask the user -(in interactive mode only)} -} -\description{ -Possible specifications of package: -\itemize{ - \item path - \item package object -} -} -\keyword{internal} diff --git a/man/check_dep_version.Rd b/man/check_dep_version.Rd deleted file mode 100644 index f07e450..0000000 --- a/man/check_dep_version.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers_package.R -\name{check_dep_version} -\alias{check_dep_version} -\title{Check that the version of an imported package satisfies the requirements} -\usage{ -check_dep_version(dep_name, dep_ver = NA, dep_compare = NA) -} -\arguments{ -\item{dep_name}{The name of the package with objects to import} - -\item{dep_ver}{The version of the package} - -\item{dep_compare}{The comparison operator to use to check the version} -} -\description{ -Check that the version of an imported package satisfies the requirements -} -\keyword{internal} diff --git a/man/github_pat.Rd b/man/github_pat.Rd deleted file mode 100644 index 10449a6..0000000 --- a/man/github_pat.Rd +++ /dev/null @@ -1,13 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers_github.R -\name{github_pat} -\alias{github_pat} -\title{Retrieve Github personal access token.} -\usage{ -github_pat(quiet = FALSE) -} -\description{ -A github personal access token -Looks in env var \code{GITHUB_PAT} -} -\keyword{internal} diff --git a/man/is.package.Rd b/man/is.package.Rd deleted file mode 100644 index 961cdf0..0000000 --- a/man/is.package.Rd +++ /dev/null @@ -1,12 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers_package.R -\name{is.package} -\alias{is.package} -\title{Is the object a package?} -\usage{ -is.package(x) -} -\description{ -Is the object a package? -} -\keyword{internal} diff --git a/man/package_file.Rd b/man/package_file.Rd deleted file mode 100644 index 2267e56..0000000 --- a/man/package_file.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers_package.R -\name{package_file} -\alias{package_file} -\title{Find file in a package.} -\usage{ -package_file(..., path = ".") -} -\arguments{ -\item{...}{Components of the path.} - -\item{path}{Place to start search for package directory.} -} -\description{ -It always starts by finding by walking up the path until it finds the -root directory, i.e. a directory containing \code{DESCRIPTION}. If it -cannot find the root directory, or it can't find the specified path, it -will throw an error. -} -\examples{ -\dontrun{ -package_file("figures", "figure_1") -} -} diff --git a/man/parse_deps.Rd b/man/parse_deps.Rd deleted file mode 100644 index 9b57975..0000000 --- a/man/parse_deps.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers_package.R -\name{parse_deps} -\alias{parse_deps} -\title{Parse package dependency strings.} -\usage{ -parse_deps(string) -} -\arguments{ -\item{string}{to parse. Should look like \code{"R (>= 3.0), ggplot2"} etc.} -} -\value{ -list of two character vectors: \code{name} package names, - and \code{version} package versions. If version is not specified, - it will be stored as NA. -} -\description{ -Parse package dependency strings. -} -\examples{ -parse_deps("httr (< 2.1),\\nRCurl (>= 3)") -# only package dependencies are returned -parse_deps("utils (== 2.12.1),\\ntools,\\nR (>= 2.10),\\nmemoise") -} -\keyword{internal} diff --git a/man/use_build_ignore.Rd b/man/use_build_ignore.Rd deleted file mode 100644 index 0150b21..0000000 --- a/man/use_build_ignore.Rd +++ /dev/null @@ -1,32 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers_infrastructure.R -\name{use_build_ignore} -\alias{use_build_ignore} -\alias{add_build_ignore} -\title{Add a file to \code{.Rbuildignore}} -\usage{ -use_build_ignore(files, escape = TRUE, pkg = ".") -} -\arguments{ -\item{files}{Name of file.} - -\item{escape}{If \code{TRUE}, the default, will escape \code{.} to -\code{\\.} and surround with \code{^} and \code{$}.} - -\item{pkg}{package description, can be path or package name. See -\code{\link{as.package}} for more information} -} -\value{ -Nothing, called for its side effect. -} -\description{ -\code{.Rbuildignore} has a regular expression on each line, but it's -usually easier to work with specific file names. By default, will (crudely) -turn a filename into a regular expression that will only match that -path. Repeated entries will be silently removed. -} -\seealso{ -Other infrastructure: \code{\link{use_readme_rmd}} -} -\concept{infrastructure} -\keyword{internal} diff --git a/man/use_git_hook.Rd b/man/use_git_hook.Rd deleted file mode 100644 index 3e98dc1..0000000 --- a/man/use_git_hook.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers_git.R -\name{use_git_hook} -\alias{use_git_hook} -\title{Add a git hook.} -\usage{ -use_git_hook(hook, script, pkg = ".") -} -\arguments{ -\item{hook}{Hook name. One of "pre-commit", "prepare-commit-msg", -"commit-msg", "post-commit", "applypatch-msg", "pre-applypatch", -"post-applypatch", "pre-rebase", "post-rewrite", "post-checkout", -"post-merge", "pre-push", "pre-auto-gc".} - -\item{script}{Text of script to run} -} -\description{ -Add a git hook. -} -\seealso{ -Other git infrastructure: \code{\link{use_github_links}} -} -\concept{git infrastructure} -\keyword{internal} diff --git a/man/use_git_quietly.Rd b/man/use_git_quietly.Rd deleted file mode 100644 index 1c8f563..0000000 --- a/man/use_git_quietly.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers_git.R -\name{use_git_quietly} -\alias{use_git_quietly} -\title{Initialise a git repository without asking questions} -\usage{ -use_git_quietly(message = "Initial commit") -} -\arguments{ -\item{message}{Message to use for first commit.} -} -\description{ -From usethis, modified to be non-interactive. -`use_git_quietly()` initialises a Git repository and adds important files to -`.gitignore`. If user consents, it also makes an initial commit. -} -\examples{ -\dontrun{ -use_git_quietly() -} -} -\concept{git helpers} diff --git a/man/use_github_links.Rd b/man/use_github_links.Rd deleted file mode 100644 index 71a23b8..0000000 --- a/man/use_github_links.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers_github.R -\name{use_github_links} -\alias{use_github_links} -\title{Add GitHub links to DESCRIPTION.} -\usage{ -use_github_links(pkg = ".", auth_token = github_pat(), - host = "https://api.github.com") -} -\arguments{ -\item{auth_token}{Provide a personal access token (PAT) from -\url{https://github.com/settings/tokens}. Defaults to the \code{GITHUB_PAT} -environment variable.} - -\item{host}{GitHub API host to use. Override with the endpoint-root for your -GitHub enterprise instance, for example, -"https://github.hostname.com/api/v3".} -} -\description{ -Populates the URL and BugReports fields of DESCRIPTION with -\code{https://github.com//} AND -\code{https://github.com///issues}, respectively, unless -those fields already exist. -} -\seealso{ -Other git infrastructure: \code{\link{use_git_hook}} -} -\concept{git infrastructure} -\keyword{internal} diff --git a/man/use_readme_rmd.Rd b/man/use_readme_rmd.Rd index be7a53f..5c91a57 100644 --- a/man/use_readme_rmd.Rd +++ b/man/use_readme_rmd.Rd @@ -29,7 +29,4 @@ Your readme should contain: use_readme_rmd() } } -\seealso{ -Other infrastructure: \code{\link{use_build_ignore}} -} \concept{infrastructure} From 0861b50c6fc663dca63cb090cd2ed08753b0e4dc Mon Sep 17 00:00:00 2001 From: nevrome Date: Tue, 25 Jun 2019 22:48:10 +0200 Subject: [PATCH 12/12] use_git_quietly is no longer exported --- R/core_create_compendium.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/core_create_compendium.R b/R/core_create_compendium.R index a50e171..1e376c1 100644 --- a/R/core_create_compendium.R +++ b/R/core_create_compendium.R @@ -20,7 +20,7 @@ create_compendium <- function(pkgname, data_in_git = TRUE) { # initialize the new project with useful features usethis::use_mit_license(name = usethis::use_git_config()$`user.name`) rrtools::use_readme_rmd() - rrtools::use_git_quietly() + use_git_quietly() rrtools::use_analysis(data_in_git = data_in_git) # install the package and its dependencies