#this is the script that syncs data, or something.
git_bin <- Sys.which("git")
home_dir <- fs::path_home()
blab_data <- file.path(home_dir, "BLAB_DATA")
#' Absolute path to a dataset folder
#'
#' @param repo dataset name: 'all_basiclevel', 'reliability', etc.
#'
#' @return absolute path as a string
#'
#' @examples
#' \dontrun{
#' get_repo_path('all_basiclevel')
#' }
get_repo_path <- function(repo) {
file.path(blab_data, repo)
}
#' Run a git command in a dataset repository
#'
#' @inheritParams get_repo_path
#' @param command what you would have after `git` on the command line except
#' for the -C \<folder\> part - the function will do that part for you.
#' @param return_output boolean, whether to return the printed output of the
#' command as string
#'
#' @return string with output if return_output is TRUE, else NULL
#'
#' @examples
#' \dontrun{
#' run_git_command('all_basiclevel', 'status')
#' }
run_git_command <- function(repo, command, return_output = FALSE) {
repo_root <- get_repo_path(repo)
if (!dir.exists(repo_root)) {
stop(glue::glue(
'Expected to find the "{repo}" repository at the following location: {repo_root}. Please clone it.'))
}
process <- processx::process
cmd_args <- strsplit(command, '\\s+')[[1]]
process <- process$new(git_bin, c('-C', repo_root, cmd_args),
stdout = "|", stderr = "|")
process$wait()
exit_status <- process$get_exit_status()
if (exit_status != 0) {
error_message <- paste("Error executing git command:\n\n",
command,
"\n\nError message:\n\n",
process$read_error())
stop(error_message)
}
if (return_output) {
# Split the output into lines for consistency with the previous version that
# used system2
output_lines <- strsplit(process$read_output(), "\n")[[1]]
return(output_lines)
}
}
#' Fetches dataset tags from GitHub
#'
#' @inheritParams get_repo_path
#'
#' @return NULL
#'
#' @examples
#' \dontrun{
#' update_tags('all_basiclevel')
#' }
update_tags <- function(repo) {
run_git_command(repo, 'fetch --tags --prune --prune-tags')
}
#' Download the dataset version specified by a tag
#'
#' @inheritParams get_repo_path
#' @param tag tag label as a string
#'
#' @return NULL
#'
#' @keywords internal
#'
#' @examples
#' \dontrun{
#' checkout_tag('all_basiclevel', '0.1.0')
#' }
checkout_tag <- function(repo, tag) {
# --quiet suppresses message about where HEAD was/is
run_git_command(repo, glue::glue('checkout tags/{tag} --quiet'))
}
#' Finds the latest version tag
#'
#' @inheritParams get_repo_path
#' @param tags_already_updated boolean, have the repository tags been updated
#' recently? Avoids unnecessary fetching of the tags when multiple functions
#' that use tags are called in succession.
#'
#' @return The latest version tag as a string
#'
#' @examples
#' \dontrun{
#' get_latest_tag('all_basiclevel')
#' }
get_latest_tag <- function(repo, tags_already_updated = FALSE) {
if (!tags_already_updated) {update_tags(repo)}
versions <- run_git_command(repo, 'tag --sort version:refname',
return_output = TRUE)
last_version <- tail(versions, 1)
return(last_version)
}
#' List tags in the dataset repository
#' @noRd
get_tags <- function(repo, tags_already_updated = tags_already_updated) {
if (!tags_already_updated) {update_tags(repo)}
run_git_command(repo, 'tag --list', return_output = TRUE)
}
#' Find tag label of the currently checked out commit.
#'
#' @inherit get_latest_tag params return
#'
#' @examples
#' \dontrun{
#' all_bl <- get_all_basiclevel(version = '0.0.7')
#' current_tag <- get_current_tag('all_basiclevel')
#' stopifnot(current_tag == '0.0.7')
#' }
get_current_tag <- function(repo, tags_already_updated = FALSE) {
if (!tags_already_updated) {update_tags(repo)}
run_git_command(repo, 'describe --tags', return_output = TRUE)
}
#' Get the date of the currently checked out commit
#'
#' @inheritParams get_latest_tag
#'
#' @return A string with the date.
#'
#' @examples
#'
#' \dontrun{
#' get_current_commit_date('all_basiclevel')
#' }
get_current_commit_date <- function(repo) {
current_commit <- run_git_command(repo = repo, command = 'rev-parse HEAD',
return_output = TRUE)
commit_date <- run_git_command(
repo = repo,
command = glue::glue('show -s --format=%ci {current_commit}'),
return_output = TRUE)
return(commit_date)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.