diff --git a/.Rbuildignore b/.Rbuildignore index 090ce293..f64dee63 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -17,3 +17,4 @@ ^LICENSE\.md$ inst/examples/rsconnect ^vignettes$ +^scripts$ diff --git a/DESCRIPTION b/DESCRIPTION index 9482b287..5afc7b31 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,6 +37,7 @@ Imports: mime (>= 0.6), rlang (>= 0.4.1), rmarkdown, + rvest (>= 1.0.3), stringr (>= 1.4.0), uuid (>= 0.1-2) Suggests: diff --git a/R/utils-quarto_emailing.R b/R/utils-quarto_emailing.R new file mode 100644 index 00000000..d056dc67 --- /dev/null +++ b/R/utils-quarto_emailing.R @@ -0,0 +1,143 @@ +# This function, to be used externally by scripts, will determine if +# the blastula package is available in the user system +blastula_pkg_available <- function() { + if (!requireNamespace("blastula", quietly = TRUE)) { + stop( + "The `blastula` package is required for processing email ", + "from Quarto documents." + ) + } +} + +jsonlite_pkg_available <- function() { + if (!requireNamespace("jsonlite", quietly = TRUE)) { + stop( + "The `jsonlite` package is required for processing email ", + "from Quarto documents." + ) + } +} + +rmarkdown_pkg_available <- function() { + if (!requireNamespace("rmarkdown", quietly = TRUE)) { + stop( + "The `rmarkdown` package is required for processing email ", + "from Quarto documents." + ) + } +} + +# Combine `path` with `filename` and normalize the path +blastula_resource_filename <- function(path, filename) { + + if (is.null(path)) { + path <- "." + } + + as.character( + fs::path_expand( + fs::path_abs( + path = filename, + start = path + ) + ) + ) +} + +get_quarto_report_render_html_path <- function() { + system.file( + "quarto_example_documents/quarto-report-render.html", + package = "blastula" + ) +} + +# Gets the HTML elements from CSS selector values +get_html_elements <- function(html, selector) { + rvest::html_elements(html, css = selector) +} + +detect_quarto_connect_json_file <- function( + filename = "connect-email.json", + path = NULL +) { + + filename <- blastula_resource_filename(path = path, filename = filename) + + if (!file.exists(filename)) { + warning("The JSON file required for Connect emailing cannot be found.") + return(invisible()) + } +} + +get_html_email_fragment <- function( + file, + selector = "[class='email']" +) { + + html_file_lines <- readLines(con = file, warn = FALSE) + html_file <- paste(html_file_lines, collapse = "\n") + html_read <- xml2::read_html(html_file) + + html_email_fragment <- + get_html_elements( + html = html_read, + selector = selector + ) + + html_email_fragment <- as.character(xml2::xml_children(html_email_fragment)) + html_email_fragment <- paste(html_email_fragment, collapse = "\n") + + html_email_fragment +} + +write_blastula_email_input_file <- function(html_fragment) { + + output_file <- tempfile(pattern = "email", fileext = ".Rmd") + + writeLines( + text = c( + "---", + "output: blastula::blastula_email", + "---", + "", + "", + html_fragment, + "" + ), + con = output_file + ) + + invisible(output_file) +} + +read_quarto_connect_json_file <- function(file) { + jsonlite::fromJSON(txt = file) +} + +write_quarto_connect_json_file <- function(obj, path) { + jsonlite::write_json(obj, path) +} + +finalize_quarto_connect_json_file <- function( + input_json_file, + output_json_file = NULL, + rendered_email_obj +) { + + connect_email_obj <- read_quarto_connect_json_file(file = input_json_file) + + connect_email_obj <- + c( + connect_email_obj, + list( + rsc_email_body_html = rendered_email_obj[["html_str"]], + rsc_email_images = rendered_email_obj[["images"]] + ) + ) + + if (is.null(output_json_file)) { + output_json_file <- input_json_file + } + + write_quarto_connect_json_file(connect_email_obj, path = output_json_file) +} diff --git a/cran-comments.md b/cran-comments.md deleted file mode 100644 index 40afbd70..00000000 --- a/cran-comments.md +++ /dev/null @@ -1,14 +0,0 @@ -## Test environments -* local OS X install, R 3.4.0 -* ubuntu 12.04 (on travis-ci), R 3.4.0 -* win-builder (devel and release) - -## R CMD check results - -0 errors | 0 warnings | 0 notes - -* This is a new release. - -## Reverse dependencies - -This is a new release, so there are no reverse dependencies. diff --git a/inst/quarto_example_documents/connect-email.json b/inst/quarto_example_documents/connect-email.json new file mode 100644 index 00000000..fe1af5b5 --- /dev/null +++ b/inst/quarto_example_documents/connect-email.json @@ -0,0 +1 @@ +{"rsc_email_subject":"This is a subject.","rsc_email_attachments":["attach1.txt","attach2.txt"],"rsc_email_suppress_report_attachment":true,"rsc_email_suppress_scheduled":false} \ No newline at end of file diff --git a/inst/quarto_example_documents/quarto-report-render-02.html b/inst/quarto_example_documents/quarto-report-render-02.html new file mode 100644 index 00000000..0a139bc0 --- /dev/null +++ b/inst/quarto_example_documents/quarto-report-render-02.html @@ -0,0 +1,3330 @@ + + + + + + + + + +report + + + + + + + + + + + + + + + + + + + +
+ +
+ + + +
+
library(tidyverse)
+
+
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
+✔ dplyr     1.1.1     ✔ readr     2.1.4
+✔ forcats   1.0.0     ✔ stringr   1.5.0
+✔ ggplot2   3.4.1     ✔ tibble    3.2.1
+✔ lubridate 1.9.2     ✔ tidyr     1.3.0
+✔ purrr     1.0.1     
+── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
+✖ dplyr::filter() masks stats::filter()
+✖ dplyr::lag()    masks stats::lag()
+ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
+
+
+
+

A fancy report

+

Hello

+ +
+ +
+ + +
+ + + + \ No newline at end of file diff --git a/inst/quarto_example_documents/quarto-report-render.html b/inst/quarto_example_documents/quarto-report-render.html new file mode 100644 index 00000000..03c6409f --- /dev/null +++ b/inst/quarto_example_documents/quarto-report-render.html @@ -0,0 +1,3331 @@ + + + + + + + + + +report + + + + + + + + + + + + + + + + + + + +
+ +
+ + + +
+
library(tidyverse)
+
+
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
+✔ dplyr     1.1.1     ✔ readr     2.1.4
+✔ forcats   1.0.0     ✔ stringr   1.5.0
+✔ ggplot2   3.4.1     ✔ tibble    3.2.1
+✔ lubridate 1.9.2     ✔ tidyr     1.3.0
+✔ purrr     1.0.1     
+── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
+✖ dplyr::filter() masks stats::filter()
+✖ dplyr::lag()    masks stats::lag()
+ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
+
+
+
+

A fancy report

+

Hello

+
+ + +
+ + +
+ + + + \ No newline at end of file diff --git a/scripts/quarto-postprocess.R b/scripts/quarto-postprocess.R new file mode 100644 index 00000000..f54d25e3 --- /dev/null +++ b/scripts/quarto-postprocess.R @@ -0,0 +1,43 @@ +# Ensure that certain packages are available +blastula_pkg_available() +jsonlite_pkg_available() +rmarkdown_pkg_available() + +library(rmarkdown) +library(blastula) +library(jsonlite) + +# Get the filename for the rendered-by-Quarto HTML +html_file <- list.files(path = ".", pattern = ".*\\.html")[1] + +# Get the filename for the rendered-by-Quarto JSON +json_file <- list.files(path = ".", pattern = ".*\\.json")[1] + +# Stop if any of `html_file` or `json_file` are of zero length +if (length(html_file) < 1 || length(html_file) < 1) { + stop("There is no HTML or JSON file for which to generate a Connect email.") +} + +# Stop if the JSON file doesn't contain identifying text + + +# Generate the fragment of HTML that only contains the emailable material +email_fragment <- get_html_email_fragment(file = html_file) + +# Render the email fragment .Rmd and generate a list object with the +# needed components for Connect +rendered_email_obj <- + render_connect_email( + input = write_blastula_email_input_file(email_fragment), + connect_footer = FALSE, + envir = parent.frame(), + quiet = TRUE, + output_options = list(), + render_options = list() + ) + +finalize_quarto_connect_json_file( + input_json_file = json_file, + output_json_file = json_file, + rendered_email_obj = rendered_email_obj +)