function for making new blog posts

DESCRIPTION

@@ -18,6 +18,7 @@ Depends:
     R (>= 3.6)
 Imports: 
     cli,
+    fs,
     jsonlite,
     later,
     processx,
@@ -26,6 +27,7 @@ Imports:
     rstudioapi,
     tools,
     utils,
+    whoami,
     yaml
 Suggests: 
     curl,

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(is_using_quarto)
+export(new_blog_post)
 export(quarto_add_extension)
 export(quarto_binary_sitrep)
 export(quarto_create_project)

NEWS.md

@@ -1,5 +1,7 @@
 # quarto (development version)
 
+- Added a `new_blog_post()` function (#22). 
+
 - Approval check in `quarto_add_extension()` and `quarto_use_template()` now works correctly (thanks, @eveyp, #172).
 
 # quarto 1.4

R/new-blog-post.R

@@ -0,0 +1,82 @@
+#' Create a new blog post
+#'
+#' Creates (and potentially opens) the `index.qmd` file for a new blog post.
+#'
+#' @param title A character string for the title of the post. It is converted
+#' to title case via [tools::toTitleCase()].
+#' @param dest A character string (or NULL) for the path within `posts`. By
+#' default, the title is adapted as the directory name.
+#' @param open A logical: have the default editor open a window to edit the
+#' `index.qmd` file?
+#' @param call A call object for reporting errors.
+#' @param ... A named list of values to be added to the yaml header, such as
+#' `description`, `author`, `categories`, etc.
+#' @return The path to the index file.
+#' @export
+#' @examples
+#' \dontrun{
+#'  \donttest{
+#' new_blog_post("making quarto blog posts", categories = c("R"))
+#'
+#'  }
+#' }
+#'
+new_blog_post <- function(title, dest = NULL, open = rlang::is_interactive(),
+                          call = rlang::current_env(), ...) {
+
+  if (is.null(dest)) {
+    # Scrub title to make directory name
+    dest <- gsub("[[:space:]]", "-", tolower(title))
+  }
+  dest_path <- make_post_dir(dest, call)
+  post_yaml <- make_post_yaml(title, ...)
+  qmd_path <- write_post_yaml(post_yaml, dest_path, call)
+  if (open) {
+    utils::file.edit(qmd_path)
+  }
+  invisible(qmd_path)
+}
+
+make_post_dir <- function(dest, call) {
+  working <- fs::path_wd()
+
+  post_path <- fs::path(working, "posts", dest)
+
+  if (fs::dir_exists(post_path)) {
+    cli::cli_abort("There is already a {.code {dest}} directory in 'posts/'",
+                   call = call)
+  } else {
+    ret <- fs::dir_create(post_path)
+  }
+  ret
+}
+
+make_post_yaml <- function(title, ...) {
+  default_values <- list(
+    title = tools::toTitleCase(title),
+    author = tools::toTitleCase(whoami::fullname("Your name")),
+    date = format(Sys.Date(), "%Y-%m-%d"),
+    categories = character(0)
+  )
+
+  user_values <- list(...)
+
+  yml_values <- utils::modifyList(default_values, user_values)
+  if (length(yml_values$categories) == 0) {
+    yml_values <- yml_values[names(yml_values) != "categories"]
+  }
+  yml_values <- yaml::as.yaml(yml_values)
+  yml_values <- paste0("---\n", yml_values, "---\n")
+  yml_values
+}
+
+write_post_yaml <- function(x, dest, call) {
+  dest_file <- fs::path(dest, "index.qmd")
+  if (fs::file_exists(dest_file)) {
+    cli::cli_abort("There is already am index.qmd file at {.code {path}}",
+                   call = call)
+  } else {
+    ret <- cat(x, file = dest_file)
+  }
+  dest_file
+}

tests/testthat/_snaps/new-blog-post.md

@@ -0,0 +1,8 @@
+# Create a blog post
+
+    Code
+      new_blog_post("Intro to Felt Surrogacy", data = "1999-12-31", open = FALSE)
+    Condition
+      Error in `new_blog_post()`:
+      ! There is already a `intro-to-felt-surrogacy` directory in 'posts/'
+

tests/testthat/test-new-blog-post.R

@@ -0,0 +1,68 @@
+test_that("Create a blog post", {
+  skip_if_no_quarto("1.4")
+
+  current_dir <- getwd()
+
+  temp_dir <- withr::local_tempdir()
+  dir_path <- fs::path(temp_dir, "test-blog-project")
+
+  withr::defer(fs::dir_delete(dir_path), envir = rlang::current_env())
+
+  quarto_create_project(name = "test-blog-project", type = "blog",
+                        dir = temp_dir, quiet = TRUE)
+
+  setwd(dir_path)
+  withr::defer(setwd(current_dir), envir = rlang::current_env())
+
+  Sys.setenv(FULLNAME="Max Kuhn")
+
+  # ------------------------------------------------------------------------------
+
+  post_1 <- new_blog_post("Intro to Felt Surrogacy", date = "March 25, 2010",
+                          open = FALSE)
+  expect_true(fs::file_exists(post_1))
+  expect_equal(fs::path_file(post_1), "index.qmd")
+
+  post_1_dir <- fs::path_split(post_1)[[1]]
+  post_1_dir <- post_1_dir[length(post_1_dir) - 1]
+  expect_equal(post_1_dir, "intro-to-felt-surrogacy")
+
+  post_1_content <- readLines(post_1)
+  post_1_content <- paste0(post_1_content, collapse = "\n")
+  expect_equal(
+    post_1_content,
+    "---\ntitle: Intro to Felt Surrogacy\nauthor: Max Kuhn\ndate: March 25, 2010\n---"
+  )
+
+  # ------------------------------------------------------------------------------
+
+  expect_snapshot(
+    new_blog_post("Intro to Felt Surrogacy", data = "1999-12-31", open = FALSE),
+    error = TRUE
+  )
+
+  # ------------------------------------------------------------------------------
+
+  post_2 <-
+    new_blog_post(
+      "Intro to Felt Surrogacy",
+      dest = "The Science of Illusion",
+      author = "Annie Edison",
+      date = '2024-04-12',
+      categories = c("shenanigans", "security"),
+      open = FALSE)
+
+  expect_true(fs::file_exists(post_2))
+  expect_equal(fs::path_file(post_2), "index.qmd")
+
+  post_2_dir <- fs::path_split(post_2)[[1]]
+  post_2_dir <- post_2_dir[length(post_2_dir) - 1]
+  expect_equal(post_2_dir, "The Science of Illusion")
+
+  post_2_content <- readLines(post_2)
+  post_2_exp <- c(
+    "---", "title: Intro to Felt Surrogacy", "author: Annie Edison",
+    "date: '2024-04-12'", "categories:", "- shenanigans", "- security", "---")
+  expect_equal(post_2_content, post_2_exp)
+})
+