Merge pull request #263 from ThinkR-open/256-codecov_inflate

256 codecov inflate

DESCRIPTION

@@ -20,13 +20,15 @@ Depends:
 Imports: 
     attachment,
     cli,
+    covr,
     desc,
     devtools,
     glue,
     here (>= 1.0.0),
     lightparser,
     magrittr,
     methods,
+    pkgload,
     roxygen2,
     stats,
     stringi,
@@ -39,7 +41,6 @@ Imports:
 Suggests: 
     gert,
     knitr,
-    pkgload,
     rcmdcheck,
     rmarkdown,
     rstudioapi,
@@ -48,7 +49,7 @@ Suggests:
     withr
 VignetteBuilder: 
     knitr
-Config/fusen/version: 0.6.0.9001
+Config/fusen/version: 0.6.0.9002
 Config/testthat/edition: 3
 Config/testthat/parallel: false
 Encoding: UTF-8

NAMESPACE

@@ -31,17 +31,20 @@ importFrom(cli,cli_alert_danger)
 importFrom(cli,cli_alert_info)
 importFrom(cli,cli_alert_success)
 importFrom(cli,cli_alert_warning)
+importFrom(covr,package_coverage)
 importFrom(devtools,check)
 importFrom(glue,glue)
 importFrom(magrittr,"%>%")
 importFrom(methods,formalArgs)
+importFrom(pkgload,unload)
 importFrom(stats,na.omit)
 importFrom(stats,setNames)
 importFrom(stringi,stri_trans_general)
 importFrom(tibble,as_tibble)
 importFrom(tibble,tibble)
 importFrom(tools,file_path_sans_ext)
 importFrom(utils,getFromNamespace)
+importFrom(utils,osVersion)
 importFrom(utils,read.csv)
 importFrom(utils,write.csv)
 importFrom(yaml,read_yaml)

R/inflate-utils.R

@@ -77,7 +77,7 @@ parse_fun <- function(x) { # x <- rmd_fun[3,]
     # If chunk all empty
     code <- character(0)
   } else if (!is.na(first_function_start) &&
-    !any(grepl("@export|@noRd", code[1:first_function_start]))) {
+             !any(grepl("@export|@noRd", code[1:first_function_start]))) {
     if (!is.na(last_hastags_above_first_fun)) {
       code <- c(
         code[1:last_hastags_above_first_fun],
@@ -142,7 +142,7 @@ parse_fun <- function(x) { # x <- rmd_fun[3,]
 add_names_to_parsed <- function(parsed_tbl, fun_code) {
   # Which parts were functions
   which_parsed_fun <- which(!is.na(parsed_tbl$label) &
-    grepl(regex_functions, parsed_tbl$label))
+                              grepl(regex_functions, parsed_tbl$label))
 
   # From fun_code, we retrieve fun_name & rox_filename
   parsed_tbl[["fun_name"]] <- NA_character_
@@ -175,7 +175,7 @@ add_names_to_parsed <- function(parsed_tbl, fun_code) {
         sec_title_name[["sec_title"]] == x, "sec_fun_name"
       ]
       parsed_tbl[group, "sec_fun_name"] <- ifelse(length(sec_fun_name) == 0,
-        NA_character_, as.character(sec_fun_name)
+                                                  NA_character_, as.character(sec_fun_name)
       )
       parsed_tbl[group, ] <- tidyr::fill(
         parsed_tbl[group, ],
@@ -204,7 +204,7 @@ add_names_to_parsed <- function(parsed_tbl, fun_code) {
   pkg_filled[["file_name"]] <- NA_character_
   # chunk_filename
   pkg_filled[["file_name"]] <- ifelse(!is.na(pkg_filled[["chunk_filename"]]),
-    pkg_filled[["chunk_filename"]], NA_character_
+                                      pkg_filled[["chunk_filename"]], NA_character_
   )
   # rox_filename
   pkg_filled[["file_name"]] <- ifelse(
@@ -280,7 +280,7 @@ parse_test <- function(x, pkg, relative_flat_file) { # x <- rmd_test[1,]
 add_fun_code_examples <- function(parsed_tbl, fun_code) {
   # Example in separate chunk
   which_parsed_ex <- which(!is.na(parsed_tbl$label) &
-    grepl(regex_example, parsed_tbl$label))
+                             grepl(regex_example, parsed_tbl$label))
   rmd_ex <- parsed_tbl[which_parsed_ex, ]
 
   # Get file_name variable
@@ -292,8 +292,8 @@ add_fun_code_examples <- function(parsed_tbl, fun_code) {
   fun_code <- fun_code[order(fun_code[["order"]]), ]
   # Get file_name for not functions. Only last place where possible
   fun_code[["file_name"]] <- ifelse(is.na(fun_code[["file_name"]]),
-    fun_code[["sec_title"]],
-    fun_code[["file_name"]]
+                                    fun_code[["sec_title"]],
+                                    fun_code[["file_name"]]
   )
 
   #  Example already in skeleton
@@ -378,8 +378,8 @@ add_fun_code_examples <- function(parsed_tbl, fun_code) {
       }
 
       end_skeleton <- ifelse(is.na(fun_code_x[["example_pos_start"]]),
-        fun_code_x[["example_pos_end"]],
-        fun_code_x[["example_pos_start"]] - 1
+                             fun_code_x[["example_pos_end"]],
+                             fun_code_x[["example_pos_start"]] - 1
       )
 
       all_fun_code <- stats::na.omit(c(
@@ -392,7 +392,7 @@ add_fun_code_examples <- function(parsed_tbl, fun_code) {
         # end
         unlist(fun_code_x[["code"]])[
           (fun_code_x[["example_pos_end"]] + 1):
-          length(unlist(fun_code_x[["code"]]))
+            length(unlist(fun_code_x[["code"]]))
         ]
       ))
       return(all_fun_code)
@@ -476,14 +476,14 @@ create_vignette_head <- function(pkg, vignette_name, yaml_options = NULL) {
 title: ".{vignette_title}."
 output: rmarkdown::html_vignette',
       ifelse(length(yaml_options) != 0,
-        glue::glue_collapse(
-          c(
-            "",
-            glue("{names(yaml_options)}: \"{yaml_options}\""), ""
-          ),
-          sep = "\n"
-        ),
-        "\n"
+             glue::glue_collapse(
+               c(
+                 "",
+                 glue("{names(yaml_options)}: \"{yaml_options}\""), ""
+               ),
+               sep = "\n"
+             ),
+             "\n"
       ),
       'vignette: >
   %\\VignetteIndexEntry{.{vignette_name}.}
@@ -502,7 +502,7 @@ knitr::opts_chunk$set(
 library(.{pkgname}.)
 ```
     ',
-      .open = ".{", .close = "}."
+    .open = ".{", .close = "}."
     )
   )
 }
@@ -623,3 +623,27 @@ document_and_check_pkg <- function(pkg = ".", document = TRUE, check = TRUE, ...
     print(res)
   }
 }
+
+#' Document and check current package
+#' @param pkg Path to package
+#' @importFrom pkgload unload
+#' @importFrom covr package_coverage
+#' @importFrom utils osVersion
+#' @noRd
+compute_codecov <- function(pkg = ".") {
+  on_windows <- grepl("windows", tolower(osVersion))
+  if (on_windows) {
+    # On windows, package_coverage() will fail
+    # if called right alfer a pkgload::load_all()
+    pkgload::unload(
+      basename(
+        normalizePath(
+          pkg
+        )
+      )
+    )
+  }
+  print(
+    covr::package_coverage()
+  )
+}

R/inflate.R

@@ -33,13 +33,15 @@ regex_example <- paste(regex_example_vec, collapse = "|")
 #'  in the flat file. Default to "ask".
 #' @param update_params Logical. Whether to update the inflate parameters
 #'  in the configuration file.
+#' @param codecov Logical. Whether to compute code coverage (with `covr::package_coverage()` or `covr::report()`).
 #' @param ... Arguments passed to `devtools::check()`.
 #'  For example, you can do `inflate(check = TRUE, quiet = TRUE)`,
 #'  where `quiet` is passed to `devtools::check()`.
 #'
 #' @importFrom utils getFromNamespace
 #' @importFrom glue glue
 #' @importFrom methods formalArgs
+#' @importFrom covr package_coverage
 #'
 #' @return
 #' Package structure. Return path to current package.
@@ -79,6 +81,7 @@ inflate <- function(pkg = ".", flat_file,
                     overwrite = "ask",
                     clean = "ask",
                     update_params = TRUE,
+                    codecov = FALSE,
                     ...) {
   if (!is.null(list(...)[["name"]])) {
     stop(paste0(
@@ -363,6 +366,10 @@ inflate <- function(pkg = ".", flat_file,
     ...
   )
 
+  if (codecov) {
+    cli::cli_alert_info("Computing code coverage - it might take some time")
+    compute_codecov(pkg = pkg)
+  }
 
   # Restart RStudio
   is_rstudio <- Sys.getenv("RSTUDIO") == "1"

R/inflate_all.R

@@ -97,6 +97,12 @@
 #'   inflate_all(check = FALSE, document = TRUE)
 #' })
 #'
+#' # If you wish, the code coverage can be computed
+#' usethis::with_project(dummypackage, {
+#'   # now you can run inflate_all()
+#'   inflate_all(check = FALSE, document = TRUE, codecov = TRUE)
+#' })
+#'
 #' # Clean the temporary directory
 #' unlink(dummypackage, recursive = TRUE)
 inflate_all <- function(
@@ -106,6 +112,7 @@ inflate_all <- function(
     open_vignette = FALSE,
     overwrite = TRUE,
     check_unregistered = TRUE,
+    codecov = FALSE,
     stylers, ...) {
   config_file <- getOption("fusen.config_file", default = "dev/config_fusen.yaml")
 
@@ -162,6 +169,7 @@ inflate_all <- function(
           flat_file$document <- FALSE
           flat_file$check <- FALSE
           flat_file$update_params <- FALSE
+          flat_file$codecov <- FALSE
           suppressMessages(do.call(inflate, flat_file))
         })
       )
@@ -197,11 +205,16 @@ inflate_all <- function(
     ...
   )
 
+  if (codecov) {
+    cli::cli_alert_info("Computing code coverage - it might take some time")
+    compute_codecov(pkg = pkg)
+  }
+
   invisible(pkg)
 }
 
 #' @rdname inflate_all
 #' @export
-inflate_all_no_check <- function(pkg = ".", document = TRUE, open_vignette = FALSE, overwrite = TRUE, check_unregistered = TRUE, stylers, ...) {
-  inflate_all(pkg = pkg, document = document, check = FALSE, open_vignette = open_vignette, overwrite = overwrite, check_unregistered = check_unregistered, stylers, ...)
+inflate_all_no_check <- function(pkg = ".", document = TRUE, open_vignette = FALSE, overwrite = TRUE, check_unregistered = TRUE, codecov = FALSE, stylers, ...) {
+  inflate_all(pkg = pkg, document = document, check = FALSE, open_vignette = open_vignette, overwrite = overwrite, check_unregistered = check_unregistered, codecov = codecov, stylers, ...)
 }

dev/config_fusen.yaml

@@ -96,6 +96,7 @@ flat_inflate_all.Rmd:
     document: true
     overwrite: 'yes'
     clean: ask
+    codecov: false
 flat_inflate_all_utils.Rmd:
   path: dev/flat_inflate_all_utils.Rmd
   state: active
@@ -114,6 +115,7 @@ flat_inflate_all_utils.Rmd:
     document: true
     overwrite: 'yes'
     clean: ask
+    codecov: false
 flat_init_share_on_github.Rmd:
   path: dev/flat_init_share_on_github.Rmd
   state: active