add_* and BiocBook_status

DESCRIPTION

@@ -22,6 +22,13 @@ Imports:
     gitcreds,
     httr, 
     usethis,
+    dplyr, 
+    purrr, 
+    tibble, 
+    methods, 
+    rprojroot, 
+    stringr, 
+    yaml
 Suggests:
     sessioninfo, 
     knitr, 

NAMESPACE

@@ -1,27 +1,50 @@
 # Generated by roxygen2: do not edit by hand
 
 export(BiocBook)
+export(BiocBook_status)
+export(add_chapter)
+export(add_page)
+export(add_preamble)
 export(create_BiocBook)
+exportClasses(BiocBook)
 exportMethods(chapters)
+exportMethods(path)
 exportMethods(releases)
+exportMethods(show)
+exportMethods(title)
 importFrom(available,available)
 importFrom(cli,cli_abort)
 importFrom(cli,cli_alert_info)
 importFrom(cli,cli_alert_success)
 importFrom(cli,cli_progress_message)
 importFrom(cli,cli_ul)
 importFrom(cli,pb_spin)
+importFrom(dplyr,case_when)
 importFrom(gert,git_clone)
 importFrom(gert,git_commit_all)
+importFrom(gert,git_config_global)
 importFrom(gert,git_push)
 importFrom(gert,git_remote_list)
+importFrom(gert,git_signature)
 importFrom(gh,gh_whoami)
 importFrom(gitcreds,gitcreds_get)
 importFrom(glue,glue)
 importFrom(httr,GET)
 importFrom(httr,POST)
 importFrom(httr,add_headers)
 importFrom(httr,content)
+importFrom(methods,new)
+importFrom(methods,setClass)
+importFrom(purrr,map_dfr)
+importFrom(purrr,pluck)
+importFrom(rprojroot,find_root_file)
+importFrom(rprojroot,has_file)
+importFrom(tibble,tibble)
+importFrom(tools,file_path_sans_ext)
 importFrom(usethis,git_sitrep)
 importFrom(usethis,proj_activate)
+importFrom(yaml,read_yaml)
 importMethodsFrom(BiocGenerics,path)
+importMethodsFrom(methods,show)
+importMethodsFrom(stringr,str_pad)
+importMethodsFrom(stringr,str_trunc)

R/BiocBook.R

@@ -1,3 +1,6 @@
+#' @importFrom methods setClass
+#' @exportClass BiocBook
+
 methods::setClass("BiocBook", 
     slots = c(
         title = "character", 
@@ -9,6 +12,11 @@ methods::setClass("BiocBook",
 )
 
 #' @export 
+#' @importFrom methods new
+#' @importFrom rprojroot find_root_file
+#' @importFrom rprojroot has_file
+#' @importFrom yaml read_yaml
+
 BiocBook <- function(path = '.') {
     tryCatch(
         expr = {rprojroot::find_root_file(criterion = is_biocbook, path = path)}, 
@@ -64,13 +72,39 @@ BiocBook <- function(path = '.') {
 }
 
 #' @importMethodsFrom BiocGenerics path
+#' @importMethodsFrom methods show
+#' @importFrom stringr str_trunc
+#' @importFrom stringr str_pad
 #' @exportMethod releases
 #' @exportMethod chapters
+#' @exportMethod path
+#' @exportMethod title
+#' @exportMethod show
+
 setMethod("path", signature("BiocBook"), function(object) object@local_path)
 setGeneric("releases", function(object) {standardGeneric("releases")})
 setMethod("releases", signature("BiocBook"), function(object) object@releases)
 setGeneric("chapters", function(object) {standardGeneric("chapters")})
-setMethod("chapters", signature("BiocBook"), function(object) object@chapters)
+setMethod("chapters", signature("BiocBook"), function(object) {
+    book.yml <- .find_path('inst/assets/_book.yml', object)
+    chapters <- rprojroot::find_root_file(
+        yaml::read_yaml(book.yml)$book$chapters, criterion = is_biocbook, path = path(object)
+    )
+    names(chapters) <- lapply(chapters, function(chap) {
+        has_yaml <- readLines(chap, n = 1) |> grepl("^---", x = _)
+        if (has_yaml) {
+            chaplines <- readLines(chap)
+            nlinesyaml <- which(grepl("^---", x = chaplines))[2] 
+            chaplines <- chaplines[seq(nlinesyaml + 2, length(chaplines))]
+        } 
+        else {
+            chaplines <- readLines(chap)
+        }
+        head <- gsub("^# ", "", chaplines[1])
+        head <- gsub(" \\{-\\}", "", head)
+    }) |> unlist()
+    return(chapters)
+})
 setGeneric("title", function(object) {standardGeneric("title")})
 setMethod("title", signature("BiocBook"), function(object) object@title)
 setMethod("show", signature("BiocBook"), function(object) {
@@ -92,4 +126,3 @@ setMethod("show", signature("BiocBook"), function(object) {
     )
 
 })
-

R/check.R

@@ -9,3 +9,66 @@ is_biocbook <- rprojroot::has_file("_quarto.yml", contents = "^  type: book", n
         stop("Please go to a BiocBook root directory.")
 }
 
+.find_path <- function(file, book, .from_book_root = FALSE) {
+    path <- rprojroot::find_root_file(
+        file, criterion = is_biocbook, path = path(book)
+    )
+    if (.from_book_root) {
+        path <- gsub(path(book), "", path)
+    }
+    return(path)
+}
+
+#' @importFrom tools file_path_sans_ext
+#' @importFrom purrr pluck
+#' @importFrom purrr map_dfr
+#' @importFrom tibble tibble
+#' @importFrom dplyr case_when
+#' @export
+
+BiocBook_status <- function(biocbook) {
+    purrr::map_dfr(releases(biocbook), function(release) {
+
+        GH_api <- "https://api.github.com"
+        gh_creds <- gitcreds::gitcreds_get()
+        user <- gh::gh_whoami()$login
+        email <- gert::git_config_global()$value[gert::git_config_global()$name == 'user.email']
+        sig <- gert::git_signature(name = user, email)
+        headers <- httr::add_headers(
+            Accept = "application/vnd.github+json", 
+            Authorization = glue::glue("Bearer {gh_creds$password}"), 
+            "X-GitHub-Api-Version" = "2022-11-28"
+        )
+        repo <- basename(biocbook@remote_repository) |> tools::file_path_sans_ext()
+        runs <- httr::GET(
+            glue::glue("{GH_api}/repos/{user}/{repo}/actions/runs"), 
+            headers, 
+            query = list(branch = release), 
+            encode = 'json'
+        ) |> httr::content() |> 
+            purrr::pluck(2) |>
+            purrr::map_dfr(~ {tibble::tibble(
+            branch = .x$head_branch, 
+            id = .x$id, 
+            commit = .x$head_sha, 
+            commit_message = .x$display_title, 
+            completed_at = .x$completed_at, 
+            status = .x$status, 
+            conclusion = .x$conclusion
+        )})
+        jobs_latest_run <- httr::GET(
+            glue::glue("{GH_api}/repos/{user}/{repo}/actions/runs/{runs[1, ][['id']]}/jobs"), 
+            headers, 
+            encode = 'json'
+        ) 
+        purrr::map_dfr(httr::content(jobs_latest_run)[[2]], ~ {tibble::tibble(
+            branch = .x$head_branch, 
+            name = dplyr::case_when(grepl("^Build and push", .x$name) ~ "Docker image", grepl("^Render and publish", .x$name) ~ "Website", .default = "Other"), 
+            conclusion = .x$conclusion, 
+            commit = .x$head_sha, 
+            completed_at = .x$completed_at
+        )})
+
+    })
+}
+

R/create.R

@@ -13,9 +13,11 @@
 #' @importFrom gh gh_whoami
 #' @importFrom gitcreds gitcreds_get
 #' @importFrom gert git_push
+#' @importFrom gert git_config_global
 #' @importFrom gert git_commit_all
 #' @importFrom gert git_remote_list
 #' @importFrom gert git_clone
+#' @importFrom gert git_signature
 #' @importFrom usethis proj_activate
 #' @importFrom usethis git_sitrep
 #' @export

R/pages.R

@@ -1,24 +1,45 @@
-add_preamble <- function(book, file, title) {
-    .check_biocbook_proj()
+#' @export 
+
+add_page <- function(book, file, title, position = NULL) {
+    full_path <- .find_path(glue::glue('pages/{file}'), book)
+    path_from_book_root <- .find_path(glue::glue('pages/{file}'), book, .from_book_root = TRUE)
+    path_from_book_root <- gsub("^/", "", path_from_book_root)
+    if (tools::file_ext(file) != 'qmd') {
+        cli::cli_abort("Please provide a file name ending with `.qmd`")
+        stop()
+    }
+    if (file.exists(full_path)) {
+        cli::cli_abort("File `{full_path}` already exists")
+        stop()
+    }
+
+    ## Create file in `pages/`
     writeLines(
-        text = glue::glue("# {title} {{-}}"), 
-        is_biocbook$find_file(glue::glue("pages/{file}"))
+        text = glue::glue("# {title}"), 
+        full_path 
     )
-}
-
-add_part <- function(book, part = "Part") {
-    .check_biocbook_proj()
-    book.yml <- is_biocbook$find_file(glue::glue("inst/assets/_book.yml"))
+
+    ## Add entry in `_book.yml`
+    book.yml <- .find_path('inst/assets/_book.yml', book)
     book.yml.lines <- readLines(book.yml)
-    book.yml.last <- grep("cover-image: ", book.yml.lines) - 1
-    book.yml.lines[1:book.yml.last]
+    if (is.null(position)) position <- length(chapters(book)) + 1
+    temp <- tempfile()
+    writeLines(book.yml.lines[seq(1, position+3-1)], temp)
+    write(glue::glue("    - {path_from_book_root}"), temp, append = TRUE)
+    write(book.yml.lines[seq(position+3, length(book.yml.lines))], temp, append = TRUE)
+    file.copy(temp, book.yml, overwrite = TRUE)
+    cli::cli_alert_success("File created @ `{full_path}`")
+    invisible(full_path)
 }
 
-add_chapter <- function(book, file, title) {
+#' @export 
 
+add_preamble <- function(book) {
+    add_page(book, file = "preamble.qmd", title = "Preamble {-}", position = 2)
 }
 
-add_appendix <- function(book, file, title) {
+#' @export 
 
+add_chapter <- function(book, file, title, position = NULL) {
+    add_page(book, file, title, position)
 }
-

inst/assets/_book.yml

@@ -1,5 +1,5 @@
 book:
-  title: "Writing reproducible books with Bioconductor"
+  title: "Write, containerize, publish and versionize Quarto books with Bioconductor"
   chapters:
     - index.qmd
     - pages/preamble.qmd

pages/Chapter-1.qmd

@@ -35,6 +35,8 @@ usethis::create_github_token(
 ## ------ Register your new token in R
 gitcreds::gitcreds_set()
 ## Paste your new Github token here and press "Enter"
+## Ideally, also add it to `~/.Renviron`: `GITHUB_PAT="<YOUR-TOKEN>"`. 
+## You can edit the `~/.Renviron` by typing `usethis::edit_r_environ()`
 
 ## ------ Double check you are logged in
 usethis::git_sitrep()