Merge pull request #538 from lorenzwalthert/caching

- Cache styling (#538).

.pre-commit-config.yaml

@@ -1,9 +1,9 @@
 # All available hooks: https://pre-commit.com/hooks.html
 repos:
 -   repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.0.0.9018
+    rev: v0.0.0.9024
     hooks:
-    -   id: lintr
+    # -   id: lintr
     -   id: parsable-R
     -   id: no-browser-statement
     -   id: readme-rmd-rendered

.travis.yml

@@ -3,7 +3,7 @@
 # Usually you shouldn't need to change the first part of the file
 
 # DO NOT CHANGE THE CODE BELOW
-before_install: R -q -e 'install.packages(c("remotes", "curl", "knitr", "rmarkdown")); remotes::install_github("ropenscilabs/tic"); tic::prepare_all_stages(); remotes::install_deps(dependencies = TRUE); tic::before_install()'
+before_install: R -q -e 'install.packages(c("remotes", "curl", "knitr", "rmarkdown")); remotes::install_github("ropenscilabs/tic"); tic::prepare_all_stages(); remotes::install_deps(dependencies = TRUE); if (isTRUE(as.logical(toupper(Sys.getenv("R_REMOVE_RCACHE"))))) remove.packages("R.cache"); tic::before_install()'
 install: R -q -e 'tic::install()'
 after_install: R -q -e 'tic::after_install()'
 before_script: R -q -e 'tic::before_script()'
@@ -38,6 +38,9 @@ matrix:
   - r: release
     env:
     - BUILD_PKGDOWN: true
+  - r: release
+    env:
+    - R_REMOVE_RCACHE: true
   - r: devel
 
 #env

API

@@ -2,6 +2,10 @@
 
 ## Exported functions
 
+cache_activate(cache_name = NULL, verbose = TRUE)
+cache_clear(cache_name = NULL, ask = TRUE)
+cache_deactivate(verbose = TRUE)
+cache_info(cache_name = NULL, format = "both")
 create_style_guide(initialize = default_style_guide_attributes, line_break = NULL, space = NULL, token = NULL, indention = NULL, use_raw_indention = FALSE, reindention = tidyverse_reindention())
 default_style_guide_attributes(pd_flat)
 specify_math_token_spacing(zero = "'^'", one = c("'+'", "'-'", "'*'", "'/'"))

DESCRIPTION

@@ -1,5 +1,5 @@
-Package: styler
 Type: Package
+Package: styler
 Title: Non-Invasive Pretty Printing of R Code
 Version: 1.2.0.9000
 Authors@R: 
@@ -30,14 +30,17 @@ Imports:
     xfun (>= 0.1)
 Suggests: 
     data.tree (>= 0.1.6),
+    digest,
     dplyr,
     here,
     knitr,
     prettycode,
+    R.cache (>= 0.14.0),
     rmarkdown,
     rstudioapi (>= 0.7),
     testthat (>= 2.1.0)
-VignetteBuilder: knitr
+VignetteBuilder: 
+    knitr
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE, roclets = c("rd", "namespace",
@@ -80,8 +83,10 @@ Collate:
     'token-create.R'
     'transform-code.R'
     'transform-files.R'
-    'ui.R'
+    'ui-caching.R'
+    'ui-styling.R'
     'unindent.R'
+    'utils-cache.R'
     'utils-files.R'
     'utils-navigate-nest.R'
     'utils-strings.R'

NAMESPACE

@@ -1,6 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(print,vertical)
+export(cache_activate)
+export(cache_clear)
+export(cache_deactivate)
+export(cache_info)
 export(create_style_guide)
 export(default_style_guide_attributes)
 export(specify_math_token_spacing)

NEWS.md

@@ -20,9 +20,16 @@
 
 ## New features
 
-* Aligned function calls are detected and kept as is if they match the styler 
-  [definition for aligned function calls](https://styler.r-lib.org/articles/detect-alignment.html)
-  (#537).
+* styler caches results of styling, so applying styler to code it has styled
+  before will be instantaneous. This brings large speed boosts in many
+  situations, e.g. when `style_pkg()` is run but only a few files have changed
+  since the last styling or when using the [styler pre-commit
+  hook](https://github.com/lorenzwalthert/pre-commit-hooks). See the README for
+  details (#538).
+
+* Aligned function calls are detected and remain unchanged if they match the styler
+  [definition for aligned function
+  calls](https://styler.r-lib.org/articles/detect-alignment.html) (#537).
 
 * curly-curly (`{{`) syntactic sugar introduced with rlang 0.4.0 is now 
   explicitly handled, where previously it was just treated as two consecutive 

R/addins.R

@@ -141,7 +141,7 @@ set_style_transformers <- function() {
 #'
 #' @keywords internal
 get_addins_style_transformer_name <- function() {
-  getOption("styler.addins_style_transformer", default = "styler::tidyverse_style()")
+  getOption("styler.addins_style_transformer")
 }
 
 #' @rdname get_addins_style_transformer_name

R/communicate.R

@@ -34,3 +34,37 @@ assert_data.tree_installation <- function() {
     abort("The package data.tree needs to be installed for this functionality.")
   }
 }
+
+#' Assert the R.cache installation in conjunction with the cache config
+#'
+#' R.cache needs to be installed if caching functionality is enabled
+#' @param installation_only Whether or not to only check if R.cache is
+#'   installed.
+#' @keywords internal
+assert_R.cache_installation <- function(installation_only = FALSE,
+                                        action = "abort") {
+  # fail if R.cache is not installed but feature is actiavted.
+  if (!rlang::is_installed("R.cache") &&
+    ifelse(installation_only, TRUE, cache_is_activated())
+  ) {
+    msg_basic <- paste(
+      "R package R.cache is not installed, which is needed when the caching ",
+      "feature is activated. Please install the package with ",
+      "`install.packages('R.cache')` and then restart R to enable the ",
+      "caching feature of styler or permanently deactivate the feature by ",
+      "adding `styler::cache_deactivate()` to your .Rprofile, e.g. via ",
+      "`usethis::edit_r_profile()`.",
+      sep = ""
+    )
+
+    if (action == "abort") {
+      rlang::abort(msg_basic)
+    } else {
+      rlang::warn(paste0(
+        msg_basic, " ",
+        "Deactivating the caching feature for the current session."
+      ))
+      cache_deactivate(verbose = FALSE)
+    }
+  }
+}

R/io.R

@@ -61,7 +61,7 @@ read_utf8 <- function(path) {
   }
 }
 
-#' Drop-in replacement for [xfun::read_utf8()], with an optional `warn`
+#' Drop-in replacement for `xfun::read_utf8()`, with an optional `warn`
 #' argument.
 #' @keywords internal
 read_utf8_bare <- function(con, warn = TRUE) {
@@ -80,7 +80,7 @@ read_utf8_bare <- function(con, warn = TRUE) {
   x
 }
 
-#' Drop-in replacement for `xfun:::invalid_utf8()`.
+#' Drop-in replacement for [xfun:::invalid_utf8()]
 #' @keywords internal
 invalid_utf8 <- function(x) {
   which(!is.na(x) & is.na(iconv(x, "UTF-8", "UTF-8")))

R/roxygen-examples-parse.R

@@ -33,8 +33,7 @@ parse_roxygen <- function(roxygen) {
 #' @param raw Raw code to post-process.
 #' @keywords internal
 post_parse_roxygen <- function(raw) {
-  split <- raw %>%
+  raw %>%
     paste0(collapse = "") %>%
-    strsplit("\n", fixed = TRUE)
-  split[[1]]
+    convert_newlines_to_linebreaks()
 }

R/serialize.R

@@ -14,5 +14,5 @@ serialize_parse_data_flattened <- function(flattened_pd, start_line = 1) {
       map(lag_newlines, add_newlines), map(lag_spaces, add_spaces), text
     )
   )
-  strsplit(res, "\n")[[1L]]
+  convert_newlines_to_linebreaks(res)
 }

R/transform-files.R

@@ -73,17 +73,47 @@ transform_file <- function(path,
 #' @inheritParams parse_transform_serialize_r
 #' @keywords internal
 #' @importFrom purrr when
-make_transformer <- function(transformers, include_roxygen_examples, warn_empty = TRUE) {
+make_transformer <- function(transformers,
+                             include_roxygen_examples,
+                             warn_empty = TRUE) {
   force(transformers)
+  cache_dir <- c("styler", cache_get_name())
+  assert_R.cache_installation(action = "warn")
+
+  is_R.cache_installed <- rlang::is_installed("R.cache")
+
   function(text) {
-    transformed_code <- text %>%
-      parse_transform_serialize_r(transformers, warn_empty = warn_empty) %>%
-      when(
-        include_roxygen_examples ~
-        parse_transform_serialize_roxygen(., transformers),
-        ~.
-      )
-    transformed_code
+    should_use_cache <- is_R.cache_installed && cache_is_activated()
+
+    if (should_use_cache) {
+      use_cache <- R.cache::generateCache(
+        key = cache_make_key(text, transformers),
+        dirs = cache_dir
+      ) %>%
+        file.exists()
+    } else {
+      use_cache <- FALSE
+    }
+
+    if (!use_cache) {
+      transformed_code <- text %>%
+        parse_transform_serialize_r(transformers, warn_empty = warn_empty) %>%
+        when(
+          include_roxygen_examples ~
+          parse_transform_serialize_roxygen(., transformers),
+          ~.
+        )
+      if (should_use_cache) {
+        R.cache::generateCache(
+          key = cache_make_key(transformed_code, transformers),
+          dirs = cache_dir
+        ) %>%
+          file.create()
+      }
+      transformed_code
+    } else {
+      text
+    }
   }
 }
 

R/ui-caching.R

@@ -0,0 +1,105 @@
+#' Clear the cache
+#'
+#' Clears the cache that stores which files are already styled. You won't be
+#' able to undo this. Note that the file corresponding to the cache (a folder
+#' on your file stystem) won't be deleted, but it will be empty after calling
+#' `cache_clear`.
+#' @param cache_name The name of the styler cache to use. If
+#'   `NULL`, the option "styler.cache_name" is considered which defaults to
+#'   the version of styler used.
+#' @details
+#' Each version of styler has it's own cache by default, because styling is
+#' potentially different with different versions of styler.
+#' @param ask Whether or not to interactively ask the user again.
+#' @family cache managers
+#' @export
+cache_clear <- function(cache_name = NULL, ask = TRUE) {
+  assert_R.cache_installation(installation_only = TRUE)
+  path_cache <- cache_find_path(cache_name)
+  R.cache::clearCache(path_cache, prompt = ask)
+  cache_deactivate(verbose = FALSE)
+}
+
+#' Show information about the styler cache
+#'
+#' Gives information about the cache. Note that the size consumed by the cache
+#' will always be displayed as zero because all the cache does is creating an
+#' empty file of size 0 bytes for every cached expression. The innode is
+#' excluded from this displayed size but negligible.
+#' @param cache_name The name of the cache for which to show details. If
+#'   `NULL`, the active cache is used. If none is active the cache corresponding
+#'   to the installed styler version is used.
+#' @param format Either "lucid" for a summary emitted with [base::cat()],
+#'   "tabular" for a tabular summary from [base::file.info()] or "both" for
+#'   both.
+#' @family cache managers
+#' @export
+cache_info <- function(cache_name = NULL, format = "both") {
+  assert_R.cache_installation(installation_only = TRUE)
+  rlang::arg_match(format, c("tabular", "lucid", "both"))
+  path_cache <- cache_find_path(cache_name)
+  files <- list.files(path_cache, full.names = TRUE)
+  file_info <- file.info(files) %>%
+    as_tibble()
+  tbl <- tibble(
+    n = nrow(file_info),
+    size = sum(file_info$size),
+    last_modified = suppressWarnings(max(file_info$mtime)),
+    created = file.info(path_cache)$ctime,
+    location = path_cache,
+    activated = cache_is_activated(cache_name)
+  )
+  if (format %in% c("lucid", "both")) {
+    cat(
+      "Size:\t\t", tbl$size, " bytes (", tbl$n, " cached expressions)",
+      "\nLast modified:\t", as.character(tbl$last_modified),
+      "\nCreated:\t", as.character(tbl$created),
+      "\nLocation:\t", path_cache,
+      "\nActivated:\t", tbl$activated,
+      "\n",
+      sep = ""
+    )
+  }
+  if (format == "tabular") {
+    tbl
+  } else if (format == "both") {
+    invisible(tbl)
+  }
+}
+
+#' Activate or deactivate the styler cache
+#'
+#' Helper functions to control the behavior of caching. Simple wrappers around
+#' [base::options()].
+#' @inheritParams cache_clear
+#' @param verbose Whether or not to print an informative message about what the
+#'   function is doing.
+#' @family cache managers
+#' @export
+cache_activate <- function(cache_name = NULL, verbose = TRUE) {
+  assert_R.cache_installation(installation_only = TRUE)
+  if (!is.null(cache_name)) {
+    options("styler.cache_name" = cache_name)
+  } else {
+    options("styler.cache_name" = styler_version)
+  }
+  path <- cache_find_path(cache_name)
+  if (verbose) {
+    cat(
+      "Using cache ", cache_get_name(), " at ",
+      path, ".\n",
+      sep = ""
+    )
+  }
+  invisible(path)
+}
+
+#' @rdname cache_activate
+#' @export
+cache_deactivate <- function(verbose = TRUE) {
+  options("styler.cache_name" = NULL)
+
+  if (verbose) {
+    cat("Deactivated cache.\n")
+  }
+}