rstudio · salim-b · Oct 16, 2019 · Oct 16, 2019 · Oct 16, 2019 · Jan 3, 2020
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -7,7 +7,8 @@ Authors@R: c(
            comment = c(ORCID = "0000-0003-3925-190X")),
     person("Joe", "Cheng", role = "aut", email = "[email protected]"),
     person("Jeroen", "Ooms", role = "ctb", email = "[email protected]",
-      comment = c(ORCID = "0000-0002-4035-0289"))
+      comment = c(ORCID = "0000-0002-4035-0289")),
+    person("Salim", "Brüggemann", role = "ctb", email = "[email protected]")
     )
 Description: Compose and send out responsive HTML email messages that render
     perfectly across a range of email clients and device sizes. Helper functions
@@ -32,10 +33,12 @@ Imports:
     jsonlite (>= 1.6),
     magrittr (>= 1.5),
     mime (>= 0.6),
+    processx (>= 3.4.1),
     rlang (>= 0.4.1),
     rmarkdown,
     stringr (>= 1.4.0),
-    uuid (>= 0.1-2)
+    uuid (>= 0.1-2),
+    xfun (>= 0.11)
 Suggests: 
     covr,
     ggplot2,
@@ -48,7 +51,7 @@ Suggests:
 SystemRequirements: pandoc (>= 1.12.3) - http://pandoc.org
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 6.1.1
+RoxygenNote: 7.0.2
 Roxygen: list(markdown = TRUE)
 VignetteBuilder: knitr
 Language: en-US
diff --git a/NAMESPACE b/NAMESPACE
@@ -28,6 +28,7 @@ export(creds_file)
 export(creds_key)
 export(get_html_str)
 export(md)
+export(minify)
 export(prepare_rsc_example_files)
 export(prepare_test_message)
 export(render_connect_email)

diff --git a/R/minify.R b/R/minify.R
@@ -0,0 +1,166 @@
+#' Minify an email
+#'
+#' Minify a blastula `email_message` object.
+#'
+#' The [minification](https://en.wikipedia.org/wiki/Minification_(programming))
+#' relies on the binary
+#' [**minify**](https://github.com/tdewolff/minify/tree/master/cmd/minify)
+#' which is cross-platform and works on Windows, macOS, Linux and BSD.
+#' Pre-built binaries can be downloaded from
+#' [here](https://github.com/tdewolff/minify/releases). Alternatively,
+#' instructions to build minify from source are available
+#' [here](https://github.com/tdewolff/minify/tree/master/cmd/minify#installation).
+#'
+#' @param email The email message object, as created by the [compose_email()]
+#'   function. The object's class is `email_message`.
+#' @param binary_loc An option to supply the location of the `minify`
+#'   binary file should it not be on the system path or in the working
+#'   directory.
+#' @param minify_opts A list of additional options to pass to the `minify` CLI
+#'   command. Only the following sensible subset of
+#'   [all possible minify options](https://github.com/tdewolff/minify/tree/master/cmd/minify#usage)
+#'   is supported, listed with their default values:
+#'   - \code{`html-keep-conditional-comments` = FALSE}: Preserve all IE conditional comments
+#'   - \code{`html-keep-default-attrvals` = FALSE}: Preserve default attribute values
+#'   - \code{`html-keep-document-tags` = FALSE}: Preserve `<html>`, `<head>` and `<body>` tags
+#'   - \code{`html-keep-end-tags` = FALSE}: Preserve all end tags
+#'   - \code{`html-keep-quotes` = FALSE}: Preserve quotes around attribute values
+#'   - \code{`html-keep-whitespace` = FALSE}: Preserve whitespace characters but still collapse multiple into one
+#'   - \code{`css-decimals` = -1L}: Number of decimals to preserve in CSS numbers,
+#'     `-1L` means all
+#'   - \code{`svg-decimals` = -1L}: Number of decimals to preserve in SVG numbers,
+#'     `-1L` means all
+#'   - `verbose = FALSE`: Print informative messages about minification details.
+#' @param echo If set to `TRUE`, the command to minify the `email_message`
+#'   object's HTML via `minify` will be printed to the console. By default,
+#'   this is `FALSE`.
+#'
+#' @examples
+#' \donttest{# Create a simple test email
+#' test_mail <- prepare_test_message()
+#'
+#' # Minify the test email
+#' minify(test_mail)
+#'
+#' # The command used to minify can be printed
+#' minify(email = test_mail,
+#'        echo = TRUE)
+#'
+#' # We can also provide options to the
+#' # underlying minify command
+#' minify(email = test_mail,
+#'        minify_opts = list(`html-keep-conditional-comments` = TRUE,
+#'                           `html-keep-default-attrvals` = TRUE,
+#'                           verbose = TRUE),
+#'        echo = TRUE)
+#' }
+#'
+#' @return An `email_message` object.
+#' @export
+minify <- function(email,
+                   binary_loc = NULL,
+                   minify_opts = NULL,
+                   echo = FALSE) {
+
+  # Verify that the `email` object
+  # is of the class `email_message`
+  if (!inherits(email, "email_message")) {
+    stop("The object provided in `email` must be an ",
+         "`email_message` object.\n",
+         " * This can be created with the `compose_email()` function.",
+         call. = FALSE)
+  }
+
+  # Determine the location of the `minify` binary
+  if (is.null(binary_loc)) {
+    binary_loc <- find_binary("minify")
+    if (is.null(binary_loc)) {
+      stop("The binary file `minify` is not in the system path or \n",
+           "in the working directory:\n",
+           " * download a pre-built binary from https://github.com/tdewolff/minify/releases\n",
+           " * or follow the installation instructions at https://github.com/tdewolff/minify/tree/master/cmd/minify#installation",
+           call. = FALSE)
+    }
+  }
+
+  # Ensure provided minify options are valid
+  # and collect arguments and options for for `processx::run()` as a list
+  run_args <- character(0)
+
+  if (!is.null(minify_opts)) {
+    binary_opts <-
+      c("html-keep-conditional-comments",
+        "html-keep-default-attrvals",
+        "html-keep-document-tags",
+        "html-keep-end-tags",
+        "html-keep-quotes",
+        "html-keep-whitespace",
+        "verbose") %>%
+      intersect(y = names(minify_opts))
+
+    int_opts <-
+      c("css-decimals",
+        "svg-decimals") %>%
+      intersect(y = names(minify_opts))
+
+    invalid_opts_i <- which(
+      !(names(minify_opts) %in% c(binary_opts, int_opts))
+    )
+
+    if (length(invalid_opts_i) > 0) {
+      stop("Unknown options provided in `minify_opts`: ", names(minify_opts[invalid_opts_i]),
+           call. = FALSE)
+    }
+
+    if (length(binary_opts) > 0) {
+      invalid_opts_i <- which(
+        names(minify_opts) %in% binary_opts & !sapply(minify_opts[binary_opts], is.logical)
+      )
+
+      if (length(invalid_opts_i) > 0) {
+        stop("The following `minify_opts` must be of type logical: ",
+             names(minify_opts[invalid_opts_i]),
+             call. = FALSE)
+      }
+
+      run_args <- c(names(minify_opts[sapply(minify_opts, isTRUE)])) %>% paste0("--", .)
+    }
+
+    if (length(int_opts) > 0) {
+      minify_opts[int_opts] <- as.integer(minify_opts[int_opts])
+
+      invalid_opts_i <-
+        names(minify_opts) %in% int_opts %>%
+        magrittr::and(!sapply(minify_opts[int_opts],
+                              function(x) x >= -1L)) %>%
+        which()
+
+      if (length(invalid_opts_i) > 0) {
+        stop("The following `minify_opts` must be >= -1: ", names(minify_opts[invalid_opts_i]),
+             call. = FALSE)
+      }
+
+      run_args <- minify_opts[int_opts] %>% paste0(names(.), "=", .)
+    }
+  }
+
+  # Write the inlined HTML message out to a file
+  # and remove the file after the function exits
+  tempfile_ <- tempfile(fileext = ".html") %>% tidy_gsub("\\\\", "/")
+  email$html_str %>% writeLines(con = tempfile_, useBytes = TRUE)
+  on.exit(file.remove(tempfile_))
+
+  # add input and file type
+  run_args <- c("--type=html", run_args, tempfile_)
+
+  # Minify via `processx::run()` and assign the result
+  minify_result <- processx::run(command = binary_loc,
+                                 args = run_args,
+                                 echo_cmd = echo,
+                                 timeout = 60L)
+
+  if (isTRUE(minify_opts$verbose)) message(minify_result$stderr)
+
+  email$html_str <- minify_result$stdout
+  email
+}
diff --git a/R/utils.R b/R/utils.R
@@ -101,6 +101,66 @@ imgur_upload <- function(file, client_id) {
   )
 }
 
+#' An upgraded version of `Sys.which()` that returns a better Windows path
+#'
+#' @param name A single-length character vector with the executable name.
+#' @noRd
+sys_which <- function(name) {
+
+  # Only accept a vector of length 1
+  stopifnot(length(name) == 1)
+
+  # Get the
+  if (xfun::is_windows()) {
+
+    suppressWarnings({
+      pathname <-
+        system(sprintf("where %s 2> NUL", name), intern = TRUE)[1]
+    })
+
+    if (!is.na(pathname)) {
+
+      pathname <- pathname %>% tidy_gsub("\\\\", "/")
+
+      return(stats::setNames(pathname, name))
+    }
+  }
+
+  Sys.which(name) %>% tidy_gsub("\\\\", "/")
+}
+
+#' Find a binary on the system path or working directory
+#'
+#' @param bin_name The name of the binary to search for.
+#' @noRd
+find_binary <- function(bin_name) {
+
+  # Find binary on path with `sys_which()`
+  which_result <- sys_which(name = bin_name) %>% unname()
+
+  if (which_result != "") {
+    return(which_result)
+  }
+
+  # Try to locate the binary in working directory
+  which_result <-
+    tryCatch(
+      {
+        processx::run(command = "ls", args = bin_name)
+        file.path(getwd(), bin_name)
+      },
+      error = function(cond) ""
+    )
+
+  if (which_result != "") {
+    return(which_result)
+  }
+
+  # If the binary isn't found in these locations,
+  # return `NULL`
+  NULL
+}
+
 # nocov end
 
 #' Prepend a element to a list at a given position

diff --git a/man/add_attachment.Rd b/man/add_attachment.Rd
diff --git a/man/add_ggplot.Rd b/man/add_ggplot.Rd
diff --git a/man/add_image.Rd b/man/add_image.Rd
diff --git a/man/add_imgur_image.Rd b/man/add_imgur_image.Rd
diff --git a/man/add_readable_time.Rd b/man/add_readable_time.Rd
diff --git a/man/attach_connect_email.Rd b/man/attach_connect_email.Rd