modules/grab/util.r

In ElianHugh/boxingtape: What the Package Does (One Line, Title Case)

box::use(
    here[here],
    glue[glue],
    cli[cli_h1, cli_alert, cli_alert_danger, cli_alert_success],
    jsonlite[read_json]
)

module_json <- glue(
    "{here()}/package.json"
)

#' @export
get_module_list <- function() {
    if (file.exists(module_json)) {
        return(read_json(module_json, simplifyVector = TRUE))
    } else {
        cli_alert_danger(
            glue("Package.json is missing at '{here()}'")
        )
        cli_alert(
            "Ensure you have run grab_init() or grab() before trying to retrieve modules."
        )
    }
}

#' @export
grab_check <- function() {

}

#' @title Grab module SHA
#' @description Returns the commit SHA of a module's git repo
#' @param repo A repo, such as "ElianHugh/boxingtape@master"
#' if the branch isn't specified, grabs @HEAD branch
#' @export
#' @import box
grab_SHA <- function(repo) {
    box::use(
        jsonlite[read_json],
        cli[cli_h1, cli_alert, cli_alert_warning, cli_alert_success],
        glue[glue],
        utils[download.file, URLencode, untar]
    )

    git_template <- "https://api.github.com/repos/%s/%s/commits/%s"
    input <- as.list(unlist(strsplit(repo, "[/@]")))

    if (is.null(unlist(input[3]))) {
        git_request <- URLencode(
            sprintf(
                git_template,
                input[1],
                input[2],
                "HEAD"
            )
        )
    } else {
        git_request <- URLencode(
            sprintf(
                git_template,
                input[1],
                input[2],
                input[3]
            )
        )
    }

    SHA <- read_json(git_request)$sha
    return(SHA)
}

#' @export
compare_SHA <- function(repo) {
    repoSHA <- grab_SHA(repo)
    package <- get_module_list()

    input <- as.list(unlist(strsplit(repo, "[/@]")))
    storedSHA <- package$modules[which(package$modules$moduleName == input[1] | package$modules$author
    == input[1]), ]$SHA

    if (length(storedSHA)) {
        if (storedSHA == repoSHA) {
            # SHA is up to date
            cli_alert("{input[2]} SHA is up to date.")
            invisible(return(TRUE))
        } else {
            # SHA is out of date
            cli_alert("{input[2]} SHA is out of date.")
            invisible(return(FALSE))
        }
    } else {
        # Stored SHA does not exist
        cli_alert_danger("There is no SHA stored for {input[1]}/{input[2]}.")
        invisible(return(FALSE))
    }
}

#' @export
scalar <- function(x) {
    class(x) <- c("scalar", class(x))
    x
}