R/dev-use_gha.R

In tjpalanca/tjutils: Utilities for TJ Palanca

#' @title
#' Development Utilities: Github Actions
#'
#' @description
#' Convenience functions for adding github actions workflows to the R package
#' for Continuous Integration and Deployment.
#'
#' - `dev_use_gha_dockerfile()` Adds a Dockerfile that is designed to
#'   conform to our standard Dockerfile template. This has common Linux
#'   dependencies, all the package dependencies specified in the package
#'   `DESCRIPTION` file, and current package installation.
#' - `dev_use_gha_makefile()` Adds a feature-rich Makefile that contains
#'   common commands for building, publishing and releasing the package. This
#'   is used by workflow files in Github Actions.
#' - `dev_use_gha_workflows()` Adds automerge, testing, and deployment for
#'   packages. Testing runs building of Docker image, `testthat()` test suite,
#'   `lintr` linting, and `spelling` spell checks.
#'
#' @param type type of setup (package, golem)
#' @param overwrite overwrite the files if they exist
#'
#' @name dev_use_gha
NULL

#' @describeIn dev_use_gha Setup directories
dev_use_gha_dirs <- function() {

    workflow_dir <- here(".github", "workflows")
    if (!dir.exists(workflow_dir)) {
        dir.create(workflow_dir, recursive = TRUE)
        log_info("Created .github/workflows")
    }

    scripts_dir <- here("scripts")
    if (!dir.exists(scripts_dir)) {
        dir.create(scripts_dir, recursive = TRUE)
        file.create(glue("{scripts_dir}/.gitkeep"))
        log_info("Created scripts")
    }

}

#' @describeIn dev_use_gha Setup Dockerfile
#' @export
dev_use_gha_dockerfile <- function(type, overwrite = FALSE,
                                   envir = parent.frame()) {

    assert_that(type %in% c("package", "golem"))
    dev_use_gha_dirs()

    docker_file <- here("Dockerfile")
    log_info("Creating Dockerfile")
    if (file.exists(docker_file)) {
        log_info("File already exists")
        if (overwrite) {
            write <- TRUE
            log_info("To be overwritten")
        } else {
            write <- FALSE
            log_warn("Skipping as file already exists")
        }
    } else {
        write <- TRUE
        log_info("Already exists. For safety we don't overwrite Dockerfiles")
    }

    if (write) {
        dock <- dockerfiler::Dockerfile$new(
            FROM = glue("rocker/r-ver:{version$major}.{version$minor}")
        )
        dock$MAINTAINER("TJ Palanca", "mail@tjpalanca.com")

        dock$custom("\n#", "Linux Dependencies")
        dock$RUN(glue::glue_collapse(
            c(
                "apt-get update && apt-get install -y \\",
                "    zlib1g-dev \\",
                "    libssh2-1-dev \\",
                "    libxml2-dev \\",
                "    libcurl4-openssl-dev \\",
                "    libssl-dev \\",
                "    curl \\",
                "    lbzip2 \\",
                "    libpng-dev \\",
                "    libpq-dev \\",
                "    pandoc \\",
                "    libsodium-dev \\",
                "    libxt-dev \\",
                "    libmagick++-dev"
            ),
            sep = "\n"
        ))

        dock$custom("\n#", "Package Dependencies")
        for (pkg in pkgload::pkg_desc()$get_deps()$package) {
            dock$RUN(glue("install2.r -s {pkg}"))
        }

        dock$custom("\n#", "Make package directory")
        dock$RUN(glue("mkdir -p /{dev_pkg_name(envir = envir)}",
                      .envir = list(envir = envir)))
        dock$WORKDIR(paste0("/", dev_pkg_name(envir = envir)))

        dock$custom("\n#", "Build assets")
        build_files <- purrr::keep(
            c("DESCRIPTION", "NAMESPACE", ".Rbuildignore", ".covrignore"),
            ~file.exists(here(.))
        )
        dock$COPY(build_files, build_files)
        build_dirs <- purrr::keep(
            c("data", "inst", "tests", "man", "R", "vignettes"),
            ~dir.exists(here(.))
        )
        dock$COPY(build_dirs, build_dirs)

        dock$custom("\n#", "Install package")
        dock$RUN(glue(
            'Rscript -e "devtools::install(\'.\', dependencies = TRUE, ',
            'upgrade = FALSE)"'
        ))

        dock$custom("\n#", "Post-build assets")
        post_build_dirs <- purrr::keep(
            c("scripts"),
            ~dir.exists(here(.))
        )
        dock$COPY(post_build_dirs, post_build_dirs)
        post_build_files <- purrr::keep(
            c("README.md", "README.Rmd", "NEWS.md", "_pkgdown.yml"),
            ~file.exists(here(.))
        )
        dock$COPY(post_build_files, post_build_files)

        if (type == "golem") {
            dock$custom("\n#", "Golem Command")
            dock$EXPOSE(3838)
            dock$CMD(glue(
                "Rscript -e \"",
                "options('shiny.port' = 3838, shiny.host = '0.0.0.0'); ",
                "{dev_pkg_name(envir = envir)}::run_app()\"",
                .envir = list(envir = envir)))
        }
        dock$write(here("Dockerfile"))
        log_info("Dockerfile written")
    }

}

#' @describeIn dev_use_gha Standard Makefile template
#' @export
dev_use_gha_makefile <- function(type, overwrite = FALSE,
                                 envir = parent.frame()) {

    assert_that(type %in% c("package", "golem"))
    dev_use_gha_dirs()

    make_file <- here("Makefile")
    log_info("Creating Makefile")
    dev_copy_template(
        template    = glue("Makefile-{type}"),
        destination = make_file,
        overwrite   = overwrite,
        envir = envir
    )

    log_info("Creating reexport-tjutils")
    dev_copy_template(
        template    = "reexport-tjutils.R",
        destination = here("R", "reexport-tjutils.R"),
        overwrite   = overwrite,
        envir = envir
    )

}

#' @describeIn dev_use_gha
#' Add github actions workflows for automerging, testing, and deployment that
#' confirm to github actions standards
#' @export
dev_use_gha_workflows <- function(type, overwrite = FALSE,
                                  envir = parent.frame()) {

    assert_that(type %in% c("package", "golem"))
    dev_use_gha_dirs()

    # Automerge
    dev_copy_template(
        template    = "automerge.yml",
        destination = here(".github", "workflows", "automerge.yml"),
        overwrite   = TRUE,
        envir = envir
    )

    # Testing
    dev_copy_template(
        template    = "testing.yml",
        destination = here(".github", "workflows", "testing.yml"),
        overwrite   = TRUE,
        envir = envir
    )

    # Deployment
    dev_copy_template(
        template    = glue("deployment-{type}.yml"),
        destination = here(".github", "workflows", "deployment.yml"),
        overwrite   = TRUE,
        envir = envir
    )

}