/
z_pages.R
237 lines (232 loc) · 9.77 KB
/
z_pages.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
#' Publish a list of ggplots as interactive visualizations on a GitHub repository
#'
#' This function takes a named list of ggplots, generates interactive animations,
#' and pushes the generated files to a specified GitHub repository. You can
#' choose to keep the repository private or public.
#' Before using this function set your appropriate git 'user.username' and 'user.email'
#'
#' @param plot.list A named list of ggplots and option lists.
#' @param github_repo The name of the GitHub repository to which the
#' files will be pushed.
#' @param commit_message A string specifying the commit message for
#' the pushed files.
#' @param private A logical flag indicating whether the GitHub
#' repository should be private or not (default FALSE).
#' @param required_opts Character vector of plot.list element names
#' which are checked (stop with an error if not present). Use
#' required_opts=NULL to skip check.
#' @param ... Additional options passed onto \code{animint2dir}.
#'
#' @return The function returns the initialized GitHub repository object.
#'
#' @examples
#' \dontrun{
#' library(animint2)
#' p1 <- ggplot(mtcars, aes(x = mpg, y = wt)) +
#' geom_point()
#' p2 <- ggplot(mtcars, aes(x = hp, y = wt)) +
#' geom_point()
#' viz <- list(plot1 = p1, plot2 = p2)
#' animint2pages(
#' viz,
#' github_repo = "my_animint2_plots",
#' commit_message = "New animint",
#' private = TRUE)
#' }
#'
#' @export
animint2pages <- function(plot.list, github_repo, commit_message = "Commit from animint2pages", private = FALSE, required_opts = c("title","source"), ...) {
for(opt in required_opts){
if(!opt %in% names(plot.list)){
stop(sprintf("plot.list does not contain option named %s, which is required by animint2pages", opt))
}
}
# Check for required packages
for(pkg in c("gert", "gh")){
if (!requireNamespace(pkg)) {
stop(sprintf("Please run `install.packages('%s')` before using this function", pkg))
}
}
# Generate plot files
res <- animint2dir(plot.list, open.browser = FALSE, ...)
# Select non-ignored files to post
all_files <- Sys.glob(file.path(res$out.dir, "*"))
file_info <- file.info(all_files)
to_post <- all_files[!(file_info$size == 0 | grepl("~$", all_files))]
tryCatch({
gitcreds::gitcreds_get()
}, error = function(e) stop("A GitHub token is required to create and push to a new repository. \nTo create a GitHub token, follow these steps:\n1. Go to https://github.com/settings/tokens/new?scopes=repo&description=animint2pages\n2. Confirm your password if prompted.\n3. Ensure that the 'repo' scope is checked.\n4. Click 'Generate token' at the bottom of the page.\n5. Copy the generated token.\nAfter creating the token, you can set it up in your R environment by running: \nSys.setenv(GITHUB_PAT=\"yourGithubPAT\") \ngert::git_config_global_set(\"user.name\", \"yourUserName\") \ngert::git_config_global_set(\"user.email\", \"yourEmail\") \n"))
# Raise error if github_repo contains '/'
if (grepl("/", github_repo)) {
stop("The github_repo argument should not contain '/'.")
}
# Check for existing repository
whoami <- suppressMessages(gh::gh_whoami())
owner <- whoami[["login"]]
viz_owner_repo <- paste0(owner, "/", github_repo)
local_clone <- tempfile()
if (!check_no_github_repo(owner, github_repo)) {
create <- gh::gh("POST /user/repos", name = github_repo, private = private)
origin_url <- create$clone_url
repo <- gert::git_init(path = local_clone)
gert::git_remote_add(name = "origin", url = origin_url, repo = repo)
} else {
origin_url <- paste0("https://github.com/", viz_owner_repo, ".git")
repo <- gert::git_clone(origin_url, local_clone)
}
viz_url <- paste0("https://", owner, ".github.io/", github_repo)
# check if repo has commit, if not, give it first commit, this can avoid error
has_commits <- FALSE
try(
{
if (nrow(gert::git_log(repo = repo)) > 0) {
has_commits <- TRUE
}
},
silent = TRUE
)
if (!has_commits) {
initial_commit(local_clone, repo, viz_url)
}
# Handle gh-pages branch
manage_gh_pages(repo, to_post, local_clone, commit_message)
message(sprintf(
"Visualization will be available at %s\nDeployment via GitHub Pages may take a few minutes...", viz_url))
viz_owner_repo
}
initial_commit <- function(local_clone, repo, viz_url) {
readme_file_path <- file.path(local_clone, "README.md")
header <- "## New animint visualization\n"
url_hyperlink <- sprintf("[%s](%s)\n", viz_url, viz_url)
full_content <- paste0(header, url_hyperlink)
writeLines(full_content, readme_file_path)
gert::git_add("README.md", repo = repo)
gert::git_commit("Initial commit", repo = repo)
df_or_vec <- gert::git_branch(repo)
# check if it is a data frame or an atomic vector
if (is.data.frame(df_or_vec)) {
all_branches <- df_or_vec[["name"]]
current_master <- all_branches[df_or_vec$active]
} else {
all_branches <- df_or_vec
current_master <- df_or_vec
}
# do not attempt to rename a branch to "main" when a branch with that name already exists
if (current_master != "main" && !"main" %in% all_branches) {
gert::git_branch_move(branch = current_master, new_branch = "main", repo = repo)
}
gert::git_push(repo = repo, remote = "origin", set_upstream = TRUE)
}
manage_gh_pages <- function(repo, to_post, local_clone, commit_message) {
branches <- gert::git_branch_list(local = TRUE, repo = repo)
if (!"gh-pages" %in% branches$name) {
gert::git_branch_create(repo = repo, branch = "gh-pages")
}
gert::git_branch_checkout("gh-pages", repo = repo)
file.copy(to_post, local_clone, recursive = TRUE)
gert::git_add(files = ".", repo = repo)
gert::git_commit(message = commit_message, repo = repo)
gert::git_push(remote = "origin", set_upstream = TRUE, repo = repo, force = TRUE)
}
check_no_github_repo <- function(owner, repo) {
tryCatch(
{
gh::gh("/repos/{owner}/{repo}", owner = owner, repo = repo)
TRUE
},
"http_error_404" = function(err) FALSE
)
}
get_pages_info <- function(viz_owner_repo){
viz_dir <- tempfile()
origin_url <- paste0("https://github.com/", viz_owner_repo, ".git")
gert::git_clone(origin_url, viz_dir)
gert::git_branch_checkout("gh-pages", repo=viz_dir)
Capture.PNG <- file.path(viz_dir, "Capture.PNG")
if(!file.exists(Capture.PNG)){
stop(sprintf("gh-pages branch of %s should contain file named Capture.PNG (screenshot of data viz)", viz_owner_repo))
}
plot.json <- file.path(viz_dir, "plot.json")
jlist <- RJSONIO::fromJSON(plot.json)
commit.row <- gert::git_log(max=1, repo=viz_dir)
repo.row <- data.table(
viz_owner_repo, Capture.PNG, commit.POSIXct=commit.row$time)
to.check <- c(
source="URL of data viz source code",
title="string describing the data viz")
for(attr.name in names(to.check)){
attr.value <- jlist[[attr.name]]
if(
is.character(attr.value)
&& length(attr.value)==1
&& !is.na(attr.value)
&& nchar(attr.value)>0
){
set(repo.row, j=attr.name, value=attr.value)
}else{
stop(sprintf("plot.json file in gh-pages branch of %s should have element named %s which should be %s", viz_owner_repo, attr.name, to.check[[attr.name]]))
}
}
repo.row
}
##' A gallery is a collection of meta-data about animints that have
##' been published to github pages. A gallery is defined as a github
##' repo that should have two source files in the gh-pages branch:
##' repos.txt (list of github repositories, one owner/repo per line)
##' and index.Rmd (source for web page with links to animints). To
##' perform the update, first repos.txt is read, then we clone each
##' repo which is not already present in meta.csv, and parse meta-data
##' (title, source, Capture.PNG) from the gh-pages branch, and write
##' the meta.csv/error.csv/Capture.PNG files, render index.Rmd to
##' index.html, commit, and push origin. For an example, see the main
##' gallery, \url{https://github.com/animint/gallery/tree/gh-pages}
##' which is updated using this function.
##' @title Update gallery
##' @param gallery_path path to local github repo with gh-pages
##' active.
##' @return named list of data tables (meta and error).
##' @author Toby Dylan Hocking
##' @export
update_gallery <- function(gallery_path="~/R/gallery"){
commit.POSIXct <- title <- NULL
## Above to avoid CRAN NOTE.
repos.txt <- file.path(gallery_path, "repos.txt")
repos.dt <- fread(repos.txt,header=FALSE,col.names="viz_owner_repo")
meta.csv <- file.path(gallery_path, "meta.csv")
old.meta <- fread(meta.csv)
todo.meta <- repos.dt[!old.meta, on="viz_owner_repo"]
meta.dt.list <- list(old.meta)
error.dt.list <- list()
add.POSIXct <- Sys.time()
for(viz_owner_repo in todo.meta[["viz_owner_repo"]]){
tryCatch({
meta.row <- data.table(add.POSIXct, get_pages_info(viz_owner_repo))
meta.dt.list[[viz_owner_repo]] <- meta.row[, .(
add.POSIXct, viz_owner_repo, commit.POSIXct, source, title)]
Capture.PNG <- meta.row[["Capture.PNG"]]
repo.png <- file.path(
gallery_path, "repos", paste0(viz_owner_repo, ".png"))
user.dir <- dirname(repo.png)
dir.create(user.dir, showWarnings = FALSE, recursive = TRUE)
file.copy(Capture.PNG, repo.png, overwrite = TRUE)
}, error=function(e){
error.dt.list[[viz_owner_repo]] <<- data.table(
add.POSIXct, viz_owner_repo, error=e$message)
})
}
(meta.dt <- rbindlist(meta.dt.list))
(error.dt <- rbindlist(error.dt.list))
fwrite(meta.dt, meta.csv)
fwrite(error.dt, file.path(gallery_path, "error.csv"))
rmarkdown::render(file.path(gallery_path, "index.Rmd"))
to_add <- c(
"*.csv",
"repos.txt",
file.path("repos","*","*.png"),
"index.html",
"index.Rmd")
gert::git_add(to_add, repo=gallery_path)
gert::git_commit(paste("update", add.POSIXct), repo=gallery_path)
gert::git_push("origin", repo=gallery_path)
list(meta=meta.dt, error=error.dt)
}