#' Create a gist via git instead of the GitHub Gists HTTP API
#'
#' @export
#'
#' @template args
#' @param artifacts (logical/character) Include artifacts or not.
#' If `TRUE`, includes all artifacts. Or you can pass in a file extension
#' to only upload artifacts of certain file exensions. Default: `FALSE`
#' @param git_method (character) One of ssh (default) or https. If a remote
#' already exists, we use that remote, and this parameter is ignored.
#' @param sleep (integer) Seconds to sleep after creating gist, but before
#' collecting metadata on the gist. If uploading a lot of stuff, you may want to
#' set this to a higher value, otherwise, you may not get accurate metadata for
#' your gist. You can of course always refresh afterwards by calling `gist`
#' with your gist id.
#'
#' @details Note that when `browse=TRUE` there is a slight delay in when
#' we open up the gist in your default browser and when the data will display
#' in the gist. We could have this function sleep a while and guess when it
#' will be ready, but instead we open your gist right after we're done sending
#' the data to GitHub. Make sure to refresh the page if you don't see your
#' content right away.
#'
#' Likewise, the object that is returned from this function call may not have
#' the updated and correct file information. You can retrieve that easily by
#' calling [gist()] with the gist id.
#'
#' This function uses git instead of the HTTP API, and thus requires
#' the R package `git2r`. If you don't have `git2r` installed, and
#' try to use this function, it will stop and tell you to install `git2r`.
#'
#' This function using git is better suited than [gist_create()]
#' for use cases involving:
#'
#' - Big files - The GitHub API allows only files of up to 1 MB in size.
#' Using git we can get around that limit.
#' - Binary files - Often artifacts created are binary files like
#' `.png`. The GitHub API doesn't allow transport of binary files, but
#' we can do that with git.
#'
#' Another difference between this function and [gist_create()] is
#' that this function can collect all artifacts coming out of a knit process.
#'
#' If a gist is somehow deleted, or the remote changes, when you try to push
#' to the same gist again, everything should be fine. We now use
#' `tryCatch` on the push attempt, and if it fails, we'll add a new
#' remote (which means a new gist), and push again.
#'
#' @seealso [gist_create()], [gist_create_obj()]
#'
#' @examples \dontrun{
#' # prepare a directory and a file
#' unlink("~/gitgist", recursive = TRUE)
#' dir.create("~/gitgist")
#' file <- system.file("examples", "stuff.md", package = "gistr")
#' writeLines(readLines(file), con = "~/gitgist/stuff.md")
#'
#' # create a gist
#' gist_create_git(files = "~/gitgist/stuff.md")
#'
#' ## more than one file can be passed in
#' unlink("~/gitgist2", recursive = TRUE)
#' dir.create("~/gitgist2")
#' file.copy(file, "~/gitgist2/")
#' cat("hello world", file = "~/gitgist2/hello_world.md")
#' list.files("~/gitgist2")
#' gist_create_git(c("~/gitgist2/stuff.md", "~/gitgist2/hello_world.md"))
#'
#' # Include all files in a directory
#' unlink("~/gitgist3", recursive = TRUE)
#' dir.create("~/gitgist3")
#' cat("foo bar", file="~/gitgist3/foobar.txt")
#' cat("hello", file="~/gitgist3/hello.txt")
#' list.files("~/gitgist3")
#' gist_create_git("~/gitgist3")
#'
#' # binary files
#' png <- system.file("examples", "file.png", package = "gistr")
#' unlink("~/gitgist4", recursive = TRUE)
#' dir.create("~/gitgist4")
#' file.copy(png, "~/gitgist4/")
#' list.files("~/gitgist4")
#' gist_create_git(files = "~/gitgist4/file.png")
#'
#' # knit files first, then push up
#' # note: by default we don't upload images, but you can do that,
#' # see next example
#' rmd <- system.file("examples", "plots.Rmd", package = "gistr")
#' unlink("~/gitgist5", recursive = TRUE)
#' dir.create("~/gitgist5")
#' file.copy(rmd, "~/gitgist5/")
#' list.files("~/gitgist5")
#' gist_create_git("~/gitgist5/plots.Rmd", knit = TRUE)
#'
#' # collect all/any artifacts from knitting process
#' arts <- system.file("examples", "artifacts_eg1.Rmd", package = "gistr")
#' unlink("~/gitgist6", recursive = TRUE)
#' dir.create("~/gitgist6")
#' file.copy(arts, "~/gitgist6/")
#' list.files("~/gitgist6")
#' gist_create_git("~/gitgist6/artifacts_eg1.Rmd", knit = TRUE,
#' artifacts = TRUE)
#'
#' # from a code block
#' gist_create_git(code={'
#' x <- letters
#' numbers <- runif(8)
#' numbers
#'
#' [1] 0.3229318 0.5933054 0.7778408 0.3898947 0.1309717 0.7501378 0.3206379 0.3379005
#' '}, filename="my_cool_code.R")
#'
#' # Use https instead of ssh
#' png <- system.file("examples", "file.png", package = "gistr")
#' unlink("~/gitgist7", recursive = TRUE)
#' dir.create("~/gitgist7")
#' file.copy(png, "~/gitgist7/")
#' list.files("~/gitgist7")
#' gist_create_git(files = "~/gitgist7/file.png", git_method = "https")
#' }
gist_create_git <- function(files = NULL, description = "", public = TRUE,
browse = TRUE, knit = FALSE, code = NULL, filename = "code.R",
knitopts=list(), renderopts=list(), include_source = FALSE,
artifacts = FALSE, imgur_inject = FALSE, git_method = "ssh",
sleep = 1, ...) {
if (!requireNamespace("git2r", quietly = TRUE)) {
stop("Please install git2r", call. = FALSE)
}
# pick git remote method
git_method <- match.arg(git_method, c("ssh", "https"))
# code handler
if (!is.null(code)) files <- code_handler(code, filename)
files <- makefiles(files)
stopifnot(all(file.exists(files)))
stopifnot(length(unique(dirname(files))) == 1)
git <- git2r::init(dirname(files[[1]]))
# knit if TRUE
if (knit) {
allfiles <- list()
for (i in seq_along(files)) {
ff <- files[[i]]
dirpath <- dirname(ff)
orig_files <- ff
if (!is.null(code)) {
ff <- tempfile(fileext = ".Rmd")
writeLines(code, ff)
}
inject_imgur(ff, imgur_inject)
ff <- knit_render(ff, knitopts, renderopts)
if (artifacts) {
file_artifacts <- all_artifacts(ff)
ff <- c(ff, file_artifacts)
}
if (include_source) ff <- c(orig_files, ff)
allfiles[[i]] <- ff
}
allfiles <- path.expand(unlist(allfiles))
} else {
allfiles <- path.expand(files)
}
# add files
git2r_ver <- unclass(utils::packageVersion('git2r'))[[1]][2]
patttth <- if (git2r_ver >= 22) git$path else git@path
ftoadd <- gsub(sprintf("%s/?|\\./", patttth), "", allfiles)
git2r::add(git, ftoadd)
# commit files
cm <- tryCatch(git2r::commit(git, message = "added files from gistr"),
error = function(e) e)
if (inherits(cm, "error")) message(strsplit(cm$message, ":")[[1]][[2]])
# create gist
gst <- as.gist(cgist(description, public))
# add remote
if (git_method == "ssh") {
url <- sprintf("git@gist.github.com:/%s.git", gst$id)
} else {
url <- sprintf("https://gist.github.com/%s.git", gst$id)
}
ra <- tryCatch(git2r::remote_add(git, "gistr", url), error = function(e) e)
if (inherits(ra, "error")) message(strsplit(ra$message, ":")[[1]][[2]])
# push up files
push_msg <-
"Old remote not found on GitHub Gists\nAdding new remote\nRe-attempting push"
if (git_method == "ssh") {
trypush <- tryCatch(git2r::push(git, "gistr", "refs/heads/master",
force = TRUE), error = function(e) e)
if (inherits(trypush, "error")) {
message(push_msg)
git2r::remote_remove(git, "gistr")
git2r::remote_add(git, "gistr", url)
git2r::push(git, "gistr", "refs/heads/master", force = TRUE)
}
} else {
cred <- git2r::cred_env("GITHUB_USERNAME", "GITHUB_PAT")
trypush <- tryCatch(git2r::push(git, "gistr", "refs/heads/master",
force = TRUE, credentials = cred),
error = function(e) e)
if (inherits(trypush, "error")) {
message(push_msg)
git2r::remote_remove(git, "gistr")
git2r::remote_add(git, "gistr", url)
git2r::push(git, "gistr", "refs/heads/master", force = TRUE,
credentials = cred)
}
}
# wait a bit before collecting metadata
Sys.sleep(sleep)
# refresh gist metadata
gst <- gist(gst$id)
message("The file list for your gist may not be accurate if you are uploading a lot of files")
message("Refresh the gist page if your files aren't there")
# cleanup any temporary directories
# unlink(dirname(allfiles[[1]]), recursive = TRUE, force = TRUE)
# browse
if (browse) browse(gst)
return( gst )
}
makefiles <- function(x) {
if (is.null(x)) {
NULL
} else {
if (length(x) > 1) {
unname(sapply(x, unpack))
} else {
unpack(x)
}
}
}
unpack <- function(z) {
if (!file.exists(z)) stop(sprintf("'%s' does not exist", z), call. = FALSE)
if (file.info(z)$isdir) {
list.files(z, full.names = TRUE)
} else {
z
}
}
cgist <- function(description, public) {
gist_POST(
paste0(ghbase(), '/gists'),
gist_auth(),
ghead(),
body = jsonlite::toJSON(list(
description = description,
public = public,
files = list(
".gistr" = list(
content = "gistr"
)
)
), auto_unbox = TRUE),
encode = "json"
)
}
all_artifacts <- function(x) {
tmp <- list.files(dirname(x), full.names = TRUE, recursive = TRUE)
tmp[ !tmp %in% path.expand(c(x, sub("\\.md", ".Rmd", x))) ]
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.