Style roxygen code examples

API

@@ -6,10 +6,10 @@ create_style_guide(initialize = default_style_guide_attributes, line_break = NUL
 default_style_guide_attributes(pd_flat)
 specify_math_token_spacing(zero = "'^'", one = c("'+'", "'-'", "'*'", "'/'"))
 specify_reindention(regex_pattern = NULL, indention = 0, comments_only = TRUE)
-style_dir(path = ".", ..., style = tidyverse_style, transformers = style(...), filetype = "R", recursive = TRUE, exclude_files = NULL)
-style_file(path, ..., style = tidyverse_style, transformers = style(...))
-style_pkg(pkg = ".", ..., style = tidyverse_style, transformers = style(...), filetype = "R", exclude_files = "R/RcppExports.R")
-style_text(text, ..., style = tidyverse_style, transformers = style(...))
+style_dir(path = ".", ..., style = tidyverse_style, transformers = style(...), filetype = "R", recursive = TRUE, exclude_files = NULL, include_roxygen_examples = TRUE)
+style_file(path, ..., style = tidyverse_style, transformers = style(...), include_roxygen_examples = TRUE)
+style_pkg(pkg = ".", ..., style = tidyverse_style, transformers = style(...), filetype = "R", exclude_files = "R/RcppExports.R", include_roxygen_examples = TRUE)
+style_text(text, ..., style = tidyverse_style, transformers = style(...), include_roxygen_examples = TRUE)
 tidyverse_math_token_spacing()
 tidyverse_reindention()
 tidyverse_style(scope = "tokens", strict = TRUE, indent_by = 2, start_comments_with_one_space = FALSE, reindention = tidyverse_reindention(), math_token_spacing = tidyverse_math_token_spacing())

DESCRIPTION

@@ -1,11 +1,15 @@
 Package: styler
 Title: Non-Invasive Pretty Printing of R Code
 Version: 1.0.2.9000
+Date: 2018-06-21
 Authors@R: c(person("Kirill", "Müller", role = c("aut"), email = "[email protected]"),
   person("Lorenz", "Walthert", role = c("cre", "aut"), email = "[email protected]"))
 Description:
     Pretty-prints R code without changing the user's formatting intent.
-Imports:
+License: GPL-3
+URL: https://github.com/r-lib/styler
+BugReports: https://github.com/r-lib/styler/issues
+Imports: 
     backports,
     cli,
     enc (>= 0.2),
@@ -15,24 +19,21 @@ Imports:
     rlang,
     rprojroot,
     tibble (>= 1.4.2),
+    tools,
     withr
-Suggests:
+Suggests: 
     data.tree,
     dplyr,
     here,
     knitr,
     rmarkdown,
     rstudioapi,
     testthat
-License: GPL-3
+VignetteBuilder: knitr
 Encoding: UTF-8
 LazyData: true
-Date: 2018-06-21
-BugReports: https://github.com/r-lib/styler/issues
-URL: https://github.com/r-lib/styler
 Roxygen: list(markdown = TRUE, roclets = c("rd", "namespace", "collate", "pkgapi::api_roclet"))
 RoxygenNote: 6.0.1
-VignetteBuilder: knitr
 Collate: 
     'addins.R'
     'communicate.R'
@@ -47,6 +48,10 @@ Collate:
     'reindent.R'
     'token-define.R'
     'relevel.R'
+    'roxygen-examples-add-remove.R'
+    'roxygen-examples-find.R'
+    'roxygen-examples-parse.R'
+    'roxygen-examples.R'
     'rules-line-break.R'
     'rules-other.R'
     'rules-replacement.R'

NAMESPACE

@@ -22,7 +22,9 @@ importFrom(purrr,flatten_int)
 importFrom(purrr,map)
 importFrom(purrr,map2)
 importFrom(purrr,map2_lgl)
+importFrom(purrr,map_at)
 importFrom(purrr,map_chr)
+importFrom(purrr,map_int)
 importFrom(purrr,map_lgl)
 importFrom(purrr,partial)
 importFrom(purrr,pmap)

R/addins.R

@@ -20,7 +20,9 @@ NULL
 #'   `strict = TRUE`.
 #' @keywords internal
 style_active_file <- function() {
-  transformer <- make_transformer(tidyverse_style())
+  transformer <- make_transformer(tidyverse_style(),
+    include_roxygen_examples = TRUE
+  )
   context <- get_rstudio_context()
   if (is_rmd_file(context$path)) {
     out <- transform_rmd(context$contents, transformer)

R/roxygen-examples-add-remove.R

@@ -0,0 +1,40 @@
+#' Remove dont* mask
+#'
+#' @param roxygen Roxygen code examples that contains a dont* segment only.
+#' @keywords internal
+#' @importFrom rlang seq2
+remove_dont_mask <- function(roxygen) {
+  mask <- c(
+    1L, 2L, if (roxygen[3] == "\n") 3L, last(which(roxygen == "}"))
+  ) %>% sort()
+  list(
+    code = roxygen[-mask], mask = paste(roxygen[seq2(1, 2)], collapse = "")
+  )
+}
+
+remove_blank_lines <- function(code) {
+  code[code != "\n"]
+}
+
+remove_roxygen_mask <- function(text) {
+  code_with_header <- gsub(pattern = "^#'\\s*", "", text)
+  remove_roxygen_header(code_with_header)
+}
+
+#' Remove roxygen header
+#'
+#' Can't simply remove the element with the regex because it may happen that
+#' the roxygen tag is on the same line as its contents start.
+#' @examples
+#' #' @examples c(1, 2)
+#' @keywords internal
+remove_roxygen_header <- function(text) {
+  text <- gsub("^\\s*@examples\\s*", "", text, perl = TRUE)
+  starts_with_blank <- text[1] == "\n"
+  c(text[1][!starts_with_blank], text[-1])
+}
+
+#' @importFrom purrr map_chr
+add_roxygen_mask <- function(text) {
+  c(paste0("#' @examples"), map_chr(text, ~paste0("#' ", .x)))
+}

R/roxygen-examples-find.R

@@ -0,0 +1,56 @@
+#' Figure out where code examples start and stop
+#'
+#' Finds the sequence from start to stop of the lines in `text` that are
+#' code examples in roxygen comments.
+#' @param text A text consisting of code and/or roxygen comments.
+#' @importFrom purrr map_int map2
+#' @importFrom rlang seq2
+#' @keywords internal
+identify_start_to_stop_of_roxygen_examples_from_text <- function(text) {
+  starts <- grep("^#'\\s*@examples", text, perl = TRUE)
+  stop_candidates <- grep("^[^#]|^#'\\s*@", text, perl = TRUE)
+  stops <- map_int(starts, match_stop_to_start, stop_candidates)
+  map2(starts, stops, seq2)
+}
+
+identify_start_to_stop_of_roxygen_examples <- function(path) {
+  content <- enc::read_lines_enc(path)
+  identify_start_to_stop_of_roxygen_examples_from_text(content)
+}
+
+#' Match a stop candidate to a start
+#' @param start An integer.
+#' @param stop_candidates Potential stop candidates.
+#' @examples
+#' styler:::match_stop_to_start(1, c(3, 4, 5))
+#' @keywords internal
+match_stop_to_start <- function(start, stop_candidates) {
+  min(stop_candidates[stop_candidates > start]) - 1L
+}
+
+#' Find dontrun and friend sequences
+#'
+#' Returns the indices of the lines that correspond to a `dontrun` or
+#' friends sequence.
+#' @param bare Bare code.
+#' @importFrom purrr map2 map_int
+#' @keywords internal
+find_dont_seqs <- function(bare) {
+  dont_openings <- which(bare %in% dont_keywords())
+  dont_type <- bare[dont_openings]
+  dont_closings <- map_int(dont_openings + 1L, find_dont_closings, bare = bare)
+  map2(dont_openings, dont_closings, seq2)
+}
+
+#' @importFrom rlang seq2
+find_dont_closings <- function(bare, dont_openings) {
+  opening <- cumsum(bare == "{")
+  closing <- cumsum(bare == "}")
+  diff <- opening - closing
+  level_dont <- diff[dont_openings]
+  match_closing <- intersect(
+    seq2(dont_openings + 1L, length(bare)),
+    which(diff == level_dont - 1L)
+  )[1]
+  match_closing + 1L
+}

R/roxygen-examples-parse.R

@@ -0,0 +1,38 @@
+#' Parse roxygen comments into text
+#'
+#' Used to parse roxygen code examples. Removes line break before
+#' `\\dontrun{...}` and friends because it does not occurr for segments other
+#' than `\\dont{...}` and friends.
+#' @param roxygen Roxygen comments.
+#' @examples
+#' styler:::parse_roxygen(c(
+#'   "#' @examples",
+#'   "#' 1+  1"
+#' ))
+#' styler:::parse_roxygen(c(
+#'   "#' @examples 33",
+#'   "#'1+  1"
+#' ))
+#' @keywords internal
+parse_roxygen <- function(roxygen) {
+  parsed <- remove_roxygen_mask(roxygen) %>%
+    textConnection() %>%
+    tools::parse_Rd(fragment = TRUE) %>%
+    as.character()
+  is_line_break <- parsed[1] == "\n"
+  c(parsed[1][!is_line_break], parsed[-1])
+}
+
+#' Changing the line definition
+#'
+#' Input: New line denoted with `\\n`. Lines can span accross elements.
+#' Output: Each element in the vector is one line.
+#'
+#' @param raw Raw code to post-process.
+#' @keywords internal
+post_parse_roxygen <- function(raw) {
+  split <- raw %>%
+    paste0(collapse = "") %>%
+    strsplit("\n", fixed = TRUE)
+  split[[1]]
+}

R/roxygen-examples.R

@@ -0,0 +1,80 @@
+#' Style a roxygen code example that may contain dontrun and friends
+#'
+#' Parses roxygen2 comments into code, breaks it into dont* (dontrun, dontest,
+#' dontshow) and run sections and processes each segment indicidually using
+#' [style_roxygen_example_snippet()].
+#' @inheritParams parse_transform_serialize_r
+#' @param example Roxygen example code.
+#' @inheritSection parse_transform_serialize_roxygen Hierarchy
+#' @importFrom purrr map flatten_chr
+#' @keywords internal
+style_roxygen_code_example <- function(example, transformers) {
+  bare <- parse_roxygen(example)
+  one_dont <- split(bare, factor(cumsum(bare %in% dont_keywords())))
+  map(one_dont, style_roxygen_code_example_segment, transformers) %>%
+    flatten_chr() %>%
+    add_roxygen_mask()
+}
+
+#' Style a roxygen code example segment
+#'
+#' A roxygen code example segment corresponds to roxygen example code that
+#' contains at most one `\\dontrun{...}` or friends.
+#' We drop all newline characters first because otherwise the code segment
+#' passed to this function was previously parsed with [parse_roxygen()] and
+#' line-breaks in and after the `\\dontrun{...}` are expressed with `"\n"`, which
+#' contradicts to the definition used elsewhere in this package, where every
+#' element in a vector corresponds to a line. These line-breaks don't get
+#' eliminated because they move to the front of a `code_segment` and
+#' `style_text("\n1")` gives `"\n1"`, i.e. trailing newlines are not
+#' eliminated.
+#' @param one_dont Bare R code containing at most one `\\dontrun{...}` or
+#'   friends.
+#' @inheritParams parse_transform_serialize_r
+#' @inheritSection parse_transform_serialize_roxygen Hierarchy
+#' @importFrom rlang seq2
+#' @importFrom purrr map2 flatten_chr
+#' @keywords internal
+style_roxygen_code_example_segment <- function(one_dont, transformers) {
+  if (length(one_dont) < 1L) return(character())
+  dont_seqs <- find_dont_seqs(one_dont)
+  split_segments <- split_roxygen_segments(one_dont, unlist(dont_seqs))
+  is_dont <-
+    seq2(1L, length(split_segments$separated)) %in% split_segments$selectors
+
+  map2(split_segments$separated, is_dont,
+    style_roxygen_example_snippet,
+    transformers = transformers
+  ) %>%
+    flatten_chr()
+}
+
+#' Given a code snippet is dont* or run, style it
+#'
+#' @param code_snippet A character vector with code to style.
+#' @param is_dont Whether the snippet to process is a dontrun, dontshow,
+#'   donttest segemnt or not.
+#' @inheritParams parse_transform_serialize_r
+#' @inheritSection parse_transform_serialize_roxygen Hierarchy
+#' @keywords internal
+style_roxygen_example_snippet <- function(code_snippet,
+                                          transformers,
+                                          is_dont) {
+  if (is_dont) {
+    decomposed <- remove_dont_mask(code_snippet)
+    code_snippet <- decomposed$code
+    mask <- decomposed$mask
+  }
+  code_snippet <- post_parse_roxygen(code_snippet) %>%
+    paste0(collapse = "\n") %>%
+    parse_transform_serialize_r(transformers)
+
+  if (is_dont) {
+    code_snippet <- c(mask, code_snippet, "}")
+  }
+  code_snippet
+}
+
+dont_keywords <- function() {
+  c("\\dontrun", "\\dontshow", "\\donttest")
+}

R/testing.R

@@ -8,17 +8,13 @@
 #' @param sub_test A regex pattern to further reduce the amount of test files
 #'   to be tested in the test. `sub_test` must match the beginning of file
 #'   names in tests/testthat. `NULL` matches all files.
-#' @details Each file name that matches `test` and `sub_test` and ends with
-#'   "-in.R" is considered as an input to test. Its counterpart,
-#'   the reference to compare it against is the *-out.R file. It is constructed
-#'   by taking the substring of the *-in.R file before the
-#'   first dash and adding -out.R. This allows for multiple in.R files to
-#'   share one out.R file. You could have one_line-out.R as the reference to
-#'   compare one_line-random-something-stuff-in.R and
-#'   one_line-random-but-not-so-much-in.R.
-#'
-#'   This also implies that -out.R files cannot have more than one dash in
-#'   their name, i.e. just the one before out.R.
+#' @details
+#' Each file name that matches `test` and `sub_test` and ends with
+#' "-in.R" is considered as an input to test. Its counterpart,
+#' the reference to compare it against is the *-out.R file. It is constructed
+#' by taking the substring of the *-in.R file before the
+#' last dash and adding -out.R. In contrast to older versions of this
+#' function, every *-out.R file has just one in file.
 #' @inheritParams transform_and_check
 #' @importFrom purrr flatten_chr pwalk map
 #' @keywords internal
@@ -68,7 +64,7 @@ test_collection <- function(test, sub_test = NULL,
 #'  "path/to/file/first-extended-in.R"))
 #' @keywords internal
 construct_out <- function(in_paths) {
-  gsub("\\-.*([.]R(?:|md))$", "\\-out\\1", in_paths)
+  gsub("\\-in([.]R(?:|md))$", "\\-out\\1", in_paths)
 }
 
 #' Construct paths of a tree object given the paths of *-in.R files
@@ -125,10 +121,7 @@ transform_and_check <- function(in_item, out_item,
       immediate. = TRUE, call. = FALSE
     )
   } else {
-    message(
-      in_name, " was identical to ", out_name,
-      immediate. = TRUE, call. = FALSE
-    )
+    message(in_name, " was identical to ", out_name)
   }
 }
 
@@ -165,7 +158,7 @@ style_empty <- function(text) {
     reindention       = specify_reindention(),
     NULL
   )
-  transformed_text <- parse_transform_serialize(text, transformers)
+  transformed_text <- parse_transform_serialize_r(text, transformers)
   transformed_text
 }
 
@@ -184,7 +177,7 @@ style_op <- function(text) {
     NULL
   )
 
-  transformed_text <- parse_transform_serialize(text, transformers)
+  transformed_text <- parse_transform_serialize_r(text, transformers)
   transformed_text
 }