function for making new blog posts (#171)

Add new function and related tests

Co-authored-by: ‘topepo’ <‘[email protected]’>
Co-authored-by: Christophe Dervieux <[email protected]>

Author: 3 people

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: quarto
 Title: R Interface to 'Quarto' Markdown Publishing System
-Version: 1.4.4.9012
+Version: 1.4.4.9013
 Authors@R: c(
     person("JJ", "Allaire", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0003-0174-9868")),
@@ -19,6 +19,7 @@ Depends:
     R (>= 3.6)
 Imports:
     cli,
+    fs,
     jsonlite,
     later,
     processx,
@@ -27,6 +28,7 @@ Imports:
     rstudioapi,
     tools,
     utils,
+    xfun,
     yaml
 Suggests: 
     bslib,
@@ -48,7 +50,7 @@ Suggests:
     thematic,
     tidyverse,
     withr,
-    xfun
+    whoami
 VignetteBuilder: 
     quarto
 Config/testthat/edition: 3

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_available)
 export(quarto_binary_sitrep)
@@ -42,4 +43,5 @@ importFrom(rstudioapi,isAvailable)
 importFrom(rstudioapi,viewer)
 importFrom(tools,vignetteEngine)
 importFrom(utils,browseURL)
+importFrom(yaml,as.yaml)
 importFrom(yaml,write_yaml)

NEWS.md

@@ -1,5 +1,7 @@
 # quarto (development version)
 
+- Added a `new_blog_post()` function (thanks, @topeto, #22). 
+
 - Make `quarto_render(as_job = TRUE)` wrapable (thanks, @salim-b, #105).
 
 - Quarto CLI will now correctly use the same R version than the one used to run functions in this package (#204).

R/blog.R

@@ -0,0 +1,111 @@
+#' Create a new blog post
+#'
+#' Creates (and potentially opens) the `index.qmd` file for a new blog post.
+#'
+#' @inheritParams rlang::args_error_context
+#' @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 wd An optional working directory. If `NULL`, the current working is used.
+#' @param open A logical: have the default editor open a window to edit the
+#' `index.qmd` file?
+#' @param ... A named list of values to be added to the yaml header, such as
+#' `date`, `author`, `categories`, `description`, etc.
+#' If no `date` is provided, the current date is used.
+#' If no `author` is provided, `whoami::fullname()` is used to get the user's name.
+#' @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,
+  wd = NULL,
+  open = rlang::is_interactive(),
+  call = rlang::current_env(),
+  ...
+) {
+  rlang::check_installed("whoami")
+
+  if (is.null(dest)) {
+    # Scrub title to make directory name
+    dest <- gsub("[[:space:]]", "-", tolower(title))
+  }
+  dest_path <- make_post_dir(dest, wd, call)
+  post_yaml <- make_post_yaml(title, ...)
+  qmd_path <- write_post_yaml(post_yaml, dest_path, call)
+  if (open) {
+    edit_file <- utils::file.edit
+    if (
+      rlang::is_installed("usethis") &&
+        is.function(asNamespace("usethis")$edit_file)
+    ) {
+      edit_file <- utils::getFromNamespace("edit_file", "usethis")
+    }
+    edit_file(qmd_path)
+  }
+  invisible(qmd_path)
+}
+
+make_post_dir <- function(dest, wd, call) {
+  working <- if (is.null(wd)) fs::path_wd() else fs::path_abs(wd)
+
+  # is this a quarto project for blog ? Expecting _quarto.yml in working dir
+  if (!fs::file_exists(fs::path(working, "_quarto.yml"))) {
+    cli::cli_abort(
+      "You need to be at root of a Quarto project to create a blog post in the {.file posts/} directory at {.file {fs::path_real(working)}}.",
+      call = call
+    )
+  }
+
+  post_path <- fs::path(working, "posts", dest)
+
+  if (fs::dir_exists(post_path)) {
+    cli::cli_abort(
+      "There is already a {.file {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 <- merge_list(default_values, user_values)
+  if (length(yml_values$categories) == 0) {
+    yml_values <- yml_values[names(yml_values) != "categories"]
+  }
+  yml_values <- 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 <- xfun::write_utf8(x, con = dest_file)
+  }
+  dest_file
+}

R/utils.R

@@ -3,17 +3,25 @@ relative_to_wd <- function(path) {
   rmarkdown::relative_to(getwd(), path)
 }
 
+# Specific YAML handlers
+# as quarto expects YAML 1.2 and yaml R package supports 1.1
+yaml_handlers <- list(
+  # Handle yes/no from 1.1 to 1.2
+  # https://github.com/vubiostat/r-yaml/issues/131
+  logical = function(x) {
+    value <- ifelse(x, "true", "false")
+    structure(value, class = "verbatim")
+  }
+)
+
+#' @importFrom yaml as.yaml
+as_yaml <- function(x) {
+  yaml::as.yaml(x, handlers = yaml_handlers)
+}
+
 #' @importFrom yaml write_yaml
 write_yaml <- function(x, file) {
-  handlers <- list(
-    # Handle yes/no from 1.1 to 1.2
-    # https://github.com/vubiostat/r-yaml/issues/131
-    logical = function(x) {
-      value <- ifelse(x, "true", "false")
-      structure(value, class = "verbatim")
-    }
-  )
-  yaml::write_yaml(x, file, handlers = handlers)
+  yaml::write_yaml(x, file, handlers = yaml_handlers)
 }
 
 
@@ -34,3 +42,13 @@ in_positron <- function() {
 in_rstudio <- function() {
   identical(Sys.getenv("RSTUDIO"), "1")
 }
+
+
+# for test
+
+hide_path <- function(path) {
+  function(x) {
+    x <- gsub(path, "<project directory>", x, fixed = TRUE)
+    gsub(fs::path_real(path), "<project directory>", x, fixed = TRUE)
+  }
+}

_pkgdown.yml

@@ -34,6 +34,7 @@ reference:
     More about Quarto extensions at <https://quarto.org/docs/projects/quarto-projects.html>
   contents:
   - quarto_create_project
+  - new_blog_post
 
 - title: "Configuration"
   desc: >

man/new_blog_post.Rd

@@ -0,0 +1,24 @@
+# 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/'
+
+# Error if not a quarto project
+
+    Code
+      new_blog_post("Intro to Felt Surrogacy", open = FALSE)
+    Condition
+      Error in `new_blog_post()`:
+      ! You need to be at root of a Quarto project to create a blog post in the 'posts/' directory at '<project directory>'.
+
+---
+
+    Code
+      new_blog_post("Intro to Felt Surrogacy", wd = tmp_dir, open = FALSE)
+    Condition
+      Error in `new_blog_post()`:
+      ! You need to be at root of a Quarto project to create a blog post in the 'posts/' directory at '<project directory>'.
+

tests/testthat/_snaps/blog.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/'
+