# Need to build a package or connect to a built package
# Post data to the package
# Connect to or create a GitHub repository for the data package
# push updates
# Create readme.md notes
# Connect to a data description repo and provide details about the package
#
#' @title Create an R package for data
#' @description This function automates the process of building a Github R package with the desired data stored in the `raw-data` folder.
#' @param package_name is the name of the created data R package.
#' @param export_folder is the base folder where the package folder will be created.
#' @param git_remote is the `HTTPS` url of the GitHub remote.
#' @param list_data is a list object of named ojbects that can be written to a csv. If NULL then no data writing actions happen.
#' @examples dd <- read_csv(system.file("extdata", "Draft_vietnam.csv", package = "DataPushR"))
#' dpr_create_package(list_data = list(dat_draft = dd), package_name = "Test3", export_folder = getwd())
#' @export
dpr_create_package <- function(package_name, export_folder = getwd(), git_remote, list_data = NULL) {
# https://www.tidyverse.org/blog/2019/05/itdepends/
# package path
ppath <- fs::path(export_folder, package_name)
# create package details
usethis::create_package(ppath, open = FALSE, rstudio = FALSE)
#usethis::local_project(ppath)
usethis::proj_set(ppath)
usethis::use_data_raw(package_name, open = FALSE)
# Now push data into the R project
raw_data_script_path <- fs::path(ppath, "data-raw", package_name, ext = "R")
raw_data_folder <- fs::path(ppath, "data-raw")
# write data if list_data has data objects if not skip.
if (!is.null(list_data)) {
temp_dir <- tempdir(check = TRUE)
temp_data_paths <- purrr::map(names(list_data),~(fs::path(temp_dir, .x, ext = "csv")))
map2(names(list_data), list_data, ~readr::write_csv(.y, fs::path(temp_dir, .x, ext = "csv")))
temp_data_paths %>% purrr::map(~dpr_export(.x,
export_format = c(".rds",".xlsx",".sav",".dta",".csv", ".json", ".sas7bdat"),
export_folder = raw_data_folder, details = FALSE))
# Remove temp files created
temp_data_paths %>% purrr::map(~fs::file_delete(.x))
# check for sizes that are too big
sizes <- fs::dir_info(raw_data_folder, recurse = TRUE) %>%
mutate(size_big = size > fs::fs_bytes("100M")) %>%
select(path, size, size_big, birth_time)
if(any(sizes$size_big)) stop("Some data files are larger than the 100M file limit for GitHub. No connection made.")
} # end data create if for list_data
proj_path <- usethis::proj_get()
repo <- git2r::init(proj_path)
dpr_push(proj_path, message = "'first push'", repo_url = git_remote)
return(proj_path)
# use_git_remote(name = "origin", url = git_remote, overwrite = FALSE)
# git2r::add(repo, "*")
# git2r::commit(repo, message = "Initial commit")
# git2r::branch_set_upstream(git2r::repository_head(repo), "origin/master")
# git2r::push(repo, credentials = git2r::cred_token())
# Could push R script text into the data-raw R script
# Could push R data objects usethis::use_data()
}
#' @title Connect to remote, Commit and Push Latest Updates to Repo
#' @param folder_dir is the folder on your local computer where you store your git repository
#' @param message is the commit message to use
#' @param repo_url is the https url from GitHub. If NULL remote connect call not run
#' @export
dpr_push <- function(folder_dir = "/Users/hathawayj/git/temp_data/Test3", message = "'First Push from Hathaway'", repo_url = NULL){
# connect git local to GitHub
git_text_remote <- glue::glue("git -C {folder} remote add origin {url}", folder = folder_dir, url = repo_url)
# The three commands to move files to github
git_add <- glue::glue("git -C {folder} add .", folder = folder_dir)
git_commit <- glue::glue("git -C {folder} commit -m {message}", folder = folder_dir, message = message)
git_push <- glue::glue("git -C {folder} push -u origin master", folder = folder_dir)
# Execute commands on system
if (!is.null(repo_url)) system(git_text_remote)
system(git_add)
system(git_commit)
system(git_push)
}
#' @title Create readme.md in repo
#' @param folder_dir is the folder on your local computer where you store your git repository
#' @param package_name is the name of the created data R package.
#' @param github_user is the Github group or user where the package is stored.
#' @export
dpr_readme <- function(folder_dir, package_name, github_user) {
install_path <- fs::path(github_user, package_name)
out <- glue::glue(
"
## --title--
The data descriptions can be found at [data.md](data.md). The [data-raw](data-raw) folder has varied data formats of the data objects that are loaded when the package is installed.
## Installation
```r
install.packages('devtools')
devtools::install_github('--github--')
```
\n\n\n
", .open = "--", .close = "--",
title = package_name, github = install_path)
cat(out, file = fs::path(folder_dir, "readme.md"), append = FALSE)
}
#' @title Github Repo Create
#' @param repo_name is the name of the created data R package and repository name.
#' @param owner_name is the name of the org or user that owns the repo.
#' @param group defaults to TRUE and uses the group POST command to a org if FALSE uses users POST command.
#' @export
dpr_create_github <- function(owner_name, repo_name, public = TRUE, group = TRUE) {
if (group) {
api_string <- glue::glue('/orgs/{ORGNAME}/repos', ORGNAME = owner_name)
} else {
api_string <- glue::glue('users/{USER}/repos', USER = owner_name)
}
gh::gh(glue::glue("POST {post}", post = api_string), name = repo_name,
private = !public, has_wiki = FALSE, auto_init = FALSE)
}
#' @title Github Repo Delete
#' @param owner_name is the Github group or user where the package is stored.
#' @param repo_name is the name of the repo to delete.
#' @export
dpr_delete_github <- function(owner_name, repo_name) {
gh::gh("DELETE /repos/:owner/:repo", owner = owner_name, repo = repo_name)
}
#' @title Github Repo Information
#' @param owner_name is the Github group or user where the package is stored.
#' @param repo_name is the name of the repo for information.
#' @examples dpr_info_github("data4legos", "byuidatascience")
#' @export
dpr_info_github <- function(owner_name, repo_name) {
gh::gh(glue::glue('GET /repos/{USER}/{repo}', USER = owner_name, repo = repo_name))
}
#' @title Write data R script
#' @param folder_dir is the folder on your local computer where you store your git repository
#' @param r_read either a path to an R script, the clipboard if `NULL`, or an `rlang::expr` object.
#' @param r_folder_write a path to a folder where the R script will be written
#' @param r_write the name of the file to write contents of `r_read`
#' @param append_file Whether to append `TRUE` or overwrite `FALSE` (default) the file `r_write`.
#' @export
dpr_write_script <- function(folder_dir, r_read = "", r_folder_write = "data-raw", r_write = "", append_file = FALSE){
# build the path for the R script in the package where code will be written.
if (r_write == "") {
path_r_write <- fs::dir_ls(fs::path(folder_dir, r_folder_write), regexp = ".R")
# stop if there is more than one R file.
if (length(path_r_write) > 1) {
stop("specify your R script as there is more than one shown in the folder")
}
} else {
path_r_write <- fs::path(folder_dir, r_folder_write, r_write)
}
# get R code to write into the path_r_write file.
if (is.null(r_read) ) {
print("writing clipboard contents")
write_text <- readr::clipboard()
} else if (is.character(r_read)) {
# Writing the saved R script
write_text <- readr::read_lines(file = r_read)
} else if (is.expression(r_script)) {
# writing an expression
write_text <- rlang::expr_text(r_read)
} else {
stop("Expecting a NULL, file path as a character string, or an rlang expression object")
}
cat(write_text, file = path_r_write, append = append_file, sep = "\n")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.