Add news.md support (#33)

* Add news.md support

* Polish NEWS

* Answer r cmd check issues

* Refactor merge_text_spaces

* Adjust unit tests

* Refactor merge_text_spaces

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: rd2markdown
 Title: Convert Rd Files into Markdown
-Version: 0.0.6
+Version: 0.0.7
 Authors@R:
     c(
       person(

NAMESPACE

@@ -40,6 +40,7 @@ S3method(rd2markdown,references)
 S3method(rd2markdown,section)
 S3method(rd2markdown,seealso)
 S3method(rd2markdown,source)
+S3method(rd2markdown,subsection)
 S3method(rd2markdown,tab)
 S3method(rd2markdown,tabular)
 S3method(rd2markdown,title)

NEWS.md

@@ -1,3 +1,20 @@
+rd2markdown 0.0.7
+-----------------
+
+* Add `rd2markdown.subsection` to further support various .Rd structures. And 
+  explicitly enhances the support for the inst/NEWS.rd files. (`?utils::news`)
+
+* `rd2markdown.section` now returns output as a block to make sure it is 
+  wrapped with new lines and renders sections properly.
+
+* add `merge_text_spaces` functions that merges standalone TEXT 
+  spaces (`" "`) into surrounding TEXT tags. Excessive spaces are not rendered
+  by markdown and therefore can be appended to other meaningful tags. (To later
+  get reduced by the "clean_text_whitespace")
+
+* Add `levels` parameter to most of the tags that could be nested in subsection
+  to make sure proper amount of `#` is appended.
+
 rd2markdown 0.0.6
 -----------------
 

R/map_rd2markdown.R

@@ -77,6 +77,7 @@ clean_text_newlines <- function(x) {
 #' @keywords internal
 #'
 clean_text_whitespace <- function(x) {
+  x <- merge_text_spaces(x)
   n <- length(x)
   if (n < 1) return(x)
 
@@ -102,6 +103,55 @@ clean_text_whitespace <- function(x) {
   x
 }
 
+#' Merge whitespace between text elements
+#'
+#' Within a series of text segments, there should be no separate text elements,
+#' which are spaces only. These should be merged together and to the next 
+#' non-space element if possible.
+#' 
+#' @param x `list` of Rd tags
+#'
+#' @examples
+#' \dontrun{
+#' x <- list(" a ", "`b`", " ", "  ", " c ", block(), "\n", "e   \n", "f")
+#' merge_text_spaces(x)
+#' # list(" a ", "`b`   ", " c ", block(), "\n", "e   \n", "f")
+#'
+#' x <- list(block(), " a ", "`b`", " c ", " ", block(), "   ",  " d ", "e ", "f", block())
+#' merge_text_spaces(x)
+#' # list(block(), "a ", "`b`", " c  ", block(), "    d ", "e ", "f", block())
+#' }
+#'
+#' @keywords internal
+merge_text_spaces <- function(x) {
+  if (length(x) == 0) return(x)
+
+  # assumes length x > 0
+  spaces <- grepl("^ *$", x, perl = TRUE)
+  is_text <- !spaces
+  blocks <- vlapply(x, is_block)
+  lag_blocks <- c(FALSE, blocks[-length(x)])
+
+  # find cells within each block that follow at least one non-space element
+  block_text_start <- cumsum(is_text) * blocks
+  block_text_index <- cumsum(is_text) - cumsum(block_text_start)
+  is_block_first_text <- block_text_index <= 1
+
+  # determine which spans of elements need to be flattened
+  groups <- cumsum(is_text & !is_block_first_text | blocks | lag_blocks)
+
+  # collapse non-block groups, maintain first-in-group's attributes
+  unname(lapply(split(x, groups), function(group) {
+    if (is_block(group[[1]])) {
+      group[[1]]
+    } else  {
+      atts <- attributes(group[[1]])
+      result <- paste(group, collapse = "")
+      attributes(result) <- atts
+      result
+    }
+  }))
+}
 
 
 is_consecutive <- function(x) {

R/rd2markdown.R

@@ -154,99 +154,109 @@ rd2markdown.title <- function(x, fragments = c(), ...) {
 }
 
 #' @param title optional section title
+#' @param level optional level parameter. 2L by default
 #'
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.description <- function(x, fragments = c(), ..., title = NULL) {
-  out <- map_rd2markdown(x, ..., collapse = "")
+rd2markdown.description <- function(x, fragments = c(), ..., title = NULL, level = 2L) {
+  out <- map_rd2markdown(x, ..., collapse = "", level = level + 1)
   out <- gsub("\n{1,}$", "", out)
   out <- gsub("\n*\\\\lifecycle\\{(.*)\\}\n*", "\n\nLifecycle: *\\1*\n\n", out)
-  with_md_title(out, title, 2L, ...)
+  with_md_title(out, title, level, ...)
 }
 
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.author <- function(x, fragments = c(), ...) {
-  rd2markdown.description(x, fragments = fragments, ..., title = "Author(s)")
+rd2markdown.author <- function(x, fragments = c(), ..., level = 2L) {
+  rd2markdown.description(x, fragments = fragments, ..., title = "Author(s)", level = level)
 }
 
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.format <- function(x, fragments = c(), ...) {
-  rd2markdown.description(x, fragments = fragments, ..., title = "Format")
+rd2markdown.format <- function(x, fragments = c(), ..., level = 2L) {
+  rd2markdown.description(x, fragments = fragments, ..., title = "Format", level = level)
 }
 
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.details <- function(x, fragments = c(), ...) {
-  rd2markdown.description(x, fragments = fragments, ..., title = "Details")
+rd2markdown.details <- function(x, fragments = c(), ..., level = 2L) {
+  rd2markdown.description(x, fragments = fragments, ..., title = "Details", level = level)
 }
 
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.note <- function(x, fragments = c(), ...) {
-  rd2markdown.description(x, fragments = fragments, ..., title = "Note")
+rd2markdown.note <- function(x, fragments = c(), ..., level = 2L) {
+  rd2markdown.description(x, fragments = fragments, ..., title = "Note", level = level)
 }
 
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.source <- function(x, fragments = c(), ...) {
-  rd2markdown.description(x, fragments = fragments, ..., title = "Source")
+rd2markdown.source <- function(x, fragments = c(), ..., level = 2L) {
+  rd2markdown.description(x, fragments = fragments, ..., title = "Source", level = level)
 }
 
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.value <- function(x, fragments = c(), ...) {
-  rd2markdown.description(x, fragments = fragments, ..., title = "Returns")
+rd2markdown.value <- function(x, fragments = c(), ..., level = 2L) {
+  rd2markdown.description(x, fragments = fragments, ..., title = "Returns", level = level)
 }
 
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.section <- function(x, fragments = c(), ...) {
+rd2markdown.section <- function(x, fragments = c(), ..., level = 2L) {
   title <- map_rd2markdown(x[[1]], collapse = "")
-  rd2markdown.description(x[[2]], fragments = fragments, ..., title = title)
+  # We need to make sure that sections are separated with new lines signs.
+  # As markdown ignroes extra new line signs when rendering docuemnts. We are
+  # safe to do it greedily
+  block(rd2markdown.description(x[[2]], fragments = fragments, ..., title = title, level = level))
 }
 
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.examples <- function(x, fragments = c(), ...) {
-  rd2markdown.usage(x, fragments = fragments, ..., title = "Examples")
+rd2markdown.subsection <- function(x, fragments = c(), ..., level = 2L) {
+  rd2markdown.section(x, fragments, ..., level = level)
 }
 
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.usage <- function(...) {
-  block(rd2markdown.preformatted(..., language = "r"))
+rd2markdown.examples <- function(x, fragments = c(), ..., level = 2L) {
+  rd2markdown.usage(x, fragments = fragments, ..., title = "Examples", level = level)
+}
+
+#' @exportS3Method
+#' @rdname rd2markdown
+rd2markdown.usage <- function(..., level = 2L) {
+  block(rd2markdown.preformatted(..., language = "r", level = level))
 }
 
 #' @param title optional section title
 #' @param language language to use as code fence syntax highlighter
 #'
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.preformatted <- function(x, fragments = c(), ..., title = NULL, language = "") {
+rd2markdown.preformatted <- function(x, fragments = c(), ..., title = NULL, language = "", level = 2L) {
   code <- capture.output(tools::Rd2txt(list(x), fragment = TRUE))
   code <- tail(code, -1L)  # remove "usage" title
   code <- gsub("^\\n?\\s{5}", "", code)  # remove leading white space
   code <- sprintf("```%s\n%s\n```", language, trimws(paste0(code, collapse = "\n")))
-  with_md_title(code, title, 2L, ...)
+  with_md_title(code, title, level, ...)
 }
 
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.references <- function(x, fragments = c(), ...) {
-  rd2markdown.description(x, fragments = fragments, ..., title = "References")
+rd2markdown.references <- function(x, fragments = c(), ..., level = 2L) {
+  rd2markdown.description(x, fragments = fragments, ..., title = "References", level = level)
 }
 
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.seealso <- function(x, fragments = c(), ...) {
-  rd2markdown.description(x, fragments = fragments, ..., title = "See Also")
+rd2markdown.seealso <- function(x, fragments = c(), ..., level = 2L) {
+  rd2markdown.description(x, fragments = fragments, ..., title = "See Also", level = level)
 }
 
 #' @exportS3Method
 #' @rdname rd2markdown
-rd2markdown.arguments <- function(x, fragments = c(), ...) {
+rd2markdown.arguments <- function(x, fragments = c(), ..., level = 2L) {
   # ignore whitespace text tags
   x <- x[!vlapply(x, is_ws)]
 
@@ -276,7 +286,7 @@ rd2markdown.arguments <- function(x, fragments = c(), ...) {
 
   # Content of the arguments consists of other fragments, therefore we
   # overwrite fragments param so they can be included
-  paste0("## Arguments\n\n", map_rd2markdown(new_x, ..., collapse = ""))
+  paste0(strrep("#", level), " Arguments\n\n", map_rd2markdown(new_x, ..., collapse = ""))
 }
 
 #' @exportS3Method

tests/testthat/test-map_rd2markdown.R

@@ -5,3 +5,36 @@ test_that("A list of fragments can be mapped over to individually map to markdow
   expect_true(all(sapply(md, is.character)))
   expect_silent(md <- map_rd2markdown(rd, strwrap = 30L))
 })
+
+test_that("merge_text_spaces works as expected", {
+  x <- list("    ", " ", "   ")
+  expect_equal(
+    merge_text_spaces(x),
+    list("        ")
+  )
+
+  x <- list(" a ", "`b`", "  ", "  ", " c ", " ", " ")
+  expect_equal(
+    merge_text_spaces(x),
+    list(" a ", "`b`    ", " c   ")
+  )
+
+  x <- list(" a ", "`b`", " ", "  ", "    c ", block(), "\n", "e   \n", "f")
+  expect_equal(
+    merge_text_spaces(x),
+    list(" a ", "`b`   ", "    c ", block(), "\ne   \n", "f")
+  )
+
+  x <- list(" a ", "`b`", " ", "  ", " c ", block(), " ", "   ", block())
+  expect_equal(
+    merge_text_spaces(x),
+    list(" a ", "`b`   ", " c ", block(), "    ", block())
+  )
+
+  x <- list(block(), " ", "      ", block())
+  expect_equal(
+    merge_text_spaces(x),
+    list(block(), "       ", block())
+  )
+})
+