R/dev-release.R

In tjpalanca/tjutils: Utilities for TJ Palanca

#' @title
#' Release Management
#'
#' @description
#' Releases as part of the continuous deployment workflow
#'
#' @name dev_release
NULL

#' @describeIn dev_release Takes the Github URL from the DESCRIPTION
#' @importFrom stringr str_split str_detect
#' @importFrom magrittr extract2
#' @importFrom purrr keep
#' @export
dev_release_gh_url <- function(envir = parent.frame()) {
    read.dcf(dev_pkg_inst("DESCRIPTION", envir = envir))[, c("URL")] %>%
        str_split(",") %>%
        extract2(1) %>%
        keep(~str_detect(., "^https://github.com"))
}

#' @describeIn dev_release
#' Returns the NEWS text for the particular package version
#' @param news_md location of NEWS.md
#' @export
dev_release_news <- function(news_md = "NEWS.md", envir = parent.frame()) {
    news_text <-
        tibble::tibble(lines = readLines(news_md)) %>%
        dplyr::mutate(
            version = dplyr::if_else(
                str_detect(lines,  glue("^# {dev_pkg_name(envir = envir)} [0-9\\.]")),
                lines, NA_character_
            ),
            version = stringr::str_replace_all(
                version,
                glue("^# {dev_pkg_name(envir = envir)} "),
                ""
            )
        ) %>%
        tidyr::fill(version) %>%
        dplyr::group_by(version) %>%
        dplyr::summarise(text = glue::glue_collapse(lines, "\n")) %>%
        dplyr::ungroup()
    if (dev_pkg_version(envir = envir) %in% news_text$version) {
        news_text %>%
            dplyr::filter(version == dev_pkg_version(envir = envir)) %>%
            dplyr::pull(text)
    } else {
        return(NULL)
    }
}

#' @describeIn dev_release Returns the github repo specification
#' @export
dev_release_gh_repo <- function(envir = parent.frame()) {
    stringr::str_replace_all(dev_release_gh_url(envir = envir),
                             "^https://github.com/", "")
}

#' @describeIn dev_release Returns a data frame of GitHub Tags
#' @export
dev_release_gh_tags <- function(envir = parent.frame()) {
    tibble::tibble(
        tags =
            gh::gh(
                glue("/repos/{dev_release_gh_repo(envir = envir)}/tags"),
                .limit = Inf
            ) %>%
            unclass()
    ) %>%
        tidyr::unnest_wider(tags)
}

#' @describeIn dev_release Returns a data frame of GitHub Releases
#' @export
dev_release_gh_releases <- function(envir = parent.frame()) {
    tibble::tibble(
        releases =
            gh::gh(
                glue("/repos/{dev_release_gh_repo(envir = envir)}/releases"),
                .limit = Inf
            ) %>%
            unclass()
    ) %>%
        tidyr::unnest_wider(releases)
}

#' @describeIn dev_release Fetches the data of an existing tag
#' @param tag github tag
#' @export
dev_release_gh_tag <- function(tag, envir = parent.frame()) {
    gh::gh(glue("GET /repos/{dev_release_gh_repo(envir = envir)}/git/refs/tags/{tag}"))
}

#' @describeIn dev_release Deletes an existing tag
#' @export
dev_release_gh_tag_delete <- function(tag, envir = parent.frame()) {
    gh::gh(glue("DELETE /repos/{dev_release_gh_repo(envir = envir)}/git/refs/tags/{tag}"))
}

#' @describeIn dev_release Determines whether a tag exists
#' @export
dev_release_gh_tag_exists <- function(tag, envir = parent.frame()) {
    !is.error(try({dev_release_gh_tag(tag, envir = envir)}, silent = TRUE))
}

#' @describeIn dev_release Fetches the data of an existing release
#' @export
dev_release_gh_release <- function(tag, envir = parent.frame()) {
    gh::gh(glue("GET /repos/{dev_release_gh_repo(envir = envir)}/releases/tags/{tag}"))
}

#' @describeIn dev_release Deletes a release associated with a tag
#' @export
dev_release_gh_release_delete <- function(tag, envir = parent.frame()) {
    gh::gh(glue("DELETE /repos/{dev_release_gh_repo(envir = envir)}/releases/",
                dev_release_gh_release(tag)$id))
}

#' @describeIn dev_release Determines whether a release exists
#' @export
dev_release_gh_release_exists <- function(tag, envir = parent.frame()) {
    !is.error(try({dev_release_gh_release(tag, envir = envir)}, silent = TRUE))
}

#' @describeIn dev_release
#' Releases the package according to the most recent version contents
#' @export
dev_release_package <- function(envir = parent.frame()) {

    # Tag is the version name
    pkg_version <- dev_pkg_version(envir = envir)
    tag <- glue("v{pkg_version}")

    # Delete the release if it exists
    if (dev_release_gh_release_exists(tag, envir = envir)) {
        dev_release_gh_release_delete(tag, envir = envir)
    }
    # Delete the tag if it exists
    if (dev_release_gh_tag_exists(tag, envir = envir)) {
        dev_release_gh_tag_delete(tag, envir = envir)
    }

    # Create the release
    pkg_name <- dev_pkg_name(envir = envir)
    gh::gh(
        glue("POST /repos/{dev_release_gh_repo(envir = envir)}/releases"),
        tag_name = tag,
        target_commitish = Sys.getenv("GITHUB_SHA", unset = "master"),
        name = glue("{pkg_name} {tag}"),
        body = as.character(dev_release_news(envir = envir)),
        draft = FALSE,
        prerelease = FALSE
    )

}