diff --git a/R/add_flat_template.R b/R/add_flat_template.R index 661fc01..fbba490 100644 --- a/R/add_flat_template.R +++ b/R/add_flat_template.R @@ -2,11 +2,13 @@ #' @rdname add_flat_template #' @export -add_additional <- function(pkg = ".", - dev_dir = "dev", - flat_name = "additional", - overwrite = FALSE, - open = TRUE) { +add_additional <- function( + pkg = ".", + dev_dir = "dev", + flat_name = "additional", + overwrite = FALSE, + open = TRUE +) { add_flat_template( template = "additional", pkg = pkg, @@ -19,11 +21,13 @@ add_additional <- function(pkg = ".", #' @rdname add_flat_template #' @export -add_minimal_flat <- function(pkg = ".", - dev_dir = "dev", - flat_name = "minimal", - overwrite = FALSE, - open = TRUE) { +add_minimal_flat <- function( + pkg = ".", + dev_dir = "dev", + flat_name = "minimal", + overwrite = FALSE, + open = TRUE +) { add_flat_template( template = "minimal_flat", pkg = pkg, @@ -36,11 +40,13 @@ add_minimal_flat <- function(pkg = ".", #' @rdname add_flat_template #' @export -add_minimal_package <- function(pkg = ".", - dev_dir = "dev", - flat_name = "minimal", - overwrite = FALSE, - open = TRUE) { +add_minimal_package <- function( + pkg = ".", + dev_dir = "dev", + flat_name = "minimal", + overwrite = FALSE, + open = TRUE +) { add_flat_template( template = "minimal_package", pkg = pkg, @@ -53,11 +59,13 @@ add_minimal_package <- function(pkg = ".", #' @rdname add_flat_template #' @export -add_full <- function(pkg = ".", - dev_dir = "dev", - flat_name = "full", - overwrite = FALSE, - open = TRUE) { +add_full <- function( + pkg = ".", + dev_dir = "dev", + flat_name = "full", + overwrite = FALSE, + open = TRUE +) { add_flat_template( template = "full", pkg = pkg, @@ -70,10 +78,12 @@ add_full <- function(pkg = ".", #' @rdname add_flat_template #' @export -add_dev_history <- function(pkg = ".", - dev_dir = "dev", - overwrite = FALSE, - open = TRUE) { +add_dev_history <- function( + pkg = ".", + dev_dir = "dev", + overwrite = FALSE, + open = TRUE +) { add_flat_template( template = "dev_history", pkg = pkg, @@ -86,10 +96,16 @@ add_dev_history <- function(pkg = ".", flat_template_choices <- c( "full", - "minimal_package", "minpkg", - "minimal_flat", "minflat", "add", "additional", - "teach", "teaching", - "dev_history", "dev" + "minimal_package", + "minpkg", + "minimal_flat", + "minflat", + "add", + "additional", + "teach", + "teaching", + "dev_history", + "dev" ) create_fusen_choices <- c("full", "minimal", "teaching", "dev_history") @@ -156,17 +172,20 @@ create_fusen_choices <- c("full", "minimal", "teaching", "dev_history") #' # add new flat template for teaching (a reduced full template) #' add_flat_template("teaching") #' } -add_flat_template <- function(template = c("full", "minimal_package", "minimal_flat", "additional", "teaching", "dev_history"), - pkg = ".", - dev_dir = "dev", - flat_name = NULL, - overwrite = FALSE, - open = TRUE) { +add_flat_template <- function( + template = c("full", "minimal_package", "minimal_flat", "additional", "teaching", "dev_history"), + pkg = ".", + dev_dir = "dev", + flat_name = NULL, + overwrite = FALSE, + open = TRUE +) { project_name <- get_pkg_name(pkg = pkg) if (project_name != asciify_name(project_name, to_pkg = TRUE)) { stop( - "Please rename your project/directory with: `", asciify_name(project_name, to_pkg = TRUE), + "Please rename your project/directory with: `", + asciify_name(project_name, to_pkg = TRUE), "` as a package name should only contain letters, numbers and dots." ) } @@ -207,7 +226,8 @@ add_flat_template <- function(template = c("full", "minimal_package", "minimal_f } flat_name <- paste0( "flat_", - asciify_name(gsub("[.]Rmd$", "", flat_name[1])), ".Rmd" + asciify_name(gsub("[.]Rmd$", "", flat_name[1])), + ".Rmd" ) pkg <- normalizePath(pkg) @@ -227,8 +247,10 @@ add_flat_template <- function(template = c("full", "minimal_package", "minimal_f n <- length(list.files(full_dev_dir, pattern = "^flat_.*[.]Rmd")) dev_file_path <- file.path(full_dev_dir, paste0(file_path_sans_ext(flat_name), "_", n + 1, ".Rmd")) message( - flat_name, " already exists. New flat file is renamed '", - basename(dev_file_path), "'. Use overwrite = TRUE, if you want to ", + flat_name, + " already exists. New flat file is renamed '", + basename(dev_file_path), + "'. Use overwrite = TRUE, if you want to ", "overwrite the existing file or rename it." ) } @@ -239,7 +261,8 @@ add_flat_template <- function(template = c("full", "minimal_package", "minimal_f lines_template[grepl("", lines_template)] <- gsub( - "", project_name, + "", + project_name, lines_template[grepl("", lines_template)] ) @@ -247,13 +270,15 @@ add_flat_template <- function(template = c("full", "minimal_package", "minimal_f # _inflate lines_template[grepl("dev/flat_template.Rmd", lines_template)] <- gsub( - "dev/flat_template.Rmd", file.path(dev_dir, dev_name), + "dev/flat_template.Rmd", + file.path(dev_dir, dev_name), lines_template[grepl("dev/flat_template.Rmd", lines_template)] ) # _title lines_template[grepl("flat_template.Rmd", lines_template)] <- gsub( - "flat_template.Rmd", dev_name, + "flat_template.Rmd", + dev_name, lines_template[grepl("flat_template.Rmd", lines_template)] ) @@ -261,7 +286,8 @@ add_flat_template <- function(template = c("full", "minimal_package", "minimal_f if (!is.na(fun_name)) { lines_template[grepl("my_fun", lines_template)] <- gsub( - "my_fun", fun_name, + "my_fun", + fun_name, lines_template[grepl("my_fun", lines_template)] ) } diff --git a/R/build_fusen_chunks.R b/R/build_fusen_chunks.R index f75e189..877098c 100644 --- a/R/build_fusen_chunks.R +++ b/R/build_fusen_chunks.R @@ -18,8 +18,10 @@ #' \dontrun{ #' add_fusen_chunks("this", export = TRUE) #' } -add_fusen_chunks <- function(function_name = NULL, - export = getOption("fusen.export.functions")) { +add_fusen_chunks <- function( + function_name = NULL, + export = getOption("fusen.export.functions") +) { if ( requireNamespace("rstudioapi") && rstudioapi::isAvailable() && @@ -94,7 +96,10 @@ build_fusen_chunks <- function(function_name, export = TRUE) { if (function_name != cleaned_function_name) { message( - "Your function name was cleaned: `", function_name, "` is now `", cleaned_function_name, + "Your function name was cleaned: `", + function_name, + "` is now `", + cleaned_function_name, "` as a function name should only contain letters, numbers and underscores." ) function_name <- cleaned_function_name diff --git a/R/create_fusen_rsproject.R b/R/create_fusen_rsproject.R index 462aa86..cd57ad2 100644 --- a/R/create_fusen_rsproject.R +++ b/R/create_fusen_rsproject.R @@ -20,19 +20,22 @@ #' @examples #' my_path <- tempfile("mypkg") #' create_fusen(path = my_path, template = "full", open = FALSE) -create_fusen <- function(path, - template = c("full", "minimal", "teaching", "dev_history"), - flat_name = template, - open = TRUE, - overwrite = FALSE, - with_git = FALSE) { +create_fusen <- function( + path, + template = c("full", "minimal", "teaching", "dev_history"), + flat_name = template, + open = TRUE, + overwrite = FALSE, + with_git = FALSE +) { path <- normalizePath(path, mustWork = FALSE) template <- match.arg(template, choices = create_fusen_choices) project_name <- get_pkg_name(pkg = path) if (project_name != asciify_name(project_name, to_pkg = TRUE)) { stop( - "Please rename your project/directory with: `", asciify_name(project_name, to_pkg = TRUE), + "Please rename your project/directory with: `", + asciify_name(project_name, to_pkg = TRUE), "` as a package name should only contain letters, numbers and dots." ) } @@ -40,7 +43,9 @@ create_fusen <- function(path, if (dir.exists(path)) { cli::cli_alert_warning( paste( - "The path:", path, "already exists." + "The path:", + path, + "already exists." ) ) if (!isTRUE(overwrite)) { @@ -120,10 +125,12 @@ create_fusen <- function(path, #' This will only work with Rstudio Project Wizard #' @noRd -create_fusen_gui <- function(path, - template, - flat_name = template, - with_git) { +create_fusen_gui <- function( + path, + template, + flat_name = template, + with_git +) { create_fusen( path = file.path(normalize_path_winslash(getwd()), path), template = template, diff --git a/R/deprecate_flat_file.R b/R/deprecate_flat_file.R index 0565f49..ce46a56 100644 --- a/R/deprecate_flat_file.R +++ b/R/deprecate_flat_file.R @@ -20,7 +20,9 @@ #' dev_file <- suppressMessages( #' add_flat_template( #' template = "add", -#' pkg = dummypackage, overwrite = TRUE, open = FALSE +#' pkg = dummypackage, +#' overwrite = TRUE, +#' open = FALSE #' ) #' ) #' deprecate_flat_file(flat_file = "dev/flat_additional.Rmd") @@ -33,14 +35,16 @@ deprecate_flat_file <- function(flat_file) { if (!file.exists(flat_file)) { stop( paste0( - "The flat file ", basename(flat_file), + "The flat file ", + basename(flat_file), " does not exist." ) ) } else if (!basename(flat_file) %in% names(config)) { stop( paste0( - "The flat file ", basename(flat_file), + "The flat file ", + basename(flat_file), " is not in the config file.", "Did you inflate it with {fusen}?" ) @@ -48,7 +52,8 @@ deprecate_flat_file <- function(flat_file) { } else if (config[[basename(flat_file)]]$state == "deprecated") { cli_alert_warning( paste0( - "The flat file ", basename(flat_file), + "The flat file ", + basename(flat_file), " is already deprecated." ) ) @@ -126,7 +131,8 @@ deprecate_flat_file <- function(flat_file) { cli_alert_success( paste0( - "The flat file ", basename(flat_file), + "The flat file ", + basename(flat_file), " has been deprecated." ) ) diff --git a/R/fill_description.R b/R/fill_description.R index 3eb068b..f32d814 100644 --- a/R/fill_description.R +++ b/R/fill_description.R @@ -26,9 +26,12 @@ #' "Everything can be set from a Rmarkdown file in your project." #' ), #' `Authors@R` = c( -#' person("John", "Doe", +#' person( +#' "John", +#' "Doe", #' email = "john@email.me", -#' role = c("aut", "cre"), comment = c(ORCID = "0000-0000-0000-0000") +#' role = c("aut", "cre"), +#' comment = c(ORCID = "0000-0000-0000-0000") #' ) #' ) #' ) @@ -46,7 +49,8 @@ fill_description <- function(pkg = ".", fields, overwrite = FALSE) { clean_pkg_name <- asciify_name(project_name, to_pkg = TRUE) if (project_name != clean_pkg_name) { warning( - "Your package was renamed: `", clean_pkg_name, + "Your package was renamed: `", + clean_pkg_name, "` as a package name should only contain letters, numbers and dots." ) } diff --git a/R/get_all_created_funs.R b/R/get_all_created_funs.R index 11a63d4..ee3a214 100644 --- a/R/get_all_created_funs.R +++ b/R/get_all_created_funs.R @@ -26,7 +26,8 @@ get_all_created_funs <- function(file) { parts <- lapply(attr(parts_parsed, "srcref"), as.character) all_functions <- lapply( - seq_along(parts), function(x) { + seq_along(parts), + function(x) { out <- list() out$code <- as.character(parts[x]) name <- parse_fun(out)$fun_name diff --git a/R/get_package_structure.R b/R/get_package_structure.R index 3a8eee0..e4f634a 100644 --- a/R/get_package_structure.R +++ b/R/get_package_structure.R @@ -43,8 +43,10 @@ #' # Works with 'fusen' package #' suppressMessages( #' inflate( -#' pkg = dummypackage, flat_file = flat_file, -#' vignette_name = "Get started", check = FALSE, +#' pkg = dummypackage, +#' flat_file = flat_file, +#' vignette_name = "Get started", +#' check = FALSE, #' open_vignette = FALSE #' ) #' ) @@ -53,9 +55,10 @@ #' draw_package_structure(pkg_structure) #' }) get_package_structure <- function( - config_file, - emoji = TRUE, - silent = FALSE) { + config_file, + emoji = TRUE, + silent = FALSE +) { if (missing(config_file)) { yaml_fusen_file_orig <- getOption( "fusen_config_file", @@ -117,10 +120,14 @@ get_package_structure <- function( if (emoji) { flat_state <- yaml_fusen[[flat_file]]$state yaml_fusen[[flat_file]]$state <- - paste(ifelse( - flat_state == "active", - "\U0001f34f", "\U0001f6d1" - ), flat_state) + paste( + ifelse( + flat_state == "active", + "\U0001f34f", + "\U0001f6d1" + ), + flat_state + ) } # Get the list of R files with their functions @@ -132,9 +139,12 @@ get_package_structure <- function( exported <- paste0("export(", functions, ")") %in% namespace if (emoji) { functions <- paste( - ifelse(exported, - "\U0001f440", "\U0001f648" - ), functions + ifelse( + exported, + "\U0001f440", + "\U0001f648" + ), + functions ) } else { functions <- paste( diff --git a/R/globals.R b/R/globals.R index 4e52b84..42eb67e 100644 --- a/R/globals.R +++ b/R/globals.R @@ -2,7 +2,10 @@ globalVariables(unique(c( # add_fun_code_examples ".", # add_fun_to_parsed - "fun_name", "rox_filename", "chunk_filename", ".", + "fun_name", + "rox_filename", + "chunk_filename", + ".", # get_functions "." ))) diff --git a/R/inflate-utils.R b/R/inflate-utils.R index 45b22ce..78211d2 100644 --- a/R/inflate-utils.R +++ b/R/inflate-utils.R @@ -39,7 +39,8 @@ parse_fun <- function(x) { # x <- rmd_fun[3,] # Get lines before "function" if code on multiple lines # Parse only code and not all the rest code_clean_first_fun <- gsub( - "\\n", " ", + "\\n", + " ", as.character(parse(text = code)) ) code_clean_first_fun <- code_clean_first_fun[grepl(regex_isfunction, code_clean_first_fun)][1] @@ -77,7 +78,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], @@ -113,11 +114,13 @@ parse_fun <- function(x) { # x <- rmd_fun[3,] # Get @rdname and @filename for grouping functions tag_filename <- gsub( - "^#'\\s*@filename\\s*", "", + "^#'\\s*@filename\\s*", + "", code[grep("^#'\\s*@filename", code)] ) tag_rdname <- gsub( - "^#'\\s*@rdname\\s*", "", + "^#'\\s*@rdname\\s*", + "", code[grep("^#'\\s*@rdname", code)] ) rox_filename <- c(tag_filename, tag_rdname)[1] @@ -142,7 +145,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_ @@ -172,29 +175,42 @@ add_names_to_parsed <- function(parsed_tbl, fun_code) { # reorder chunks for fun, ex, test ? # however, what happens when multiple groups under same title ? sec_fun_name <- sec_title_name[ - sec_title_name[["sec_title"]] == x, "sec_fun_name" + 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) + parsed_tbl[group, "sec_fun_name"] <- ifelse( + length(sec_fun_name) == 0, + NA_character_, + as.character(sec_fun_name) ) parsed_tbl[group, ] <- tidyr::fill( parsed_tbl[group, ], - fun_name, rox_filename, chunk_filename, + fun_name, + rox_filename, + chunk_filename, .direction = "down" ) parsed_tbl[group, ] <- tidyr::fill( parsed_tbl[group, ], - fun_name, rox_filename, chunk_filename, + fun_name, + rox_filename, + chunk_filename, .direction = "up" ) }) %>% do.call("rbind", .) parsed_tbl[["fun_name"]][pkg_filled[["order"]]] <- pkg_filled[["fun_name"]] } else { - pkg_filled <- parsed_tbl[, c( - "fun_name", "chunk_filename", "rox_filename", - "sec_fun_name", "sec_title" - )] + pkg_filled <- parsed_tbl[ + , + c( + "fun_name", + "chunk_filename", + "rox_filename", + "sec_fun_name", + "sec_title" + ) + ] pkg_filled[, "order"] <- 1:nrow(pkg_filled) } @@ -203,8 +219,10 @@ add_names_to_parsed <- function(parsed_tbl, fun_code) { # If sec_title, choose fun_name of the first function 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[["file_name"]] <- ifelse( + !is.na(pkg_filled[["chunk_filename"]]), + pkg_filled[["chunk_filename"]], + NA_character_ ) # rox_filename pkg_filled[["file_name"]] <- ifelse( @@ -255,7 +273,9 @@ parse_test <- function(x, pkg, relative_flat_file) { # x <- rmd_test[1,] file_name <- x[["file_name"]] test_file <- file.path( - pkg, "tests", "testthat", + pkg, + "tests", + "testthat", paste0("test-", asciify_name(file_name), ".R") ) @@ -280,7 +300,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 @@ -291,9 +311,10 @@ add_fun_code_examples <- function(parsed_tbl, fun_code) { fun_code <- as_tibble(merge(fun_code, fun_file_groups, by = "fun_name", all.x = TRUE, sort = FALSE)) 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[["file_name"]] <- ifelse( + is.na(fun_code[["file_name"]]), + fun_code[["sec_title"]], + fun_code[["file_name"]] ) # Example already in skeleton @@ -313,7 +334,8 @@ add_fun_code_examples <- function(parsed_tbl, fun_code) { if (nrow(ex_alone) != 0) { message( "Some example chunks are not associated to any function: ", - paste(ex_alone[["label"]], collapse = ", "), ".", + paste(ex_alone[["label"]], collapse = ", "), + ".", "\nIf you plan to include them only in the vignette, then ", "you can give them any other name except `dev*`, `fun*`, `test*`" ) @@ -377,9 +399,10 @@ 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 + end_skeleton <- ifelse( + is.na(fun_code_x[["example_pos_start"]]), + fun_code_x[["example_pos_end"]], + fun_code_x[["example_pos_start"]] - 1 ) all_fun_code <- stats::na.omit(c( @@ -392,7 +415,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) @@ -475,15 +498,17 @@ 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" + ifelse( + length(yaml_options) != 0, + glue::glue_collapse( + c( + "", + glue("{names(yaml_options)}: \"{yaml_options}\""), + "" + ), + sep = "\n" + ), + "\n" ), 'vignette: > %\\VignetteIndexEntry{.{vignette_name}.} @@ -502,7 +527,8 @@ knitr::opts_chunk$set( library(.{pkgname}.) ``` ', - .open = ".{", .close = "}." + .open = ".{", + .close = "}." ) ) } @@ -557,11 +583,14 @@ asciify_name <- function(name, to_pkg = FALSE) { name <- stri_trans_general(name, id = "Latin-ASCII") cleaned_name <- gsub( - "^[.]*|^-|-$", "", + "^[.]*|^-|-$", + "", gsub( - "-+", "-", + "-+", + "-", gsub( - "-_|_-", "-", + "-_|_-", + "-", gsub("[^([:alnum:]*_*-*)*]", "-", name) ) ) @@ -569,7 +598,8 @@ asciify_name <- function(name, to_pkg = FALSE) { if (isTRUE(to_pkg)) { cleaned_name <- gsub( - "[^a-zA-Z0-9]+", ".", + "[^a-zA-Z0-9]+", + ".", gsub("^[0-9]+", "", cleaned_name) ) } else { @@ -585,9 +615,11 @@ asciify_name <- function(name, to_pkg = FALSE) { #' @noRd clean_function_name <- function(name) { gsub( - "-", "_", + "-", + "_", gsub( - "^\\s*|\\s*$|^[0-9]*|^-*|-*$", "", + "^\\s*|\\s*$|^[0-9]*|^-*|-*$", + "", asciify_name(name, to_pkg = FALSE) ) ) diff --git a/R/inflate.R b/R/inflate.R index 2dcea79..e7aaef3 100644 --- a/R/inflate.R +++ b/R/inflate.R @@ -1,8 +1,13 @@ # Previously generated by {fusen} from dev/flat_history/flat_history_core.Rmd: now deprecated. # The regex to identify chunk names regex_functions_vec <- c( - "^function", "^fun$", "^fun-", "^fun_", - "^funs$", "^funs-", "^funs_" + "^function", + "^fun$", + "^fun-", + "^fun_", + "^funs$", + "^funs-", + "^funs_" ) regex_functions <- paste(regex_functions_vec, collapse = "|") regex_tests_vec <- c("^test") @@ -60,8 +65,10 @@ regex_example <- paste(regex_example_vec, collapse = "|") #' flat_file <- dev_file[grepl("flat", dev_file)] #' fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package")) #' inflate( -#' pkg = dummypackage, flat_file = flat_file, -#' vignette_name = "Exploration of my Data", check = FALSE +#' pkg = dummypackage, +#' flat_file = flat_file, +#' vignette_name = "Exploration of my Data", +#' check = FALSE #' ) #' #' # Explore directory of the package @@ -73,21 +80,26 @@ regex_example <- paste(regex_example_vec, collapse = "|") #' # Delete dummy package #' unlink(dummypackage, recursive = TRUE) #' -inflate <- function(pkg = ".", flat_file, - vignette_name = "Get started", - open_vignette = TRUE, - check = TRUE, - document = TRUE, - overwrite = "ask", - clean = "ask", - update_params = TRUE, - codecov = FALSE, - ...) { +inflate <- function( + pkg = ".", + flat_file, + vignette_name = "Get started", + open_vignette = TRUE, + check = TRUE, + document = TRUE, + overwrite = "ask", + clean = "ask", + update_params = TRUE, + codecov = FALSE, + ... +) { if (!is.null(list(...)[["name"]])) { stop(paste0( "The `name` argument to `inflate()`", " is deprecated since {fusen} version 0.3.0.", - "\nPlease use `vignette_name = '", list(...)[["name"]], "'` instead.\n" + "\nPlease use `vignette_name = '", + list(...)[["name"]], + "'` instead.\n" )) vignette_name <- list(...)[["name"]] } @@ -95,7 +107,9 @@ inflate <- function(pkg = ".", flat_file, stop(paste0( "The `rmd` argument to `inflate()`", " is deprecated since {fusen} version 0.3.0.", - "\nPlease use `flat_file = '", list(...)[["rmd"]], "'` instead.\n" + "\nPlease use `flat_file = '", + list(...)[["rmd"]], + "'` instead.\n" )) flat_file <- list(...)[["rmd"]] } @@ -121,8 +135,11 @@ inflate <- function(pkg = ".", flat_file, sure <- paste0( "You did not specify parameter 'flat_file'.", " The current file will be inflated:\n", - current_file, ".\n", - "With vignette name: ", vignette_name, "\n", + current_file, + ".\n", + "With vignette name: ", + vignette_name, + "\n", "Are you sure this is what you planned? (y/n)\n" ) do_it <- readline(sure) == "y" || readline(sure) == "yes" @@ -179,7 +196,8 @@ inflate <- function(pkg = ".", flat_file, if (!file.exists(file.path(normalizePath(pkg), "DESCRIPTION"))) { stop( "DESCRIPTION file does not exist in your directory:", - normalize_path_winslash(pkg), ".\n", + normalize_path_winslash(pkg), + ".\n", "Have you run the content of the 'description'", " chunk of your {fusen} template?" ) @@ -202,7 +220,8 @@ inflate <- function(pkg = ".", flat_file, if (!file.exists(flat_file_path)) { stop( - flat_file, " does not exists, ", + flat_file, + " does not exists, ", "please use fusen::add_flat_template() to create it." ) } @@ -214,7 +233,8 @@ inflate <- function(pkg = ".", flat_file, overwrite <- match.arg(overwrite, choices = c("ask", "yes", "no")) cleaned_vignette_name <- asciify_name(vignette_name) vignette_path <- file.path( - pkg, "vignettes", + pkg, + "vignettes", paste0(cleaned_vignette_name, ".Rmd") ) if (file.exists(vignette_path)) { @@ -253,8 +273,10 @@ inflate <- function(pkg = ".", flat_file, lapply( parsed_tbl[["options"]], function(x) { - ifelse(!is.list(x) || is.null(x[["filename"]]), - NA_character_, gsub('"', "", x[["filename"]]) + ifelse( + !is.list(x) || is.null(x[["filename"]]), + NA_character_, + gsub('"', "", x[["filename"]]) ) } ) @@ -266,8 +288,12 @@ inflate <- function(pkg = ".", flat_file, # Get flat file path relative to package root # To be inserted in "DO NOT EDIT" comments relative_flat_file <- gsub( - "^/", "", - sub(normalize_path_winslash(pkg), "", normalize_path_winslash(flat_file), + "^/", + "", + sub( + normalize_path_winslash(pkg), + "", + normalize_path_winslash(flat_file), fixed = TRUE ) ) @@ -278,12 +304,16 @@ inflate <- function(pkg = ".", flat_file, # Get functions and create R and tests files ----s if (!is.null(fun_code)) { script_files <- create_functions_all( - parsed_tbl, fun_code, pkg, relative_flat_file + parsed_tbl, + fun_code, + pkg, + relative_flat_file ) } else { message( "No chunks named 'function-xx' or 'fun-xx'", - " were found in the Rmarkdown file: ", flat_file + " were found in the Rmarkdown file: ", + flat_file ) script_files <- tibble::tibble(type = character(0), path = character(0)) } @@ -329,7 +359,8 @@ inflate <- function(pkg = ".", flat_file, ] inflate_default_parameters <- lapply( - inflate_default_parameters, function(param) get(param) + inflate_default_parameters, + function(param) get(param) ) %>% setNames(inflate_default_parameters) @@ -417,7 +448,8 @@ create_functions_all <- function(parsed_tbl, fun_code, pkg, relative_flat_file) "There are duplicated chunk names, ", "please rename chunks with 'examples-fun_name' for instance.\n", "Duplicates: ", - paste(labels_in_vignette[duplicated(labels_in_vignette)], + paste( + labels_in_vignette[duplicated(labels_in_vignette)], collapse = ", " ) ) @@ -536,8 +568,10 @@ create_r_files <- function(fun_code, pkg, relative_flat_file) { create_tests_files <- function(parsed_tbl, pkg, relative_flat_file) { project_name <- get_pkg_name(pkg = pkg) - rmd_test <- parsed_tbl[!is.na(parsed_tbl$label) & - grepl(regex_tests, parsed_tbl$label), ] + rmd_test <- parsed_tbl[ + !is.na(parsed_tbl$label) & + grepl(regex_tests, parsed_tbl$label), + ] # If there is at least one test if (nrow(rmd_test) != 0) { @@ -545,7 +579,8 @@ create_tests_files <- function(parsed_tbl, pkg, relative_flat_file) { if (any(is.na(rmd_test[["file_name"]]) | rmd_test[["file_name"]] == "")) { stop( "Some `test` chunks can not be handled: ", - paste(rmd_test[["label"]][!is.na(rmd_test[["file_name"]])], + paste( + rmd_test[["label"]][!is.na(rmd_test[["file_name"]])], collapse = ", " ), ". Please associate these `test` chunks with a `function` chunk, ", @@ -558,7 +593,8 @@ create_tests_files <- function(parsed_tbl, pkg, relative_flat_file) { # Filter if code is still empty after code grouped rmd_test[["is_empty"]] <- lapply( - rmd_test[["code"]], function(x) grepl("^\\s*$", paste(x, collapse = "")) + rmd_test[["code"]], + function(x) grepl("^\\s*$", paste(x, collapse = "")) ) %>% unlist() rmd_test <- rmd_test[!rmd_test[["is_empty"]], ] @@ -620,12 +656,15 @@ create_vignette <- function(parsed_tbl, pkg, relative_flat_file, vignette_name, # _remove dev, description, function and tests. # Keep examples and unnamed not_in_vignette <- - paste(c( - regex_desc, - regex_tests, - regex_development, - regex_functions - ), collapse = "|") + paste( + c( + regex_desc, + regex_tests, + regex_development, + regex_functions + ), + collapse = "|" + ) vignette_tbl <- parsed_tbl[ !( grepl(not_in_vignette, parsed_tbl[["label"]]) | diff --git a/R/inflate_all.R b/R/inflate_all.R index 2fc648e..d0b21f1 100644 --- a/R/inflate_all.R +++ b/R/inflate_all.R @@ -106,14 +106,16 @@ #' # Clean the temporary directory #' unlink(dummypackage, recursive = TRUE) inflate_all <- function( - pkg = ".", - document = TRUE, - check = TRUE, - open_vignette = FALSE, - overwrite = TRUE, - check_unregistered = TRUE, - codecov = FALSE, - stylers, ...) { + pkg = ".", + document = TRUE, + check = TRUE, + open_vignette = FALSE, + overwrite = TRUE, + check_unregistered = TRUE, + codecov = FALSE, + stylers, + ... +) { config_file <- getOption("fusen.config_file", default = "dev/config_fusen.yaml") if (!file.exists(config_file)) { @@ -150,7 +152,8 @@ inflate_all <- function( message("No flat files were inflated") } else { apply_inflate <- function(inflate_params, pkg, overwrite, open_vignette) { - config_file <- getOption("fusen.config_file", + config_file <- getOption( + "fusen.config_file", default = "dev/config_fusen.yaml" ) # Change config option temporary, to be able to modify it on the fly @@ -175,8 +178,10 @@ inflate_all <- function( ) } - apply_inflate(inflate_params, - pkg = pkg, overwrite = overwrite, + apply_inflate( + inflate_params, + pkg = pkg, + overwrite = overwrite, open_vignette = open_vignette ) } diff --git a/R/init_share_on_github.R b/R/init_share_on_github.R index 37a55f1..b570ceb 100644 --- a/R/init_share_on_github.R +++ b/R/init_share_on_github.R @@ -149,7 +149,8 @@ init_share_on_github <- function(ask = TRUE, organisation = NULL) { add_line <- grep("## Example", readme_lines)[1] readme_lines[add_line] <- paste0( "## Documentation\n\n", - "Full documentation website on: ", url_pages, + "Full documentation website on: ", + url_pages, "\n\n", readme_lines[add_line] ) diff --git a/R/load_flat_functions.R b/R/load_flat_functions.R index 9709ef1..6f5e183 100644 --- a/R/load_flat_functions.R +++ b/R/load_flat_functions.R @@ -54,7 +54,8 @@ load_flat_functions <- function(flat_file, envir = globalenv()) { cli_alert_success( paste0( "'function' chunks from '", - flat_file, "' sourced in global env." + flat_file, + "' sourced in global env." ) ) } else { diff --git a/R/pre_inflate_all_diagnosis_eval.R b/R/pre_inflate_all_diagnosis_eval.R index 8353a1d..e956bb9 100644 --- a/R/pre_inflate_all_diagnosis_eval.R +++ b/R/pre_inflate_all_diagnosis_eval.R @@ -33,12 +33,16 @@ pre_inflate_all_diagnosis_eval <- function(diag_table, type_stop = FALSE) { if (is.na(params)) { status_text <- paste0( diag_to_eval[["type"]][flat_file_diag], - "(\"", diag_to_eval[["status"]][flat_file_diag], "\")" + "(\"", + diag_to_eval[["status"]][flat_file_diag], + "\")" ) } else { status_text <- paste0( diag_to_eval[["type"]][flat_file_diag], - "(\"", diag_to_eval[["status"]][flat_file_diag], "\", ", + "(\"", + diag_to_eval[["status"]][flat_file_diag], + "\", ", diag_to_eval[["params"]][flat_file_diag], ")" ) diff --git a/R/register_config_file.R b/R/register_config_file.R index d7ea9c1..ec6e781 100644 --- a/R/register_config_file.R +++ b/R/register_config_file.R @@ -36,8 +36,10 @@ #' usethis::with_project(dummypackage, { #' suppressMessages( #' inflate( -#' pkg = dummypackage, flat_file = flat_file, -#' vignette_name = "Get started", check = FALSE, +#' pkg = dummypackage, +#' flat_file = flat_file, +#' vignette_name = "Get started", +#' check = FALSE, #' open_vignette = FALSE #' ) #' ) @@ -72,7 +74,9 @@ check_not_registered_files <- function(path = ".", config_file, guess = TRUE, to rep("vignette", length(all_vignette)) ), path = c( - all_r, all_test, all_vignette + all_r, + all_test, + all_vignette ), stringsAsFactors = FALSE ) @@ -136,7 +140,8 @@ check_not_registered_files <- function(path = ".", config_file, guess = TRUE, to # config_file may not exist already csv_file <- file.path( - gsub(paste0(normalize_path_winslash(getwd()), "/"), "", dirname(normalize_path_winslash(config_file, mustWork = FALSE)), fixed = TRUE), "config_not_registered.csv" + gsub(paste0(normalize_path_winslash(getwd()), "/"), "", dirname(normalize_path_winslash(config_file, mustWork = FALSE)), fixed = TRUE), + "config_not_registered.csv" ) # Save for manual modification @@ -182,14 +187,16 @@ guess_flat_origin <- function(path) { lines <- readLines(path) guess_path <- sub( - ".* from\\s*(/){0,1}(.+[.].{1}md).*", "\\2", + ".* from\\s*(/){0,1}(.+[.].{1}md).*", + "\\2", lines[grep("(G|g)enerated by \\{fusen\\} from", lines)][1] ) guess_path <- normalize_path_winslash(guess_path, mustWork = FALSE) if (file.exists(guess_path)) { guess_path <- gsub( - paste0(normalize_path_winslash(getwd()), "/"), "", + paste0(normalize_path_winslash(getwd()), "/"), + "", normalize_path_winslash(guess_path, mustWork = FALSE) ) return(guess_path) @@ -248,14 +255,16 @@ get_list_paths <- function(config_list) { #' #' @noRd -df_to_config <- function(df_files, - flat_file_path = "keep", - state = c("active", "deprecated"), - config_file, - force = FALSE, - clean = "ask", - inflate_parameters = NULL, - update_params = TRUE) { +df_to_config <- function( + df_files, + flat_file_path = "keep", + state = c("active", "deprecated"), + config_file, + force = FALSE, + clean = "ask", + inflate_parameters = NULL, + update_params = TRUE +) { if (missing(config_file)) { config_file <- getOption( "fusen.config_file", @@ -275,7 +284,9 @@ df_to_config <- function(df_files, df_files <- read.csv(df_files, stringsAsFactors = FALSE) } else if (!is.data.frame(df_files) && !file.exists(df_files)) { stop( - "'", df_files, "' does not exist. You can run ", + "'", + df_files, + "' does not exist. You can run ", "`check_not_registered_files()` before." ) } @@ -297,7 +308,9 @@ df_to_config <- function(df_files, "Some 'origin' in df_files do not exist:", paste( paste0( - "row ", which(!all_exists), ": ", + "row ", + which(!all_exists), + ": ", df_files[["origin"]][!all_exists] ), collapse = ", " @@ -340,8 +353,11 @@ df_to_config <- function(df_files, "Some 'path' in df_files do not exist:", paste( paste0( - "row ", which(!all_exists), "- ", - df_files[["type"]][!all_exists], ": ", + "row ", + which(!all_exists), + "- ", + df_files[["type"]][!all_exists], + ": ", df_files[["path"]][!all_exists] ), collapse = ", " @@ -446,7 +462,8 @@ df_to_config <- function(df_files, paste( yaml_paths[!all_exists], collapse = ", " - ), ".\n", + ), + ".\n", "Please open the configuration file: ", config_file, " to verify, and delete the non-existing files if needed." @@ -475,7 +492,8 @@ df_to_config <- function(df_files, seq_along(each_flat_file_path), function(x) { update_one_group_yaml( - df_files, complete_yaml, + df_files, + complete_yaml, each_flat_file_path[x], state = state[x], clean = ifelse(each_flat_file_path[x] == "keep", FALSE, clean), @@ -533,7 +551,8 @@ df_to_config <- function(df_files, #' @importFrom yaml write_yaml read_yaml #' @noRd write_yaml_verbatim <- function(x, file) { - write_yaml(x, + write_yaml( + x, file = file, handlers = list( logical = function(x) { @@ -567,13 +586,14 @@ files_list_to_vector <- function(list_of_files) { #' @importFrom cli cli_alert_warning cli_alert_success #' @noRd update_one_group_yaml <- function( - df_files, - complete_yaml, - flat_file_path, - state = c("active", "deprecated"), - clean = "ask", - inflate_parameters = NULL, - update_params = TRUE) { + df_files, + complete_yaml, + flat_file_path, + state = c("active", "deprecated"), + clean = "ask", + inflate_parameters = NULL, + update_params = TRUE +) { state <- match.arg(state, several.ok = FALSE) all_keep_before <- complete_yaml[[basename(flat_file_path)]] @@ -645,7 +665,8 @@ update_one_group_yaml <- function( inflate_parameters_new <- inflate_parameters } this_group_list_return <- c( - this_group_list, list(inflate = inflate_parameters_new) + this_group_list, + list(inflate = inflate_parameters_new) ) } @@ -681,14 +702,18 @@ update_one_group_yaml <- function( cli_alert_warning( paste0( "Some files are not anymore created from ", - flat_file_path, ".\n", + flat_file_path, + ".\n", "You may have rename some functions or moved them to another flat:", "\n", - paste(files_removed_vec, collapse = ", "), ".\n\n", + paste(files_removed_vec, collapse = ", "), + ".\n\n", "Below, you are ask if you want to remove them from the repository.", "\n\n", "Note: to not see this message again, use `clean = TRUE` in the ", - "`inflate()` command of this flat file : ", flat_file_path, ".\n", + "`inflate()` command of this flat file : ", + flat_file_path, + ".\n", "Use with caution. ", "It is recommended to use git to check the changes...\n" ) @@ -715,7 +740,8 @@ update_one_group_yaml <- function( silent <- lapply( paste( - files_removed_vec, "was removed from the config file", + files_removed_vec, + "was removed from the config file", "and from the repository" ), cli_alert_warning @@ -723,7 +749,8 @@ update_one_group_yaml <- function( } else if (isFALSE(do_it)) { silent <- lapply( paste( - files_removed_vec, "was removed from the config file", + files_removed_vec, + "was removed from the config file", "but kept in the repository" ), cli_alert_warning @@ -771,8 +798,10 @@ update_one_group_yaml <- function( #' usethis::with_project(dummypackage, { #' suppressMessages( #' inflate( -#' pkg = dummypackage, flat_file = flat_file, -#' vignette_name = "Get started", check = FALSE, +#' pkg = dummypackage, +#' flat_file = flat_file, +#' vignette_name = "Get started", +#' check = FALSE, #' open_vignette = FALSE #' ) #' ) @@ -790,8 +819,11 @@ register_all_to_config <- function(pkg = ".", config_file) { } # Use the function to check the list of files - out_df <- check_not_registered_files(pkg, - config_file = config_file, to_csv = FALSE, open = FALSE + out_df <- check_not_registered_files( + pkg, + config_file = config_file, + to_csv = FALSE, + open = FALSE ) @@ -812,7 +844,8 @@ register_all_to_config <- function(pkg = ".", config_file) { # Delete out_df csv_file <- file.path( gsub( - paste0(normalize_path_winslash(getwd()), "/"), "", + paste0(normalize_path_winslash(getwd()), "/"), + "", dirname(normalize_path_winslash(config_file, mustWork = FALSE)), fixed = TRUE ), diff --git a/R/rename_flat_file.R b/R/rename_flat_file.R index df70765..225b7e5 100644 --- a/R/rename_flat_file.R +++ b/R/rename_flat_file.R @@ -15,7 +15,9 @@ #' dev_file <- suppressMessages( #' add_flat_template( #' template = "add", -#' pkg = ".", overwrite = TRUE, open = FALSE +#' pkg = ".", +#' overwrite = TRUE, +#' open = FALSE #' ) #' ) #' rename_flat_file( @@ -23,12 +25,12 @@ #' new_name = "flat_new.Rmd" #' ) #' } - rename_flat_file <- function(flat_file, new_name) { if (!file.exists(flat_file)) { stop( paste0( - "The flat file ", basename(flat_file), + "The flat file ", + basename(flat_file), " does not exist." ) ) @@ -47,7 +49,8 @@ rename_flat_file <- function(flat_file, new_name) { if (file.exists(new_name_path)) { stop( paste0( - "The new file ", new_name_path, + "The new file ", + new_name_path, " already exists." ) ) @@ -81,8 +84,10 @@ rename_flat_file <- function(flat_file, new_name) { cli_alert_info( paste0( - "The flat file ", flat_file, - " has been renamed to ", new_name_path + "The flat file ", + flat_file, + " has been renamed to ", + new_name_path ) ) @@ -105,7 +110,8 @@ rename_flat_file <- function(flat_file, new_name) { cli_alert_info( paste0( - "The flat file ", basename(flat_file), + "The flat file ", + basename(flat_file), " has been updated in the config file." ) ) @@ -130,7 +136,8 @@ rename_flat_file <- function(flat_file, new_name) { } cli_alert_info( paste0( - "The flat file ", basename(new_name_path), + "The flat file ", + basename(new_name_path), " has been updated in the inflated files." ) ) diff --git a/R/sepuku.R b/R/sepuku.R index a7646b5..d12ca8b 100644 --- a/R/sepuku.R +++ b/R/sepuku.R @@ -79,27 +79,31 @@ #' #' # We check that all the flat files have been deleted #' length( -#' list.files(file.path(dummypackage, "dev"), +#' list.files( +#' file.path(dummypackage, "dev"), #' pattern = "^flat.*\\.Rmd" #' ) #' ) #' #' length( -#' list.files(file.path(dummypackage, "dev"), +#' list.files( +#' file.path(dummypackage, "dev"), #' pattern = "^flat.*\\.qmd" #' ) #' ) #' #' #' length( -#' list.files(file.path(dummypackage, "dev", "flat_history"), +#' list.files( +#' file.path(dummypackage, "dev", "flat_history"), #' pattern = "^flat.*\\.Rmd" #' ) #' ) #' #' #' length( -#' list.files(file.path(dummypackage, "dev", "flat_history"), +#' list.files( +#' file.path(dummypackage, "dev", "flat_history"), #' pattern = "^flat.*\\.qmd" #' ) #' ) @@ -112,9 +116,10 @@ #' unlink(dummypackage, recursive = TRUE) #' } sepuku <- function( - pkg = ".", - force = FALSE, - verbose = FALSE) { + pkg = ".", + force = FALSE, + verbose = FALSE +) { if (!dir.exists(file.path(pkg, "dev"))) { cli_abort("No dev/ folder have been found. Are you sure that your package has been initiated with fusen ?") } diff --git a/R/sepuku_utils.R b/R/sepuku_utils.R index 0471641..d4bf608 100644 --- a/R/sepuku_utils.R +++ b/R/sepuku_utils.R @@ -4,9 +4,10 @@ #' @noRd #' @rdname sepuku_utils list_flat_files_in_config_file <- function( - config_file = getOption("fusen.config_file", - default = "dev/config_fusen.yaml" - )) { + config_file = getOption( + "fusen.config_file", + default = "dev/config_fusen.yaml" + )) { if (!file.exists(config_file)) { return(character(0)) } else { @@ -22,8 +23,9 @@ list_flat_files_in_config_file <- function( #' @noRd #' @rdname sepuku_utils list_flat_files_in_dev_folder <- function( - pkg = ".", - folder = "dev") { + pkg = ".", + folder = "dev" +) { files_identified <- c( list.files( @@ -136,8 +138,9 @@ find_files_with_fusen_tags <- function(pkg = ".") { #' @noRd #' @rdname sepuku_utils clean_fusen_tags_in_files <- function( - pkg = ".", - files_to_clean) { + pkg = ".", + files_to_clean +) { fusen_tags <- tolower( c("WARNING - Generated by", "Previously generated by", "WARNING - This vignette is generated by") ) diff --git a/dev/dev_history.R b/dev/dev_history.R index 41356c9..7c2449d 100644 --- a/dev/dev_history.R +++ b/dev/dev_history.R @@ -85,7 +85,9 @@ chameleon::build_pkgdown( # lazy = TRUE, yml = system.file("pkgdown/_pkgdown.yml", package = "thinkridentity"), favicon = system.file("pkgdown/favicon.ico", package = "thinkridentity"), - move = FALSE, clean_before = TRUE, clean_after = FALSE + move = FALSE, + clean_before = TRUE, + clean_after = FALSE ) # Doc @@ -115,12 +117,22 @@ styler::style_file(list.files("dev", pattern = "[.](Rmd|qmd|rmd)$", full.names = # attachment::att_from_namespace() attachment::att_amend_desc( pkg_ignore = c( - "testthat", "dummypackage", "rstudioapi", - "knitr", "rmarkdown", "R6", "gert" + "testthat", + "dummypackage", + "rstudioapi", + "knitr", + "rmarkdown", + "R6", + "gert" ), extra.suggests = c( - "testthat", "pkgload", "rstudioapi", - "rmarkdown", "knitr", "gert", "styler" + "testthat", + "pkgload", + "rstudioapi", + "rmarkdown", + "knitr", + "gert", + "styler" ), # "MASS", "lattice", "Matrix") update.config = TRUE # attachment >= 0.4.0. diff --git a/dev/dev_history_cran.R b/dev/dev_history_cran.R index 5b27d3f..8defb7f 100644 --- a/dev/dev_history_cran.R +++ b/dev/dev_history_cran.R @@ -59,12 +59,16 @@ suppressMessages(devtools::test()) # interactivity fusen::draw_package_structure() # Update Readmes -rmarkdown::render("dev/README.Rmd", - output_format = "github_document", output_file = "README.md" +rmarkdown::render( + "dev/README.Rmd", + output_format = "github_document", + output_file = "README.md" ) -rmarkdown::render("README.Rmd", - output_format = "github_document", output_file = "README.md" +rmarkdown::render( + "README.Rmd", + output_format = "github_document", + output_file = "README.md" ) diff --git a/dev/flat_addins.Rmd b/dev/flat_addins.Rmd index f181c53..f14d958 100644 --- a/dev/flat_addins.Rmd +++ b/dev/flat_addins.Rmd @@ -35,8 +35,10 @@ pkgload::load_all(export_all = FALSE) #' \dontrun{ #' add_fusen_chunks("this", export = TRUE) #' } -add_fusen_chunks <- function(function_name = NULL, - export = getOption("fusen.export.functions")) { +add_fusen_chunks <- function( + function_name = NULL, + export = getOption("fusen.export.functions") +) { if ( requireNamespace("rstudioapi") && rstudioapi::isAvailable() && @@ -115,7 +117,10 @@ build_fusen_chunks <- function(function_name, export = TRUE) { if (function_name != cleaned_function_name) { message( - "Your function name was cleaned: `", function_name, "` is now `", cleaned_function_name, + "Your function name was cleaned: `", + function_name, + "` is now `", + cleaned_function_name, "` as a function name should only contain letters, numbers and underscores." ) function_name <- cleaned_function_name @@ -173,11 +178,11 @@ test_that("build_fusen_chunks works properly", { expect_true( grepl("^# pouet", res) ) - + expect_true( grepl("development-pouet", res) ) - + expect_true( grepl("function-pouet", res) ) @@ -217,11 +222,11 @@ test_that("build_fusen_chunks cleans functions names", { expect_true( grepl("^# po_uet", res) ) - + expect_true( grepl("development-po_uet}", res) ) - + expect_true( grepl("function-po_uet}", res) ) diff --git a/dev/flat_create_flat.Rmd b/dev/flat_create_flat.Rmd index ff3588d..7f81a32 100644 --- a/dev/flat_create_flat.Rmd +++ b/dev/flat_create_flat.Rmd @@ -17,10 +17,16 @@ library(tools) ```{r function-1} flat_template_choices <- c( "full", - "minimal_package", "minpkg", - "minimal_flat", "minflat", "add", "additional", - "teach", "teaching", - "dev_history", "dev" + "minimal_package", + "minpkg", + "minimal_flat", + "minflat", + "add", + "additional", + "teach", + "teaching", + "dev_history", + "dev" ) create_fusen_choices <- c("full", "minimal", "teaching", "dev_history") @@ -59,17 +65,20 @@ create_fusen_choices <- c("full", "minimal", "teaching", "dev_history") #' @export #' #' @examples -add_flat_template <- function(template = c("full", "minimal_package", "minimal_flat", "additional", "teaching", "dev_history"), - pkg = ".", - dev_dir = "dev", - flat_name = NULL, - overwrite = FALSE, - open = TRUE) { +add_flat_template <- function( + template = c("full", "minimal_package", "minimal_flat", "additional", "teaching", "dev_history"), + pkg = ".", + dev_dir = "dev", + flat_name = NULL, + overwrite = FALSE, + open = TRUE +) { project_name <- get_pkg_name(pkg = pkg) if (project_name != asciify_name(project_name, to_pkg = TRUE)) { stop( - "Please rename your project/directory with: `", asciify_name(project_name, to_pkg = TRUE), + "Please rename your project/directory with: `", + asciify_name(project_name, to_pkg = TRUE), "` as a package name should only contain letters, numbers and dots." ) } @@ -110,7 +119,8 @@ add_flat_template <- function(template = c("full", "minimal_package", "minimal_f } flat_name <- paste0( "flat_", - asciify_name(gsub("[.]Rmd$", "", flat_name[1])), ".Rmd" + asciify_name(gsub("[.]Rmd$", "", flat_name[1])), + ".Rmd" ) pkg <- normalizePath(pkg) @@ -130,8 +140,10 @@ add_flat_template <- function(template = c("full", "minimal_package", "minimal_f n <- length(list.files(full_dev_dir, pattern = "^flat_.*[.]Rmd")) dev_file_path <- file.path(full_dev_dir, paste0(file_path_sans_ext(flat_name), "_", n + 1, ".Rmd")) message( - flat_name, " already exists. New flat file is renamed '", - basename(dev_file_path), "'. Use overwrite = TRUE, if you want to ", + flat_name, + " already exists. New flat file is renamed '", + basename(dev_file_path), + "'. Use overwrite = TRUE, if you want to ", "overwrite the existing file or rename it." ) } @@ -142,7 +154,8 @@ add_flat_template <- function(template = c("full", "minimal_package", "minimal_f lines_template[grepl("", lines_template)] <- gsub( - "", project_name, + "", + project_name, lines_template[grepl("", lines_template)] ) @@ -150,13 +163,15 @@ add_flat_template <- function(template = c("full", "minimal_package", "minimal_f # _inflate lines_template[grepl("dev/flat_template.Rmd", lines_template)] <- gsub( - "dev/flat_template.Rmd", file.path(dev_dir, dev_name), + "dev/flat_template.Rmd", + file.path(dev_dir, dev_name), lines_template[grepl("dev/flat_template.Rmd", lines_template)] ) # _title lines_template[grepl("flat_template.Rmd", lines_template)] <- gsub( - "flat_template.Rmd", dev_name, + "flat_template.Rmd", + dev_name, lines_template[grepl("flat_template.Rmd", lines_template)] ) @@ -164,7 +179,8 @@ add_flat_template <- function(template = c("full", "minimal_package", "minimal_f if (!is.na(fun_name)) { lines_template[grepl("my_fun", lines_template)] <- gsub( - "my_fun", fun_name, + "my_fun", + fun_name, lines_template[grepl("my_fun", lines_template)] ) } @@ -286,7 +302,8 @@ pkg_name <- basename(dummypackage) # add_flat_template ---- test_that("add_flat_template adds flat_template.Rmd and co.", { - dev_file_path <- expect_error(add_flat_template(pkg = dummypackage, open = FALSE), + dev_file_path <- expect_error( + add_flat_template(pkg = dummypackage, open = FALSE), regexp = NA ) flat_file <- dev_file_path[grepl("flat_", dev_file_path)] @@ -301,7 +318,7 @@ test_that("add_flat_template adds flat_template.Rmd and co.", { rbuildignore_lines <- readLines(rbuildignore_file) expect_true(any(grepl("^dev$", rbuildignore_lines, fixed = TRUE))) expect_true(any(grepl("[.]here", rbuildignore_lines))) - + gitignore_file <- file.path(dummypackage, "dev", ".gitignore") expect_true(file.exists(gitignore_file)) gitignore_lines <- readLines(gitignore_file) @@ -359,14 +376,14 @@ test_that("add dev_history template works", { expect_true(file.exists(dev_file_path)) usethis::with_project(dummypackage, { - # Extract and test the description chunk dev_lines <- readLines(dev_file_path) # Change path of project dev_lines <- gsub( "here::here()", # To correct for Windows path - paste0('"', gsub("\\\\", "\\\\\\\\", dummypackage), '"'), dev_lines, + paste0('"', gsub("\\\\", "\\\\\\\\", dummypackage), '"'), + dev_lines, fixed = TRUE ) @@ -406,7 +423,8 @@ test_that("add dev_history template works with windows \\users path", { withr::with_dir(dummypackage, { dev_file_path <- expect_error( add_flat_template( - pkg = dummypackage, template = "dev_history", + pkg = dummypackage, + template = "dev_history", open = FALSE ), regexp = NA @@ -424,7 +442,8 @@ test_that("add dev_history template works with windows \\users path", { dev_lines <- gsub( "here::here()", # To correct for Windows path - paste0('"', gsub("\\\\", "\\\\\\\\", newdir_uu), '"'), dev_lines, + paste0('"', gsub("\\\\", "\\\\\\\\", newdir_uu), '"'), + dev_lines, # paste0('"', newdir_uu, '"'), dev_lines, fixed = TRUE ) @@ -487,8 +506,10 @@ for (template in all_templates) { # template <- all_templates[1] main_flat_file_name <- template if (template %in% c( - "minimal_package", "minpkg", - "minimal_flat", "minflat" + "minimal_package", + "minpkg", + "minimal_flat", + "minflat" )) { main_flat_file_name <- "minimal" } else if (template == "add") { @@ -546,14 +567,17 @@ for (template in all_templates) { rmarkdown::render( input = dev_hist_path, output_file = file.path(dummypackage4, "dev", "dev_history.html"), - envir = new.env(), quiet = TRUE + envir = new.env(), + quiet = TRUE ), regexp = NA ) }) } else if (template %in% c( - "additional", "add", - "minimal_flat", "minflat" + "additional", + "add", + "minimal_flat", + "minflat" )) { fusen::fill_description( pkg = here::here(), @@ -571,7 +595,8 @@ for (template in all_templates) { rmarkdown::render( input = flat_to_render, output_file = file.path(dummypackage4, "dev", paste0("flat_", main_flat_file_name, ".html")), - envir = new.env(), quiet = TRUE + envir = new.env(), + quiet = TRUE ), regexp = NA ) @@ -632,7 +657,9 @@ test_that("Other flat_name works", { dev_file_path <- expect_error( add_flat_template( template = "add", - pkg = dummypackage, flat_name = "hello", open = FALSE + pkg = dummypackage, + flat_name = "hello", + open = FALSE ), regexp = NA ) @@ -647,7 +674,9 @@ test_that("Other flat_name works", { expect_message( add_flat_template( template = "minpkg", - pkg = dummypackage, flat_name = "hello", open = FALSE + pkg = dummypackage, + flat_name = "hello", + open = FALSE ), regexp = "flat_hello.Rmd already exists." ) @@ -664,8 +693,10 @@ test_that("Other flat_name works", { fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package")) expect_error( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "hello", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "hello", + check = FALSE, open_vignette = FALSE ), regexp = NA @@ -694,7 +725,8 @@ test_that("Other dev_dir works", { dev_file_path <- expect_error( add_flat_template( template = "add", - pkg = dummypackage, flat_name = "hello", + pkg = dummypackage, + flat_name = "hello", dev_dir = "devdir", open = FALSE ), @@ -747,23 +779,32 @@ pkg_name <- basename(dummypackage) test_that( "add_flat_template allows bad flat_name for function name with full", - { - dev_file_path <- expect_error( - suppressMessages( - add_flat_template( - pkg = dummypackage, - flat_name = "bad for function ! but.ok", open = FALSE) - ), - regexp = NA - ) - flat_file <- dev_file_path[grepl("flat_", dev_file_path)] - - expect_true(all(file.exists(dev_file_path))) - expect_true(file.exists(file.path(dummypackage, - "dev", "flat_bad-for-function-but-ok.Rmd"))) - expect_true(file.exists(file.path(dummypackage, - "dev", "0-dev_history.Rmd"))) -}) + { + dev_file_path <- expect_error( + suppressMessages( + add_flat_template( + pkg = dummypackage, + flat_name = "bad for function ! but.ok", + open = FALSE + ) + ), + regexp = NA + ) + flat_file <- dev_file_path[grepl("flat_", dev_file_path)] + + expect_true(all(file.exists(dev_file_path))) + expect_true(file.exists(file.path( + dummypackage, + "dev", + "flat_bad-for-function-but-ok.Rmd" + ))) + expect_true(file.exists(file.path( + dummypackage, + "dev", + "0-dev_history.Rmd" + ))) + } +) unlink(dummypackage, recursive = TRUE) # add_flat_template allows bad flat_name for function name ---- @@ -774,16 +815,22 @@ pkg_name <- basename(dummypackage) test_that("add_flat_template allows bad flat_name for function name with add", { dev_file_path <- expect_error( suppressMessages( - add_additional(pkg = dummypackage, - flat_name = "bad for function ! but.ok2", open = FALSE) + add_additional( + pkg = dummypackage, + flat_name = "bad for function ! but.ok2", + open = FALSE + ) ), regexp = NA ) flat_file <- dev_file_path[grepl("flat_", dev_file_path)] expect_true(all(file.exists(dev_file_path))) - expect_true(file.exists(file.path(dummypackage, - "dev", "flat_bad-for-function-but-ok2.Rmd"))) + expect_true(file.exists(file.path( + dummypackage, + "dev", + "flat_bad-for-function-but-ok2.Rmd" + ))) dev_lines <- readLines(flat_file) # title x 1, function x 3, example x 2, tests x 3 @@ -797,11 +844,13 @@ unlink(dummypackage, recursive = TRUE) ```{r function-add_additional} #' @rdname add_flat_template #' @export -add_additional <- function(pkg = ".", - dev_dir = "dev", - flat_name = "additional", - overwrite = FALSE, - open = TRUE) { +add_additional <- function( + pkg = ".", + dev_dir = "dev", + flat_name = "additional", + overwrite = FALSE, + open = TRUE +) { add_flat_template( template = "additional", pkg = pkg, @@ -814,11 +863,13 @@ add_additional <- function(pkg = ".", #' @rdname add_flat_template #' @export -add_minimal_flat <- function(pkg = ".", - dev_dir = "dev", - flat_name = "minimal", - overwrite = FALSE, - open = TRUE) { +add_minimal_flat <- function( + pkg = ".", + dev_dir = "dev", + flat_name = "minimal", + overwrite = FALSE, + open = TRUE +) { add_flat_template( template = "minimal_flat", pkg = pkg, @@ -831,11 +882,13 @@ add_minimal_flat <- function(pkg = ".", #' @rdname add_flat_template #' @export -add_minimal_package <- function(pkg = ".", - dev_dir = "dev", - flat_name = "minimal", - overwrite = FALSE, - open = TRUE) { +add_minimal_package <- function( + pkg = ".", + dev_dir = "dev", + flat_name = "minimal", + overwrite = FALSE, + open = TRUE +) { add_flat_template( template = "minimal_package", pkg = pkg, @@ -848,11 +901,13 @@ add_minimal_package <- function(pkg = ".", #' @rdname add_flat_template #' @export -add_full <- function(pkg = ".", - dev_dir = "dev", - flat_name = "full", - overwrite = FALSE, - open = TRUE) { +add_full <- function( + pkg = ".", + dev_dir = "dev", + flat_name = "full", + overwrite = FALSE, + open = TRUE +) { add_flat_template( template = "full", pkg = pkg, @@ -865,10 +920,12 @@ add_full <- function(pkg = ".", #' @rdname add_flat_template #' @export -add_dev_history <- function(pkg = ".", - dev_dir = "dev", - overwrite = FALSE, - open = TRUE) { +add_dev_history <- function( + pkg = ".", + dev_dir = "dev", + overwrite = FALSE, + open = TRUE +) { add_flat_template( template = "dev_history", pkg = pkg, @@ -890,7 +947,8 @@ dir.create(dummypackage) pkg_name <- basename(dummypackage) test_that("add_full adds flat_full.Rmd", { - dev_file_path <- expect_error(suppressMessages(add_full(pkg = dummypackage, open = FALSE)), + dev_file_path <- expect_error( + suppressMessages(add_full(pkg = dummypackage, open = FALSE)), regexp = NA ) flat_file <- dev_file_path[grepl("flat_", dev_file_path)] @@ -1006,7 +1064,8 @@ unlink(dummypackage, recursive = TRUE) # # Execute in the console directly fusen::inflate( flat_file = "dev/flat_create_flat.Rmd", - check = FALSE, vignette_name = NA + check = FALSE, + vignette_name = NA ) ``` diff --git a/dev/flat_deal_with_flat_files.Rmd b/dev/flat_deal_with_flat_files.Rmd index 3094553..efe870f 100644 --- a/dev/flat_deal_with_flat_files.Rmd +++ b/dev/flat_deal_with_flat_files.Rmd @@ -34,7 +34,8 @@ rename_flat_file <- function(flat_file, new_name) { if (!file.exists(flat_file)) { stop( paste0( - "The flat file ", basename(flat_file), + "The flat file ", + basename(flat_file), " does not exist." ) ) @@ -53,7 +54,8 @@ rename_flat_file <- function(flat_file, new_name) { if (file.exists(new_name_path)) { stop( paste0( - "The new file ", new_name_path, + "The new file ", + new_name_path, " already exists." ) ) @@ -87,8 +89,10 @@ rename_flat_file <- function(flat_file, new_name) { cli_alert_info( paste0( - "The flat file ", flat_file, - " has been renamed to ", new_name_path + "The flat file ", + flat_file, + " has been renamed to ", + new_name_path ) ) @@ -111,7 +115,8 @@ rename_flat_file <- function(flat_file, new_name) { cli_alert_info( paste0( - "The flat file ", basename(flat_file), + "The flat file ", + basename(flat_file), " has been updated in the config file." ) ) @@ -136,7 +141,8 @@ rename_flat_file <- function(flat_file, new_name) { } cli_alert_info( paste0( - "The flat file ", basename(new_name_path), + "The flat file ", + basename(new_name_path), " has been updated in the inflated files." ) ) @@ -152,7 +158,9 @@ rename_flat_file <- function(flat_file, new_name) { dev_file <- suppressMessages( add_flat_template( template = "add", - pkg = ".", overwrite = TRUE, open = FALSE + pkg = ".", + overwrite = TRUE, + open = FALSE ) ) rename_flat_file( @@ -171,7 +179,9 @@ fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package")) dev_file <- suppressMessages( add_flat_template( template = "full", - pkg = dummypackage, overwrite = TRUE, open = FALSE + pkg = dummypackage, + overwrite = TRUE, + open = FALSE ) ) flat_file <- dev_file[grepl("flat_", dev_file)] @@ -182,7 +192,8 @@ usethis::with_project(dummypackage, { write_yaml_verbatim(list(), config_file) test_that("rename_flat_file fails if file does not exists", { - expect_error(rename_flat_file(flat_file = "dev/flat_nonexistent.Rmd"), + expect_error( + rename_flat_file(flat_file = "dev/flat_nonexistent.Rmd"), regexp = "does not exist" ) }) @@ -258,8 +269,10 @@ usethis::with_project(dummypackage, { # Inflate the new file suppressMessages( inflate( - pkg = dummypackage, flat_file = other_new_path, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = other_new_path, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -371,14 +384,16 @@ deprecate_flat_file <- function(flat_file) { if (!file.exists(flat_file)) { stop( paste0( - "The flat file ", basename(flat_file), + "The flat file ", + basename(flat_file), " does not exist." ) ) } else if (!basename(flat_file) %in% names(config)) { stop( paste0( - "The flat file ", basename(flat_file), + "The flat file ", + basename(flat_file), " is not in the config file.", "Did you inflate it with {fusen}?" ) @@ -386,7 +401,8 @@ deprecate_flat_file <- function(flat_file) { } else if (config[[basename(flat_file)]]$state == "deprecated") { cli_alert_warning( paste0( - "The flat file ", basename(flat_file), + "The flat file ", + basename(flat_file), " is already deprecated." ) ) @@ -464,7 +480,8 @@ deprecate_flat_file <- function(flat_file) { cli_alert_success( paste0( - "The flat file ", basename(flat_file), + "The flat file ", + basename(flat_file), " has been deprecated." ) ) @@ -478,7 +495,9 @@ deprecate_flat_file <- function(flat_file) { dev_file <- suppressMessages( add_flat_template( template = "add", - pkg = dummypackage, overwrite = TRUE, open = FALSE + pkg = dummypackage, + overwrite = TRUE, + open = FALSE ) ) deprecate_flat_file(flat_file = "dev/flat_additional.Rmd") @@ -495,7 +514,9 @@ fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package")) dev_file <- suppressMessages( add_flat_template( template = "full", - pkg = dummypackage, overwrite = TRUE, open = FALSE + pkg = dummypackage, + overwrite = TRUE, + open = FALSE ) ) flat_file <- dev_file[grepl("flat_", dev_file)] @@ -507,8 +528,10 @@ usethis::with_project(dummypackage, { # Inflate once suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -587,14 +610,16 @@ usethis::with_project(dummypackage, { }) test_that("deprecate_flat_file stops if flat file does not exist", { - expect_error(deprecate_flat_file(flat_file = "dev/flat_nonexistent.Rmd"), + expect_error( + deprecate_flat_file(flat_file = "dev/flat_nonexistent.Rmd"), regexp = "does not exist" ) }) file.create("dev/flat_nonexistent.Rmd") test_that("deprecate_flat_file stops if flat file is not in config file", { - expect_error(deprecate_flat_file(flat_file = "dev/flat_nonexistent.Rmd"), + expect_error( + deprecate_flat_file(flat_file = "dev/flat_nonexistent.Rmd"), regexp = "is not in the config file" ) }) @@ -618,8 +643,10 @@ usethis::with_project(dummypackage, { # Execute in the console directly fusen::inflate( flat_file = "dev/flat_deal_with_flat_files.Rmd", - vignette_name = "Deal with a 'fusen' flat file", check = FALSE, - overwrite = TRUE, open_vignette = FALSE, + vignette_name = "Deal with a 'fusen' flat file", + check = FALSE, + overwrite = TRUE, + open_vignette = FALSE, clean = TRUE ) ``` diff --git a/dev/flat_get_package_structure.Rmd b/dev/flat_get_package_structure.Rmd index ba70db9..cba24c9 100644 --- a/dev/flat_get_package_structure.Rmd +++ b/dev/flat_get_package_structure.Rmd @@ -44,9 +44,10 @@ This also works for any R package, not only for `fusen` built packages. #' #' @examples get_package_structure <- function( - config_file, - emoji = TRUE, - silent = FALSE) { + config_file, + emoji = TRUE, + silent = FALSE +) { if (missing(config_file)) { yaml_fusen_file_orig <- getOption( "fusen_config_file", @@ -108,10 +109,14 @@ get_package_structure <- function( if (emoji) { flat_state <- yaml_fusen[[flat_file]]$state yaml_fusen[[flat_file]]$state <- - paste(ifelse( - flat_state == "active", - "\U0001f34f", "\U0001f6d1" - ), flat_state) + paste( + ifelse( + flat_state == "active", + "\U0001f34f", + "\U0001f6d1" + ), + flat_state + ) } # Get the list of R files with their functions @@ -123,9 +128,12 @@ get_package_structure <- function( exported <- paste0("export(", functions, ")") %in% namespace if (emoji) { functions <- paste( - ifelse(exported, - "\U0001f440", "\U0001f648" - ), functions + ifelse( + exported, + "\U0001f440", + "\U0001f648" + ), + functions ) } else { functions <- paste( @@ -245,8 +253,10 @@ usethis::with_project(dummypackage, { # Works with 'fusen' package suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -283,8 +293,10 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -333,7 +345,8 @@ get_all_created_funs <- function(file) { parts <- lapply(attr(parts_parsed, "srcref"), as.character) all_functions <- lapply( - seq_along(parts), function(x) { + seq_along(parts), + function(x) { out <- list() out$code <- as.character(parts[x]) name <- parse_fun(out)$fun_name @@ -384,7 +397,8 @@ test_that("get_all_created_funs works", { fusen::inflate( flat_file = "dev/flat_get_package_structure.Rmd", vignette_name = "Draw a tree of your package files and functions", - check = TRUE, open_vignette = TRUE + check = TRUE, + open_vignette = TRUE ) ``` diff --git a/dev/flat_history/flat_history_core.Rmd b/dev/flat_history/flat_history_core.Rmd index cace385..0d8f9c0 100644 --- a/dev/flat_history/flat_history_core.Rmd +++ b/dev/flat_history/flat_history_core.Rmd @@ -84,13 +84,18 @@ Deprecated. See `add_flat_template()` instead. #' @export #' #' @examples -add_dev_history <- function(pkg = ".", overwrite = FALSE, - open = TRUE, dev_dir = "dev", - name = c("full", "minimal", "additional", "teaching")) { +add_dev_history <- function( + pkg = ".", + overwrite = FALSE, + open = TRUE, + dev_dir = "dev", + name = c("full", "minimal", "additional", "teaching") +) { project_name <- basename(normalizePath(pkg)) if (project_name != asciify_name(project_name, to_pkg = TRUE)) { stop( - "Please rename your project/directory with: ", asciify_name(project_name, to_pkg = TRUE), + "Please rename your project/directory with: ", + asciify_name(project_name, to_pkg = TRUE), " as a package name should only contain letters, numbers and dots." ) } @@ -113,7 +118,8 @@ add_dev_history <- function(pkg = ".", overwrite = FALSE, dev_path <- file.path(pkg, dev_dir, paste0("dev_history_", n + 1, ".Rmd")) message( "dev_history.Rmd already exists. New dev file is renamed '", - basename(dev_path), "'. Use overwrite = TRUE, if you want to ", + basename(dev_path), + "'. Use overwrite = TRUE, if you want to ", "overwrite the existing dev_history.Rmd file, or rename it." ) } @@ -123,7 +129,8 @@ add_dev_history <- function(pkg = ".", overwrite = FALSE, lines_template[grepl("", lines_template)] <- gsub( - "", basename(pkg), + "", + basename(pkg), lines_template[grepl("", lines_template)] ) @@ -182,11 +189,14 @@ add_dev_history <- function(pkg = ".", overwrite = FALSE, asciify_name <- function(name, to_pkg = FALSE) { # name <- "y _ p n@ é ! 1" cleaned_name <- gsub( - "^-|-$", "", + "^-|-$", + "", gsub( - "-+", "-", + "-+", + "-", gsub( - "-_|_-", "-", + "-_|_-", + "-", gsub("[^([:alnum:]*_*-*)*]", "-", name) ) ) @@ -195,7 +205,8 @@ asciify_name <- function(name, to_pkg = FALSE) { if (isTRUE(to_pkg)) { cleaned_name <- gsub( - "[^a-zA-Z0-9]+", ".", + "[^a-zA-Z0-9]+", + ".", gsub("^[0-9]+", "", cleaned_name) ) } else { @@ -293,7 +304,8 @@ dev_path <- add_dev_history(pkg = dummypackage4, open = FALSE) lines_template <- readLines(system.file("tests-templates/dev-template-tests.Rmd", package = "fusen")) lines_template[grepl("", lines_template)] <- gsub( - "", basename(dummypackage4), + "", + basename(dummypackage4), lines_template[grepl("", lines_template)] ) cat(enc2utf8(lines_template), file = dev_path, sep = "\n") @@ -305,7 +317,8 @@ withr::with_dir(dummypackage4, { rmarkdown::render( input = file.path(dummypackage4, "dev/dev_history.Rmd"), output_file = file.path(dummypackage4, "dev/dev_history.html"), - envir = new.env(), quiet = TRUE + envir = new.env(), + quiet = TRUE ) }) @@ -380,9 +393,12 @@ fill_description( "Everything can be set from a Rmarkdown file in your project." ), `Authors@R` = c( - person("John", "Doe", + person( + "John", + "Doe", email = "john@email.me", - role = c("aut", "cre"), comment = c(ORCID = "0000-0000-0000-0000") + role = c("aut", "cre"), + comment = c(ORCID = "0000-0000-0000-0000") ), person(given = "Company", role = "cph") ) @@ -418,7 +434,8 @@ test_that("fill_description adds DESCRIPTION", { # Second launch error and no change expect_error(fill_description( - pkg = dummypackage, fields = list(Title = "Second launch") + pkg = dummypackage, + fields = list(Title = "Second launch") )) lines <- readLines(file.path(dummypackage, "DESCRIPTION")) expect_true(lines[1] == "Package: dummypackage") @@ -485,7 +502,9 @@ inflate <- function(pkg = ".", flat_file = file.path("dev", "dev_history.Rmd"), if (!file.exists(file.path(normalizePath(pkg), "DESCRIPTION"))) { stop( - "DESCRIPTION file does not exist in your directory:", normalizePath(pkg), ".\n", + "DESCRIPTION file does not exist in your directory:", + normalizePath(pkg), + ".\n", "Have you run the content of the 'description' chunk of your {fusen} template?" ) } @@ -570,7 +589,8 @@ create_functions_all <- function(parsed_tbl, fun_code, pkg) { "There are duplicated chunk names, ", "please rename chunks with 'name-01' for instance.\n", "Duplicates: ", - paste(labels_in_vignette[duplicated(labels_in_vignette)], + paste( + labels_in_vignette[duplicated(labels_in_vignette)], collapse = ", " ) ) @@ -613,7 +633,8 @@ get_functions <- function(parsed_tbl) { example_pos_start <- grep("^#'\\s*@example", code)[1] example_pos_end <- all_arobase[all_arobase > example_pos_start][1] - 1 - example_pos_end <- ifelse(is.na(example_pos_end), + example_pos_end <- ifelse( + is.na(example_pos_end), grep("function(\\s*)\\(", code) - 1, example_pos_end ) @@ -720,7 +741,8 @@ add_fun_code_examples <- function(parsed_tbl, fun_code) { return(NA_character_) } - end_skeleton <- ifelse(is.na(fun_code_x[["example_pos_start"]]), + end_skeleton <- ifelse( + is.na(fun_code_x[["example_pos_start"]]), fun_code_x[["example_pos_end"]], fun_code_x[["example_pos_start"]] - 1 ) @@ -756,7 +778,8 @@ create_r_files <- function(fun_code, pkg) { } cat( enc2utf8(unlist(fun_code[x, ][["code_example"]])), - file = r_file, sep = "\n" + file = r_file, + sep = "\n" ) r_file }) @@ -767,8 +790,10 @@ create_r_files <- function(fun_code, pkg) { #' @param pkg Path to package #' @importFrom parsermd rmd_get_chunk create_tests_files <- function(parsed_tbl, pkg) { - rmd_test <- parsed_tbl[!is.na(parsed_tbl$label) & - grepl("test", parsed_tbl$label), ] + rmd_test <- parsed_tbl[ + !is.na(parsed_tbl$label) & + grepl("test", parsed_tbl$label), + ] rmd_test <- rmd_test[!is.na(rmd_test[["fun_name"]]), ] @@ -851,14 +876,18 @@ create_vignette <- function(parsed_tbl, pkg, name) { # Write vignette if (nrow(vignette_tbl) == 0) { - cat("", - sep = "\n", append = TRUE, + cat( + "", + sep = "\n", + append = TRUE, file = vignette_file ) } else { - cat("", + cat( + "", enc2utf8(parsermd::as_document(vignette_tbl)), - sep = "\n", append = TRUE, + sep = "\n", + append = TRUE, file = vignette_file ) } @@ -917,12 +946,16 @@ usethis::with_project(dummypackage, { # examples in R files my_median_lines <- readLines(my_median_file) expect_true(all(my_median_lines[10:12] == c( - "#' @examples", "#' my_median(2:20)", "#' my_median(1:12)" + "#' @examples", + "#' my_median(2:20)", + "#' my_median(1:12)" ))) my_other_median_lines <- readLines(my_other_median_file) expect_true(all(my_other_median_lines[10:13] == c( - "#' @examples", "#' my_other_median(1:12)", - "#' my_other_median(8:20)", "#' my_other_median(20:50)" + "#' @examples", + "#' my_other_median(1:12)", + "#' my_other_median(8:20)", + "#' my_other_median(20:50)" ))) my_third_median_lines <- readLines(my_third_median_file) # _no example @@ -946,7 +979,8 @@ usethis::with_project(dummypackage, { # Test package no check errors ---- usethis::with_project(dummypackage, { - check_out <- rcmdcheck::rcmdcheck(dummypackage, + check_out <- rcmdcheck::rcmdcheck( + dummypackage, quiet = TRUE, args = c("--no-manual") ) diff --git a/dev/flat_inflate_all.Rmd b/dev/flat_inflate_all.Rmd index fe35619..3cd349d 100644 --- a/dev/flat_inflate_all.Rmd +++ b/dev/flat_inflate_all.Rmd @@ -108,14 +108,16 @@ You can run your preferred styling functions just before the check of the packag #' #' @export inflate_all <- function( - pkg = ".", - document = TRUE, - check = TRUE, - open_vignette = FALSE, - overwrite = TRUE, - check_unregistered = TRUE, - codecov = FALSE, - stylers, ...) { + pkg = ".", + document = TRUE, + check = TRUE, + open_vignette = FALSE, + overwrite = TRUE, + check_unregistered = TRUE, + codecov = FALSE, + stylers, + ... +) { config_file <- getOption("fusen.config_file", default = "dev/config_fusen.yaml") if (!file.exists(config_file)) { @@ -152,7 +154,8 @@ inflate_all <- function( message("No flat files were inflated") } else { apply_inflate <- function(inflate_params, pkg, overwrite, open_vignette) { - config_file <- getOption("fusen.config_file", + config_file <- getOption( + "fusen.config_file", default = "dev/config_fusen.yaml" ) # Change config option temporary, to be able to modify it on the fly @@ -177,8 +180,10 @@ inflate_all <- function( ) } - apply_inflate(inflate_params, - pkg = pkg, overwrite = overwrite, + apply_inflate( + inflate_params, + pkg = pkg, + overwrite = overwrite, open_vignette = open_vignette ) } @@ -308,7 +313,8 @@ usethis::with_project(dummypackage, { # if no config file exists, we raise an error withr::with_options(list(cli.width = 80), { # cli.width is requires as cli output is wrapped to the console size - expect_error(inflate_all(), + expect_error( + inflate_all(), regexp = "requires a configuration file to[[:space:]]work properly" ) }) @@ -317,16 +323,20 @@ usethis::with_project(dummypackage, { # we inflate the flat file suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, - open_vignette = FALSE, document = TRUE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, + open_vignette = FALSE, + document = TRUE, overwrite = "yes" ) ) config_yml_ref <- yaml::read_yaml(getOption("fusen.config_file", default = "dev/config_fusen.yaml")) test_that("inflate_all says which is going to be inflated", { - expect_message(inflate_all(check = FALSE), + expect_message( + inflate_all(check = FALSE), regexp = glue::glue("The flat file {basename(flat_file)} is going to be inflated") ) }) @@ -343,7 +353,8 @@ usethis::with_project(dummypackage, { expect_true(file.exists(fun_file)) file.remove(fun_file) - expect_message(inflate_all(check = FALSE), + expect_message( + inflate_all(check = FALSE), regexp = glue::glue("The flat file {basename(flat_file)} is not going to be inflated because it is in state 'inactive or deprecated'") ) @@ -355,7 +366,8 @@ usethis::with_project(dummypackage, { flat_file2 <- gsub(x = flat_file, pattern = "flat_minimal.Rmd", replacement = "flat_minimal_2.Rmd") file.copy(from = flat_file, to = flat_file2, overwrite = TRUE) - expect_message(inflate_all(check = FALSE), + expect_message( + inflate_all(check = FALSE), regexp = glue::glue("The flat file flat_minimal_2.Rmd is not going to be inflated. It was detected in your flats directory but it is absent from the config file.") ) @@ -388,9 +400,12 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, - open_vignette = FALSE, document = TRUE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, + open_vignette = FALSE, + document = TRUE, overwrite = "yes" ) ) @@ -461,9 +476,12 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file2, - vignette_name = "Get started_2", check = FALSE, - open_vignette = FALSE, document = TRUE, + pkg = dummypackage, + flat_file = flat_file2, + vignette_name = "Get started_2", + check = FALSE, + open_vignette = FALSE, + document = TRUE, overwrite = "yes" ) ) @@ -520,9 +538,12 @@ usethis::with_project(dummypackage, { # Let's check a other way to choose the vignette name suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file2, - vignette_name = c("name" = "index"), check = FALSE, - open_vignette = FALSE, document = TRUE, + pkg = dummypackage, + flat_file = flat_file2, + vignette_name = c("name" = "index"), + check = FALSE, + open_vignette = FALSE, + document = TRUE, overwrite = "yes" ) ) @@ -533,7 +554,8 @@ usethis::with_project(dummypackage, { inflate_all(check = FALSE) expect_true(all(list.files(file.path( - dummypackage, "vignettes/" + dummypackage, + "vignettes/" )) %in% c("get-started.Rmd", "index.Rmd"))) }) }) @@ -630,20 +652,23 @@ usethis::with_project(dummypackage, { test_that("when check = FALSE we ensure no check has been performed", { # no check - utils::capture.output(inflate_all_no_check(), + utils::capture.output( + inflate_all_no_check(), file = file.path(dummypackage, "dev/inflate_all_nocheck.txt") ) expect_false(any(grepl( pattern = "R CMD check", x = readLines(file.path( - dummypackage, "dev/inflate_all_nocheck.txt" + dummypackage, + "dev/inflate_all_nocheck.txt" )) ))) }) test_that("rmdcheck does not raise errors on the created package", { - check_out <- rcmdcheck::rcmdcheck(dummypackage, + check_out <- rcmdcheck::rcmdcheck( + dummypackage, quiet = TRUE, args = c("--no-manual") ) @@ -692,13 +717,17 @@ usethis::with_project(dummypackage, { test_that("inflate_all detects unregistered files", { # Create an unregistered file - cat("# unregistered file in R\n", + cat( + "# unregistered file in R\n", file = file.path(dummypackage, "R", "unregistered_r.R") ) - cat("# unregistered file in test\n", + cat( + "# unregistered file in test\n", file = file.path( dummypackage, - "tests", "testthat", "test-unregistered_r.R" + "tests", + "testthat", + "test-unregistered_r.R" ) ) @@ -817,8 +846,10 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -846,8 +877,13 @@ usethis::with_project(dummypackage, { expect_equal( names(config_content[["flat_full.Rmd"]][["inflate"]]), c( - "flat_file", "vignette_name", "open_vignette", - "check", "document", "overwrite", "clean", + "flat_file", + "vignette_name", + "open_vignette", + "check", + "document", + "overwrite", + "clean", "codecov" ) ) @@ -868,8 +904,10 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = NA, check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = NA, + check = FALSE, open_vignette = FALSE ) ) @@ -897,8 +935,13 @@ usethis::with_project(dummypackage, { expect_equal( names(config_content[["flat_full.Rmd"]][["inflate"]]), c( - "flat_file", "vignette_name", "open_vignette", - "check", "document", "overwrite", "clean", + "flat_file", + "vignette_name", + "open_vignette", + "check", + "document", + "overwrite", + "clean", "codecov" ) ) diff --git a/dev/flat_inflate_all_utils.Rmd b/dev/flat_inflate_all_utils.Rmd index 2584881..1a34ae2 100644 --- a/dev/flat_inflate_all_utils.Rmd +++ b/dev/flat_inflate_all_utils.Rmd @@ -49,12 +49,16 @@ pre_inflate_all_diagnosis_eval <- function(diag_table, type_stop = FALSE) { if (is.na(params)) { status_text <- paste0( diag_to_eval[["type"]][flat_file_diag], - "(\"", diag_to_eval[["status"]][flat_file_diag], "\")" + "(\"", + diag_to_eval[["status"]][flat_file_diag], + "\")" ) } else { status_text <- paste0( diag_to_eval[["type"]][flat_file_diag], - "(\"", diag_to_eval[["status"]][flat_file_diag], "\", ", + "(\"", + diag_to_eval[["status"]][flat_file_diag], + "\", ", diag_to_eval[["params"]][flat_file_diag], ")" ) @@ -76,7 +80,8 @@ test_that("pre_inflate_all_diagnosis_eval works", { diagnostic <- structure( list( flat = c( - "flat_minimal.Rmd", "flat_minimal_2.Rmd", + "flat_minimal.Rmd", + "flat_minimal_2.Rmd", "missing_file.Rmd" ), status = structure( @@ -88,14 +93,16 @@ test_that("pre_inflate_all_diagnosis_eval works", { class = c("glue", "character") ), type = c( - "cli::cli_alert_success", "cli::cli_alert_warning", + "cli::cli_alert_success", + "cli::cli_alert_warning", "stop" ), params = c(NA, NA, "call. = FALSE") ), row.names = c(NA, -3L), class = c( - "tbl_df", "tbl", + "tbl_df", + "tbl", "data.frame" ) ) @@ -341,16 +348,20 @@ usethis::with_project(dummypackage, { # We inflate both flat files suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file2, - vignette_name = "Get started2", check = FALSE, + pkg = dummypackage, + flat_file = flat_file2, + vignette_name = "Get started2", + check = FALSE, open_vignette = FALSE ) ) @@ -523,7 +534,8 @@ usethis::with_project(dummypackage, { diag_expected <- structure( list( flat = c( - "flat_minimal.Rmd", "flat_minimal_2.Rmd", + "flat_minimal.Rmd", + "flat_minimal_2.Rmd", "missing_file.Rmd" ), status = structure( @@ -535,14 +547,16 @@ usethis::with_project(dummypackage, { class = c("glue", "character") ), type = c( - "cli::cli_alert_success", "cli::cli_alert_success", + "cli::cli_alert_success", + "cli::cli_alert_success", "stop" ), params = c(NA, NA, "call. = FALSE") ), row.names = c(NA, -3L), class = c( - "tbl_df", "tbl", + "tbl_df", + "tbl", "data.frame" ) ) @@ -573,8 +587,10 @@ usethis::with_project(dummypackage, { file.create(file.path(dummypackage, "R/zaza.R")) my_files_to_protect <- tibble::tribble( - ~type, ~path, - "R", "R/zaza.R" + ~type, + ~path, + "R", + "R/zaza.R" ) df_to_config(my_files_to_protect, force = TRUE) @@ -602,8 +618,10 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = new_name, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = new_name, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE, overwrite = TRUE ) @@ -618,7 +636,8 @@ usethis::with_project(dummypackage, { diag_expected <- structure( list( flat = c( - "test_minimal.Rmd", "flat_minimal_2.Rmd" + "test_minimal.Rmd", + "flat_minimal_2.Rmd" ), status = structure( c( @@ -628,13 +647,15 @@ usethis::with_project(dummypackage, { class = c("glue", "character") ), type = c( - "cli::cli_alert_success", "cli::cli_alert_success" + "cli::cli_alert_success", + "cli::cli_alert_success" ), params = c(NA, NA) ), row.names = c(NA, -2L), class = c( - "tbl_df", "tbl", + "tbl_df", + "tbl", "data.frame" ) ) @@ -662,7 +683,8 @@ usethis::with_project(dummypackage, { diag_expected <- structure( list( flat = c( - "flat_minimal.Rmd", "flat_minimal_2.Rmd" + "flat_minimal.Rmd", + "flat_minimal_2.Rmd" ), status = structure( c( @@ -672,13 +694,15 @@ usethis::with_project(dummypackage, { class = c("glue", "character") ), type = c( - "stop", "stop" + "stop", + "stop" ), params = c("call. = FALSE", "call. = FALSE") ), row.names = c(NA, -2L), class = c( - "tbl_df", "tbl", + "tbl_df", + "tbl", "data.frame" ) ) @@ -769,16 +793,20 @@ usethis::with_project(dummypackage, { # We inflate both flat files suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file2, - vignette_name = "Get started2", check = FALSE, + pkg = dummypackage, + flat_file = flat_file2, + vignette_name = "Get started2", + check = FALSE, open_vignette = FALSE ) ) @@ -847,8 +875,10 @@ usethis::with_project(dummypackage, { file.create(file.path(dummypackage, "R/zaza.R")) my_files_to_protect <- tibble::tribble( - ~type, ~path, - "R", "R/zaza.R" + ~type, + ~path, + "R", + "R/zaza.R" ) df_to_config(my_files_to_protect, force = TRUE) diff --git a/dev/flat_init_share_on_github.Rmd b/dev/flat_init_share_on_github.Rmd index 6dff1a6..fc4e505 100644 --- a/dev/flat_init_share_on_github.Rmd +++ b/dev/flat_init_share_on_github.Rmd @@ -212,7 +212,8 @@ init_share_on_github <- function(ask = TRUE, organisation = NULL) { add_line <- grep("## Example", readme_lines)[1] readme_lines[add_line] <- paste0( "## Documentation\n\n", - "Full documentation website on: ", url_pages, + "Full documentation website on: ", + url_pages, "\n\n", readme_lines[add_line] ) diff --git a/dev/flat_register_config_file.Rmd b/dev/flat_register_config_file.Rmd index 3e3448f..703fab1 100644 --- a/dev/flat_register_config_file.Rmd +++ b/dev/flat_register_config_file.Rmd @@ -168,7 +168,9 @@ check_not_registered_files <- function(path = ".", config_file, guess = TRUE, to rep("vignette", length(all_vignette)) ), path = c( - all_r, all_test, all_vignette + all_r, + all_test, + all_vignette ), stringsAsFactors = FALSE ) @@ -232,7 +234,8 @@ check_not_registered_files <- function(path = ".", config_file, guess = TRUE, to # config_file may not exist already csv_file <- file.path( - gsub(paste0(normalize_path_winslash(getwd()), "/"), "", dirname(normalize_path_winslash(config_file, mustWork = FALSE)), fixed = TRUE), "config_not_registered.csv" + gsub(paste0(normalize_path_winslash(getwd()), "/"), "", dirname(normalize_path_winslash(config_file, mustWork = FALSE)), fixed = TRUE), + "config_not_registered.csv" ) # Save for manual modification @@ -278,14 +281,16 @@ guess_flat_origin <- function(path) { lines <- readLines(path) guess_path <- sub( - ".* from\\s*(/){0,1}(.+[.].{1}md).*", "\\2", + ".* from\\s*(/){0,1}(.+[.].{1}md).*", + "\\2", lines[grep("(G|g)enerated by \\{fusen\\} from", lines)][1] ) guess_path <- normalize_path_winslash(guess_path, mustWork = FALSE) if (file.exists(guess_path)) { guess_path <- gsub( - paste0(normalize_path_winslash(getwd()), "/"), "", + paste0(normalize_path_winslash(getwd()), "/"), + "", normalize_path_winslash(guess_path, mustWork = FALSE) ) return(guess_path) @@ -329,8 +334,10 @@ flat_file <- dev_file[grepl("flat_", dev_file)] usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -372,8 +379,10 @@ usethis::with_project(dummypackage, { # Inflate once suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -390,13 +399,15 @@ usethis::with_project(dummypackage, { test_that("check_not_registered_files works", { # All files were registered during inflate expect_true(file.exists(file.path(dummypackage, "dev", "config_fusen.yaml"))) - expect_message(out_csv <- check_not_registered_files(open = FALSE), + expect_message( + out_csv <- check_not_registered_files(open = FALSE), regexp = "There are no unregistered files" ) # Delete config file to check if al sub-functions work file.remove(file.path(dummypackage, "dev", "config_fusen.yaml")) - expect_message(out_csv <- check_not_registered_files(open = FALSE), + expect_message( + out_csv <- check_not_registered_files(open = FALSE), regexp = "Some files in your package are not registered in the configuration file" ) @@ -527,8 +538,11 @@ register_all_to_config <- function(pkg = ".", config_file) { } # Use the function to check the list of files - out_df <- check_not_registered_files(pkg, - config_file = config_file, to_csv = FALSE, open = FALSE + out_df <- check_not_registered_files( + pkg, + config_file = config_file, + to_csv = FALSE, + open = FALSE ) @@ -549,7 +563,8 @@ register_all_to_config <- function(pkg = ".", config_file) { # Delete out_df csv_file <- file.path( gsub( - paste0(normalize_path_winslash(getwd()), "/"), "", + paste0(normalize_path_winslash(getwd()), "/"), + "", dirname(normalize_path_winslash(config_file, mustWork = FALSE)), fixed = TRUE ), @@ -597,8 +612,10 @@ flat_file <- dev_file[grepl("flat_", dev_file)] usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -623,8 +640,10 @@ flat_file <- dev_file[grepl("flat_", dev_file)] usethis::with_project(dummypackage_fixed, { suppressMessages( inflate( - pkg = dummypackage_fixed, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage_fixed, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -658,8 +677,10 @@ test_that("register_all_to_config can be run twice", { suppressMessages( inflate( pkg = dummypackage_fixed, - flat_file = "dev/flat_new_one.Rmd", vignette_name = NA, - check = FALSE, open_vignette = FALSE + flat_file = "dev/flat_new_one.Rmd", + vignette_name = NA, + check = FALSE, + open_vignette = FALSE ) ) @@ -674,7 +695,8 @@ test_that("register_all_to_config can be run twice", { pkg = dummypackage_fixed, flat_file = "dev/flat_new_one.Rmd", vignette_name = "new_one", - check = FALSE, open_vignette = FALSE + check = FALSE, + open_vignette = FALSE ) ) @@ -714,8 +736,10 @@ flat_file <- dev_file[grepl("flat_", dev_file)] usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -772,7 +796,8 @@ usethis::with_project(dummypackage, { ) # expect config file with my_old_fun.R in "keep" section file.remove("R/my_old_fun.R") - expect_message(check_not_registered_files(open = FALSE), + expect_message( + check_not_registered_files(open = FALSE), regexp = "There are no unregistered files" ) @@ -789,7 +814,8 @@ usethis::with_project(dummypackage, { config_file$keep$R <- "R/to_keep.R" write_yaml_verbatim(config_file, "dev/config_fusen.yaml") - expect_message(register_all_to_config(), + expect_message( + register_all_to_config(), regexp = "R: R/my_second_old_fun.R was added to the config file" ) config_file <- yaml::read_yaml("dev/config_fusen.yaml") @@ -800,7 +826,8 @@ usethis::with_project(dummypackage, { # add new file to add to keep cat("new_to_keep\n", file = "R/newfile_to_keep.R") - expect_message(register_all_to_config(), + expect_message( + register_all_to_config(), regexp = "R: R/newfile_to_keep.R was added to the config file" ) config_file <- yaml::read_yaml("dev/config_fusen.yaml") @@ -859,14 +886,16 @@ unlink(dummypackage, recursive = TRUE) #' #' @noRd -df_to_config <- function(df_files, - flat_file_path = "keep", - state = c("active", "deprecated"), - config_file, - force = FALSE, - clean = "ask", - inflate_parameters = NULL, - update_params = TRUE) { +df_to_config <- function( + df_files, + flat_file_path = "keep", + state = c("active", "deprecated"), + config_file, + force = FALSE, + clean = "ask", + inflate_parameters = NULL, + update_params = TRUE +) { if (missing(config_file)) { config_file <- getOption( "fusen.config_file", @@ -886,7 +915,9 @@ df_to_config <- function(df_files, df_files <- read.csv(df_files, stringsAsFactors = FALSE) } else if (!is.data.frame(df_files) && !file.exists(df_files)) { stop( - "'", df_files, "' does not exist. You can run ", + "'", + df_files, + "' does not exist. You can run ", "`check_not_registered_files()` before." ) } @@ -908,7 +939,9 @@ df_to_config <- function(df_files, "Some 'origin' in df_files do not exist:", paste( paste0( - "row ", which(!all_exists), ": ", + "row ", + which(!all_exists), + ": ", df_files[["origin"]][!all_exists] ), collapse = ", " @@ -951,8 +984,11 @@ df_to_config <- function(df_files, "Some 'path' in df_files do not exist:", paste( paste0( - "row ", which(!all_exists), "- ", - df_files[["type"]][!all_exists], ": ", + "row ", + which(!all_exists), + "- ", + df_files[["type"]][!all_exists], + ": ", df_files[["path"]][!all_exists] ), collapse = ", " @@ -1057,7 +1093,8 @@ df_to_config <- function(df_files, paste( yaml_paths[!all_exists], collapse = ", " - ), ".\n", + ), + ".\n", "Please open the configuration file: ", config_file, " to verify, and delete the non-existing files if needed." @@ -1086,7 +1123,8 @@ df_to_config <- function(df_files, seq_along(each_flat_file_path), function(x) { update_one_group_yaml( - df_files, complete_yaml, + df_files, + complete_yaml, each_flat_file_path[x], state = state[x], clean = ifelse(each_flat_file_path[x] == "keep", FALSE, clean), @@ -1144,7 +1182,8 @@ df_to_config <- function(df_files, #' @importFrom yaml write_yaml read_yaml #' @noRd write_yaml_verbatim <- function(x, file) { - write_yaml(x, + write_yaml( + x, file = file, handlers = list( logical = function(x) { @@ -1178,13 +1217,14 @@ files_list_to_vector <- function(list_of_files) { #' @importFrom cli cli_alert_warning cli_alert_success #' @noRd update_one_group_yaml <- function( - df_files, - complete_yaml, - flat_file_path, - state = c("active", "deprecated"), - clean = "ask", - inflate_parameters = NULL, - update_params = TRUE) { + df_files, + complete_yaml, + flat_file_path, + state = c("active", "deprecated"), + clean = "ask", + inflate_parameters = NULL, + update_params = TRUE +) { state <- match.arg(state, several.ok = FALSE) all_keep_before <- complete_yaml[[basename(flat_file_path)]] @@ -1256,7 +1296,8 @@ update_one_group_yaml <- function( inflate_parameters_new <- inflate_parameters } this_group_list_return <- c( - this_group_list, list(inflate = inflate_parameters_new) + this_group_list, + list(inflate = inflate_parameters_new) ) } @@ -1292,14 +1333,18 @@ update_one_group_yaml <- function( cli_alert_warning( paste0( "Some files are not anymore created from ", - flat_file_path, ".\n", + flat_file_path, + ".\n", "You may have rename some functions or moved them to another flat:", "\n", - paste(files_removed_vec, collapse = ", "), ".\n\n", + paste(files_removed_vec, collapse = ", "), + ".\n\n", "Below, you are ask if you want to remove them from the repository.", "\n\n", "Note: to not see this message again, use `clean = TRUE` in the ", - "`inflate()` command of this flat file : ", flat_file_path, ".\n", + "`inflate()` command of this flat file : ", + flat_file_path, + ".\n", "Use with caution. ", "It is recommended to use git to check the changes...\n" ) @@ -1326,7 +1371,8 @@ update_one_group_yaml <- function( silent <- lapply( paste( - files_removed_vec, "was removed from the config file", + files_removed_vec, + "was removed from the config file", "and from the repository" ), cli_alert_warning @@ -1334,7 +1380,8 @@ update_one_group_yaml <- function( } else if (isFALSE(do_it)) { silent <- lapply( paste( - files_removed_vec, "was removed from the config file", + files_removed_vec, + "was removed from the config file", "but kept in the repository" ), cli_alert_warning @@ -1358,11 +1405,16 @@ update_one_group_yaml <- function( # if they are not in any flat file. # Otherwise, they may be deleted with your next `inflate()` my_files_to_protect <- tibble::tribble( - ~type, ~path, - "R", "R/zaza.R", - "R", "R/zozo.R", - "test", "tests/testthat/test-zaza.R", - "vignette", "vignettes/my-zaza-vignette.Rmd" + ~type, + ~path, + "R", + "R/zaza.R", + "R", + "R/zozo.R", + "test", + "tests/testthat/test-zaza.R", + "vignette", + "vignettes/my-zaza-vignette.Rmd" ) #' \dontrun{ @@ -1386,8 +1438,10 @@ files_created_from_fake_flat <- structure( list( type = c("R", "test", "vignette"), path = c( - "R", "my_fun.R", - "tests/testthat", "test-my_fun.R", + "R", + "my_fun.R", + "tests/testthat", + "test-my_fun.R", "vignettes/minimal.Rmd" ) ), @@ -1442,17 +1496,22 @@ withr::with_dir(temp_clean_inflate, { cat("# test R file\n", file = file.path("R", "to_keep.R")) cat("# test R file\n", file = file.path("R", "to_remove.R")) - cat("# test test file\n", + cat( + "# test test file\n", file = file.path("tests", "testthat", "test-zaza.R") ) cat("# test flat file\n", file = file.path("dev", "flat_test.Rmd")) all_files <- tibble::tribble( - ~type, ~path, - "R", "R/to_keep.R", - "R", "R/to_remove.R", - "test", "tests/testthat/test-zaza.R" + ~type, + ~path, + "R", + "R/to_keep.R", + "R", + "R/to_remove.R", + "test", + "tests/testthat/test-zaza.R" ) @@ -1483,10 +1542,18 @@ withr::with_dir(temp_clean_inflate, { cat("# test R file\n", file = file.path("R", "to_add.R")) all_files_new <- tibble::tribble( - ~origin, ~type, ~path, - "dev/flat_test.Rmd", "R", "R/to_keep.R", - "dev/flat_test.Rmd", "R", "R/to_add.R", - "dev/flat_test.Rmd", "test", "tests/testthat/test-zaza.R" + ~origin, + ~type, + ~path, + "dev/flat_test.Rmd", + "R", + "R/to_keep.R", + "dev/flat_test.Rmd", + "R", + "R/to_add.R", + "dev/flat_test.Rmd", + "test", + "tests/testthat/test-zaza.R" ) # Get all messages once with snapshot @@ -1558,10 +1625,14 @@ config_file_path <- tempfile(fileext = ".yaml") test_that("df_to_config fails when appropriate", { withr::with_options(list(fusen.config_file = config_file_path), { all_files <- tibble::tribble( - ~type, ~files, - "R", "zaza.R", - "R", "zozo.R", - "test", "test-zaza.R" + ~type, + ~files, + "R", + "zaza.R", + "R", + "zozo.R", + "test", + "test-zaza.R" ) expect_error( @@ -1570,10 +1641,14 @@ test_that("df_to_config fails when appropriate", { ) all_files <- tibble::tribble( - ~type, ~path, - "R", "zaza.R", - "R", "zozo.R", - "test", "test-zaza.R" + ~type, + ~path, + "R", + "zaza.R", + "R", + "zozo.R", + "test", + "test-zaza.R" ) expect_error( @@ -1611,13 +1686,18 @@ test_that("df_to_config works", { # Use full path all_files <- tibble::tribble( - ~type, ~path, - "R", "zaza.R", - "R", "zozo.R", - "test", "test-zaza.R" + ~type, + ~path, + "R", + "zaza.R", + "R", + "zozo.R", + "test", + "test-zaza.R" ) - expect_message(config_file_out <- df_to_config(all_files), + expect_message( + config_file_out <- df_to_config(all_files), regexp = "R: zaza.R was added to the config file" ) }) @@ -1639,11 +1719,16 @@ test_that("df_to_config works", { # Second pass all_files <- tibble::tribble( - ~type, ~path, - "r", "tata.R", - "R", "toto.R", - "tests", "test-tata.R", - "vignettes", "tata_vignette.Rmd" + ~type, + ~path, + "r", + "tata.R", + "R", + "toto.R", + "tests", + "test-tata.R", + "vignettes", + "tata_vignette.Rmd" ) file.create(file.path( @@ -1679,11 +1764,16 @@ test_that("df_to_config works with files having no content", { withr::with_dir(dir_tmp, { # Use relative path all_files <- tibble::tribble( - ~type, ~path, - "R", "zaza.R", - "R", "zozo.R", - "test", "test-zaza.R", - "vignette", file.path("vignettes", "my-vignette.Rmd") + ~type, + ~path, + "R", + "zaza.R", + "R", + "zozo.R", + "test", + "test-zaza.R", + "vignette", + file.path("vignettes", "my-vignette.Rmd") ) expect_message( @@ -1716,14 +1806,20 @@ test_that("df_to_config works with files having no content", { withr::with_dir(dir_tmp, { # Use relative path all_files <- tibble::tribble( - ~type, ~path, - "R", "zaza.R", - "R", "zozo.R", - "test", "test-zaza.R", - "vignette", file.path("vignettes", "my-vignette.Rmd") + ~type, + ~path, + "R", + "zaza.R", + "R", + "zozo.R", + "test", + "test-zaza.R", + "vignette", + file.path("vignettes", "my-vignette.Rmd") ) - expect_error(config_file_out <- df_to_config(all_files), + expect_error( + config_file_out <- df_to_config(all_files), regexp = "zaza.R" ) }) @@ -1745,14 +1841,19 @@ test_that( withr::with_dir(dir_tmp, { withr::with_options(list(fusen.config_file = config_file_path), { all_files <- tibble::tribble( - ~type, ~path, - "R", "zaza.R", - "R", "zozo.R", - "test", "test-zaza.R" + ~type, + ~path, + "R", + "zaza.R", + "R", + "zozo.R", + "test", + "test-zaza.R" ) expect_error( - df_to_config(all_files, + df_to_config( + all_files, inflate_parameters = list( flat_file = "dev/my_flat.Rmd", vignette_name = "My new vignette", @@ -1777,7 +1878,8 @@ dir.create(dummypackage) fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package")) dev_file <- suppressMessages(add_minimal_package( pkg = dummypackage, - overwrite = TRUE, open = FALSE + overwrite = TRUE, + open = FALSE )) # let's create a flat file flat_file <- dev_file[grepl("flat_", dev_file)] @@ -1794,14 +1896,18 @@ file.create(file.path(dummypackage, "vignettes", "minimal.Rmd")) usethis::with_project(dummypackage, { - all_files <- structure(list( - type = c("R", "test", "vignette"), - path = c( - file.path(dummypackage, "R", "my_fun.R"), - file.path(dummypackage, "tests/testthat", "test-my_fun.R"), - "vignettes/minimal.Rmd" - ) - ), row.names = c(NA, -3L), class = c("tbl_df", "tbl", "data.frame")) + all_files <- structure( + list( + type = c("R", "test", "vignette"), + path = c( + file.path(dummypackage, "R", "my_fun.R"), + file.path(dummypackage, "tests/testthat", "test-my_fun.R"), + "vignettes/minimal.Rmd" + ) + ), + row.names = c(NA, -3L), + class = c("tbl_df", "tbl", "data.frame") + ) relative_flat_file <- "dev/flat_minimal.Rmd" @@ -1849,16 +1955,20 @@ usethis::with_project(dummypackage, { file.path(dummypackage, "vignettes", "minimal2.Rmd") ) - all_files <- structure(list( - type = c("R", "R", "test", "test", "vignette"), - path = c( - file.path(dummypackage, "R", "my_fun.R"), - file.path(dummypackage, "R", "my_fun2.R"), - file.path(dummypackage, "tests/testthat", "test-my_fun.R"), - file.path(dummypackage, "tests/testthat", "test-my_fun2.R"), - "vignettes/minimal2.Rmd" - ) - ), row.names = c(NA, -5L), class = c("tbl_df", "tbl", "data.frame")) + all_files <- structure( + list( + type = c("R", "R", "test", "test", "vignette"), + path = c( + file.path(dummypackage, "R", "my_fun.R"), + file.path(dummypackage, "R", "my_fun2.R"), + file.path(dummypackage, "tests/testthat", "test-my_fun.R"), + file.path(dummypackage, "tests/testthat", "test-my_fun2.R"), + "vignettes/minimal2.Rmd" + ) + ), + row.names = c(NA, -5L), + class = c("tbl_df", "tbl", "data.frame") + ) config_file <- df_to_config( df_files = all_files, @@ -1930,8 +2040,10 @@ test_that("inflate parameters are put into config_fusen.yaml", { usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE, extra_param = "toto" ) @@ -1977,12 +2089,15 @@ test_that("inflate parameters are put into config_fusen.yaml", { # Let's inflate a second time with different parameters suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, + pkg = dummypackage, + flat_file = flat_file, vignette_name = "Get started again", clean = TRUE, # clean previous vignette check = FALSE, - open_vignette = FALSE, overwrite = "yes", - extra_param = "tutu", document = FALSE + open_vignette = FALSE, + overwrite = "yes", + extra_param = "tutu", + document = FALSE ) ) @@ -2041,7 +2156,9 @@ unlink(dummypackage, recursive = TRUE) fusen::inflate( flat_file = "dev/flat_register_config_file.Rmd", vignette_name = "Register files in config", - check = FALSE, overwrite = TRUE, open_vignette = FALSE + check = FALSE, + overwrite = TRUE, + open_vignette = FALSE ) # rstudioapi::navigateToFile("dev/dev_history.R", line = 105) ``` diff --git a/dev/flat_sepuku-utils.Rmd b/dev/flat_sepuku-utils.Rmd index 946f88c..bb671ea 100644 --- a/dev/flat_sepuku-utils.Rmd +++ b/dev/flat_sepuku-utils.Rmd @@ -22,9 +22,10 @@ pkgload::load_all(export_all = FALSE) #' @noRd #' @rdname sepuku_utils list_flat_files_in_config_file <- function( - config_file = getOption("fusen.config_file", - default = "dev/config_fusen.yaml" - )) { + config_file = getOption( + "fusen.config_file", + default = "dev/config_fusen.yaml" + )) { if (!file.exists(config_file)) { return(character(0)) } else { @@ -96,7 +97,8 @@ usethis::with_project(dummypackage, { identified_flat_files <- list_flat_files_in_config_file() expect_equal( - length(identified_flat_files), 2 + length(identified_flat_files), + 2 ) expect_true( @@ -117,8 +119,9 @@ unlink(dummypackage, recursive = TRUE) #' @noRd #' @rdname sepuku_utils list_flat_files_in_dev_folder <- function( - pkg = ".", - folder = "dev") { + pkg = ".", + folder = "dev" +) { files_identified <- c( list.files( @@ -176,7 +179,8 @@ usethis::with_project(dummypackage, { identified_flat_files <- list_flat_files_in_dev_folder() expect_equal( - length(identified_flat_files), 2 + length(identified_flat_files), + 2 ) expect_true( @@ -212,7 +216,8 @@ usethis::with_project(dummypackage, { identified_flat_files <- list_flat_files_in_dev_folder(folder = "dev/flat_history") expect_equal( - length(identified_flat_files), 2 + length(identified_flat_files), + 2 ) expect_true( @@ -283,7 +288,8 @@ usethis::with_project(dummypackage, { flat_files <- list_flat_files() expect_equal( - length(flat_files), 2 + length(flat_files), + 2 ) expect_true( @@ -313,7 +319,8 @@ usethis::with_project(dummypackage, { flat_files <- list_flat_files() expect_equal( - length(flat_files), 2 + length(flat_files), + 2 ) expect_true( @@ -347,7 +354,8 @@ usethis::with_project(dummypackage, { flat_files <- list_flat_files() expect_equal( - length(flat_files), 2 + length(flat_files), + 2 ) expect_true( @@ -506,8 +514,9 @@ unlink(dummypackage, recursive = TRUE) #' @noRd #' @rdname sepuku_utils clean_fusen_tags_in_files <- function( - pkg = ".", - files_to_clean) { + pkg = ".", + files_to_clean +) { fusen_tags <- tolower( c("WARNING - Generated by", "Previously generated by", "WARNING - This vignette is generated by") ) diff --git a/dev/flat_sepuku.Rmd b/dev/flat_sepuku.Rmd index c4a197a..01b6ae8 100644 --- a/dev/flat_sepuku.Rmd +++ b/dev/flat_sepuku.Rmd @@ -35,9 +35,10 @@ Please be aware that this operation is irreversible. You will lose all the histo #' @importFrom cli cli_alert_info cli_alert_danger cli_abort cli_alert_success #' @export sepuku <- function( - pkg = ".", - force = FALSE, - verbose = FALSE) { + pkg = ".", + force = FALSE, + verbose = FALSE +) { if (!dir.exists(file.path(pkg, "dev"))) { cli_abort("No dev/ folder have been found. Are you sure that your package has been initiated with fusen ?") } @@ -210,27 +211,31 @@ usethis::with_project(dummypackage, { # We check that all the flat files have been deleted length( - list.files(file.path(dummypackage, "dev"), + list.files( + file.path(dummypackage, "dev"), pattern = "^flat.*\\.Rmd" ) ) length( - list.files(file.path(dummypackage, "dev"), + list.files( + file.path(dummypackage, "dev"), pattern = "^flat.*\\.qmd" ) ) length( - list.files(file.path(dummypackage, "dev", "flat_history"), + list.files( + file.path(dummypackage, "dev", "flat_history"), pattern = "^flat.*\\.Rmd" ) ) length( - list.files(file.path(dummypackage, "dev", "flat_history"), + list.files( + file.path(dummypackage, "dev", "flat_history"), pattern = "^flat.*\\.qmd" ) ) @@ -283,9 +288,12 @@ usethis::with_project(dummypackage, { # To add the config file a first inflate is needed suppressMessages( inflate( - pkg = dummypackage, flat_file = dev_file1, - vignette_name = "Get started", check = FALSE, - open_vignette = FALSE, document = TRUE, + pkg = dummypackage, + flat_file = dev_file1, + vignette_name = "Get started", + check = FALSE, + open_vignette = FALSE, + document = TRUE, overwrite = "yes" ) ) @@ -509,7 +517,8 @@ usethis::with_project(dummypackage, { ) expect_equal( length( - list.files(file.path(dummypackage, "dev"), + list.files( + file.path(dummypackage, "dev"), pattern = "flat.*\\.Rmd" ) ), @@ -518,7 +527,8 @@ usethis::with_project(dummypackage, { expect_equal( length( - list.files(file.path(dummypackage, "dev"), + list.files( + file.path(dummypackage, "dev"), pattern = "^flat.*\\.qmd" ) ), @@ -527,7 +537,8 @@ usethis::with_project(dummypackage, { expect_equal( length( - list.files(file.path(dummypackage, "dev", "flat_history"), + list.files( + file.path(dummypackage, "dev", "flat_history"), pattern = "flat.*\\.Rmd" ) ), @@ -536,7 +547,8 @@ usethis::with_project(dummypackage, { expect_equal( length( - list.files(file.path(dummypackage, "dev", "flat_history"), + list.files( + file.path(dummypackage, "dev", "flat_history"), pattern = "^flat.*\\.qmd" ) ), diff --git a/tests/testthat/test-add_flat_template.R b/tests/testthat/test-add_flat_template.R index 44906ed..62010de 100644 --- a/tests/testthat/test-add_flat_template.R +++ b/tests/testthat/test-add_flat_template.R @@ -7,7 +7,8 @@ pkg_name <- basename(dummypackage) # add_flat_template ---- test_that("add_flat_template adds flat_template.Rmd and co.", { - dev_file_path <- expect_error(add_flat_template(pkg = dummypackage, open = FALSE), + dev_file_path <- expect_error( + add_flat_template(pkg = dummypackage, open = FALSE), regexp = NA ) flat_file <- dev_file_path[grepl("flat_", dev_file_path)] @@ -22,7 +23,7 @@ test_that("add_flat_template adds flat_template.Rmd and co.", { rbuildignore_lines <- readLines(rbuildignore_file) expect_true(any(grepl("^dev$", rbuildignore_lines, fixed = TRUE))) expect_true(any(grepl("[.]here", rbuildignore_lines))) - + gitignore_file <- file.path(dummypackage, "dev", ".gitignore") expect_true(file.exists(gitignore_file)) gitignore_lines <- readLines(gitignore_file) @@ -80,14 +81,14 @@ test_that("add dev_history template works", { expect_true(file.exists(dev_file_path)) usethis::with_project(dummypackage, { - # Extract and test the description chunk dev_lines <- readLines(dev_file_path) # Change path of project dev_lines <- gsub( "here::here()", # To correct for Windows path - paste0('"', gsub("\\\\", "\\\\\\\\", dummypackage), '"'), dev_lines, + paste0('"', gsub("\\\\", "\\\\\\\\", dummypackage), '"'), + dev_lines, fixed = TRUE ) @@ -127,7 +128,8 @@ test_that("add dev_history template works with windows \\users path", { withr::with_dir(dummypackage, { dev_file_path <- expect_error( add_flat_template( - pkg = dummypackage, template = "dev_history", + pkg = dummypackage, + template = "dev_history", open = FALSE ), regexp = NA @@ -145,7 +147,8 @@ test_that("add dev_history template works with windows \\users path", { dev_lines <- gsub( "here::here()", # To correct for Windows path - paste0('"', gsub("\\\\", "\\\\\\\\", newdir_uu), '"'), dev_lines, + paste0('"', gsub("\\\\", "\\\\\\\\", newdir_uu), '"'), + dev_lines, # paste0('"', newdir_uu, '"'), dev_lines, fixed = TRUE ) @@ -208,8 +211,10 @@ for (template in all_templates) { # template <- all_templates[1] main_flat_file_name <- template if (template %in% c( - "minimal_package", "minpkg", - "minimal_flat", "minflat" + "minimal_package", + "minpkg", + "minimal_flat", + "minflat" )) { main_flat_file_name <- "minimal" } else if (template == "add") { @@ -267,14 +272,17 @@ for (template in all_templates) { rmarkdown::render( input = dev_hist_path, output_file = file.path(dummypackage4, "dev", "dev_history.html"), - envir = new.env(), quiet = TRUE + envir = new.env(), + quiet = TRUE ), regexp = NA ) }) } else if (template %in% c( - "additional", "add", - "minimal_flat", "minflat" + "additional", + "add", + "minimal_flat", + "minflat" )) { fusen::fill_description( pkg = here::here(), @@ -292,7 +300,8 @@ for (template in all_templates) { rmarkdown::render( input = flat_to_render, output_file = file.path(dummypackage4, "dev", paste0("flat_", main_flat_file_name, ".html")), - envir = new.env(), quiet = TRUE + envir = new.env(), + quiet = TRUE ), regexp = NA ) @@ -353,7 +362,9 @@ test_that("Other flat_name works", { dev_file_path <- expect_error( add_flat_template( template = "add", - pkg = dummypackage, flat_name = "hello", open = FALSE + pkg = dummypackage, + flat_name = "hello", + open = FALSE ), regexp = NA ) @@ -368,7 +379,9 @@ test_that("Other flat_name works", { expect_message( add_flat_template( template = "minpkg", - pkg = dummypackage, flat_name = "hello", open = FALSE + pkg = dummypackage, + flat_name = "hello", + open = FALSE ), regexp = "flat_hello.Rmd already exists." ) @@ -385,8 +398,10 @@ test_that("Other flat_name works", { fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package")) expect_error( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "hello", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "hello", + check = FALSE, open_vignette = FALSE ), regexp = NA @@ -415,7 +430,8 @@ test_that("Other dev_dir works", { dev_file_path <- expect_error( add_flat_template( template = "add", - pkg = dummypackage, flat_name = "hello", + pkg = dummypackage, + flat_name = "hello", dev_dir = "devdir", open = FALSE ), @@ -468,23 +484,32 @@ pkg_name <- basename(dummypackage) test_that( "add_flat_template allows bad flat_name for function name with full", - { - dev_file_path <- expect_error( - suppressMessages( - add_flat_template( - pkg = dummypackage, - flat_name = "bad for function ! but.ok", open = FALSE) - ), - regexp = NA - ) - flat_file <- dev_file_path[grepl("flat_", dev_file_path)] - - expect_true(all(file.exists(dev_file_path))) - expect_true(file.exists(file.path(dummypackage, - "dev", "flat_bad-for-function-but-ok.Rmd"))) - expect_true(file.exists(file.path(dummypackage, - "dev", "0-dev_history.Rmd"))) -}) + { + dev_file_path <- expect_error( + suppressMessages( + add_flat_template( + pkg = dummypackage, + flat_name = "bad for function ! but.ok", + open = FALSE + ) + ), + regexp = NA + ) + flat_file <- dev_file_path[grepl("flat_", dev_file_path)] + + expect_true(all(file.exists(dev_file_path))) + expect_true(file.exists(file.path( + dummypackage, + "dev", + "flat_bad-for-function-but-ok.Rmd" + ))) + expect_true(file.exists(file.path( + dummypackage, + "dev", + "0-dev_history.Rmd" + ))) + } +) unlink(dummypackage, recursive = TRUE) # add_flat_template allows bad flat_name for function name ---- @@ -495,16 +520,22 @@ pkg_name <- basename(dummypackage) test_that("add_flat_template allows bad flat_name for function name with add", { dev_file_path <- expect_error( suppressMessages( - add_additional(pkg = dummypackage, - flat_name = "bad for function ! but.ok2", open = FALSE) + add_additional( + pkg = dummypackage, + flat_name = "bad for function ! but.ok2", + open = FALSE + ) ), regexp = NA ) flat_file <- dev_file_path[grepl("flat_", dev_file_path)] expect_true(all(file.exists(dev_file_path))) - expect_true(file.exists(file.path(dummypackage, - "dev", "flat_bad-for-function-but-ok2.Rmd"))) + expect_true(file.exists(file.path( + dummypackage, + "dev", + "flat_bad-for-function-but-ok2.Rmd" + ))) dev_lines <- readLines(flat_file) # title x 1, function x 3, example x 2, tests x 3 @@ -518,7 +549,8 @@ dir.create(dummypackage) pkg_name <- basename(dummypackage) test_that("add_full adds flat_full.Rmd", { - dev_file_path <- expect_error(suppressMessages(add_full(pkg = dummypackage, open = FALSE)), + dev_file_path <- expect_error( + suppressMessages(add_full(pkg = dummypackage, open = FALSE)), regexp = NA ) flat_file <- dev_file_path[grepl("flat_", dev_file_path)] diff --git a/tests/testthat/test-build_fusen_chunks.R b/tests/testthat/test-build_fusen_chunks.R index cd60a47..a127f38 100644 --- a/tests/testthat/test-build_fusen_chunks.R +++ b/tests/testthat/test-build_fusen_chunks.R @@ -7,11 +7,11 @@ test_that("build_fusen_chunks works properly", { expect_true( grepl("^# pouet", res) ) - + expect_true( grepl("development-pouet", res) ) - + expect_true( grepl("function-pouet", res) ) @@ -51,11 +51,11 @@ test_that("build_fusen_chunks cleans functions names", { expect_true( grepl("^# po_uet", res) ) - + expect_true( grepl("development-po_uet}", res) ) - + expect_true( grepl("function-po_uet}", res) ) diff --git a/tests/testthat/test-deprecate_flat_file.R b/tests/testthat/test-deprecate_flat_file.R index 38f924b..8369371 100644 --- a/tests/testthat/test-deprecate_flat_file.R +++ b/tests/testthat/test-deprecate_flat_file.R @@ -8,7 +8,9 @@ fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package")) dev_file <- suppressMessages( add_flat_template( template = "full", - pkg = dummypackage, overwrite = TRUE, open = FALSE + pkg = dummypackage, + overwrite = TRUE, + open = FALSE ) ) flat_file <- dev_file[grepl("flat_", dev_file)] @@ -20,8 +22,10 @@ usethis::with_project(dummypackage, { # Inflate once suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -100,14 +104,16 @@ usethis::with_project(dummypackage, { }) test_that("deprecate_flat_file stops if flat file does not exist", { - expect_error(deprecate_flat_file(flat_file = "dev/flat_nonexistent.Rmd"), + expect_error( + deprecate_flat_file(flat_file = "dev/flat_nonexistent.Rmd"), regexp = "does not exist" ) }) file.create("dev/flat_nonexistent.Rmd") test_that("deprecate_flat_file stops if flat file is not in config file", { - expect_error(deprecate_flat_file(flat_file = "dev/flat_nonexistent.Rmd"), + expect_error( + deprecate_flat_file(flat_file = "dev/flat_nonexistent.Rmd"), regexp = "is not in the config file" ) }) diff --git a/tests/testthat/test-fill_description.R b/tests/testthat/test-fill_description.R index 4ca4c52..776ee52 100644 --- a/tests/testthat/test-fill_description.R +++ b/tests/testthat/test-fill_description.R @@ -31,7 +31,8 @@ test_that("fill_description adds DESCRIPTION", { expect_error( expect_message( fill_description( - pkg = dummypackage, fields = list(Title = "Second launch") + pkg = dummypackage, + fields = list(Title = "Second launch") ) ) ) @@ -57,13 +58,17 @@ test_that("no dot description fails", { "Everything can be set from a Rmarkdown file in your project" ), `Authors@R` = c( - person("Jack", "Doe", + person( + "Jack", + "Doe", email = "jack@email.me", - role = c("aut", "cre"), comment = c(ORCID = "0000-0000-0000-0001") + role = c("aut", "cre"), + comment = c(ORCID = "0000-0000-0000-0001") ), person(given = "ThinkR", role = "cph") ) - ), overwrite = TRUE + ), + overwrite = TRUE ), "A dot was added." ) @@ -89,17 +94,20 @@ dir.create(dummypackage) test_that("curly bracket in title and description works", { # Works with {} in text although not allowed by CRAN - expect_message(fill_description( - pkg = dummypackage, - fields = list( - Title = "Build a package with {fusen}", - Description = "Use Rmarkdown First method to build your package with {fusen}.", - `Authors@R` = c( - person("Jack", "Doe", email = "jack@email.me", role = c("aut", "cre"), comment = c(ORCID = "0000-0000-0000-0001")), - person(given = "ThinkR", role = "cph") + expect_message( + fill_description( + pkg = dummypackage, + fields = list( + Title = "Build a package with {fusen}", + Description = "Use Rmarkdown First method to build your package with {fusen}.", + `Authors@R` = c( + person("Jack", "Doe", email = "jack@email.me", role = c("aut", "cre"), comment = c(ORCID = "0000-0000-0000-0001")), + person(given = "ThinkR", role = "cph") + ) ) - ) - ), "Title Case") + ), + "Title Case" + ) }) # Delete dummy package diff --git a/tests/testthat/test-get_package_structure.R b/tests/testthat/test-get_package_structure.R index c7f5672..5e43653 100644 --- a/tests/testthat/test-get_package_structure.R +++ b/tests/testthat/test-get_package_structure.R @@ -26,8 +26,10 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) diff --git a/tests/testthat/test-inflate-part1.R b/tests/testthat/test-inflate-part1.R index 02a27a8..9f0f745 100644 --- a/tests/testthat/test-inflate-part1.R +++ b/tests/testthat/test-inflate-part1.R @@ -19,8 +19,10 @@ usethis::with_project(dummypackage, { usethis::use_mit_license("Statnmap") suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -80,17 +82,23 @@ usethis::with_project(dummypackage, { my_median_lines <- readLines(my_median_file) expect_equal(my_median_lines[1], "# WARNING - Generated by {fusen} from dev/flat_full.Rmd: do not edit by hand") expect_true(all(my_median_lines[12:14] == c( - "#' @examples", "#' my_median(2:20)", "#' my_median(1:12)" + "#' @examples", + "#' my_median(2:20)", + "#' my_median(1:12)" ))) my_other_median_lines <- readLines(my_other_median_file) expect_equal(my_other_median_lines[1], "# WARNING - Generated by {fusen} from dev/flat_full.Rmd: do not edit by hand") expect_true(all(my_other_median_lines[12:15] == c( - "#' @examples", "#' my_other_median(1:12)", - "#' my_other_median(8:20)", "#' my_other_median(20:50)" + "#' @examples", + "#' my_other_median(1:12)", + "#' my_other_median(8:20)", + "#' my_other_median(20:50)" ))) my_fourth_median_lines <- readLines(my_fourth_median_file) expect_true(all(my_fourth_median_lines[11:13] == c( - "#' @examples", "#' my_fourth_median(1:12)", "#' my_fourth_median(8:20)" + "#' @examples", + "#' my_fourth_median(1:12)", + "#' my_fourth_median(8:20)" ))) # _no example @@ -102,37 +110,59 @@ usethis::with_project(dummypackage, { # dot in name my_sixth_median_lines <- readLines(my_sixth_median_file) expect_true(all(my_sixth_median_lines[11:13] == c( - "#' @examples", "#' my.sixth.median_function(1:12)", "#' my.sixth.median_function(8:20)" + "#' @examples", + "#' my.sixth.median_function(1:12)", + "#' my.sixth.median_function(8:20)" ))) # _no roxygen at all my_norox_lines <- readLines(my_noroxfunctionfile) expect_true(all(my_norox_lines == c( - "# WARNING - Generated by {fusen} from dev/flat_full.Rmd: do not edit by hand", "", - "#' @noRd", "my_norox <- function(x) {", " x + 10", "}" + "# WARNING - Generated by {fusen} from dev/flat_full.Rmd: do not edit by hand", + "", + "#' @noRd", + "my_norox <- function(x) {", + " x + 10", + "}" ))) # _no roxygen but examples my_norox2_lines <- readLines(my_norox2functionfile) - expect_equal(my_norox2_lines, c( - "# WARNING - Generated by {fusen} from dev/flat_full.Rmd: do not edit by hand", "", - "#' @noRd", "#' @examples", - "#' \\dontrun{", "#' # comment", - "#' my_norox2(10)", "#' }", - "#'", - "#' \\dontrun{", - "#' # comment", - "#' my_norox2(12)", "#' }", - "my_norox2 <- function(x) {", " x + 10", "}" - )) + expect_equal( + my_norox2_lines, + c( + "# WARNING - Generated by {fusen} from dev/flat_full.Rmd: do not edit by hand", + "", + "#' @noRd", + "#' @examples", + "#' \\dontrun{", + "#' # comment", + "#' my_norox2(10)", + "#' }", + "#'", + "#' \\dontrun{", + "#' # comment", + "#' my_norox2(12)", + "#' }", + "my_norox2 <- function(x) {", + " x + 10", + "}" + ) + ) # _extra empty line and examples my_space_lines <- readLines(my_spacefunctionfile) expect_true(all(my_space_lines[8:12] == c( - "#' @examples", "#' my_space(10)", "#' @export", "", "my_space <- function(x) {" + "#' @examples", + "#' my_space(10)", + "#' @export", + "", + "my_space <- function(x) {" ))) # _extra empty line and noRd my_space2_lines <- readLines(my_space2functionfile) expect_true(all(my_space2_lines[8:10] == c( - "#' @noRd", "", "my_space2 <- function(x) {" + "#' @noRd", + "", + "my_space2 <- function(x) {" ))) }) @@ -260,8 +290,10 @@ usethis::with_project(dummypackage.special, { suppressMessages( inflate( - pkg = dummypackage.special, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage.special, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -282,8 +314,12 @@ flat_file <- dev_file[grepl("flat_", dev_file)] usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, vignette_name = "Get started", - check = FALSE, document = FALSE, open_vignette = FALSE + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, + document = FALSE, + open_vignette = FALSE ) ) desc_lines <- readLines(file.path(dummypackage, "DESCRIPTION")) @@ -308,8 +344,10 @@ usethis::with_project(dummypackage, { ) suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -337,8 +375,10 @@ usethis::with_project(dummypackage, { suppressMessages( expect_message( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -355,9 +395,11 @@ usethis::with_project(dummypackage, { usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, + pkg = dummypackage, + flat_file = flat_file, vignette_name = "Get started", - check = FALSE, overwrite = "yes", + check = FALSE, + overwrite = "yes", open_vignette = FALSE ) ) @@ -366,7 +408,8 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, + pkg = dummypackage, + flat_file = flat_file, vignette_name = "Get started", check = FALSE, open_vignette = FALSE @@ -376,9 +419,11 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, + pkg = dummypackage, + flat_file = flat_file, vignette_name = "Get started", - check = FALSE, overwrite = "no", + check = FALSE, + overwrite = "no", open_vignette = FALSE ) ) @@ -388,8 +433,12 @@ usethis::with_project(dummypackage, { # No error with overwrite = 'yes' suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, vignette_name = "Get started", - check = FALSE, overwrite = "yes", open_vignette = FALSE + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, + overwrite = "yes", + open_vignette = FALSE ) ) @@ -415,8 +464,10 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -438,8 +489,10 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ), @@ -457,18 +510,23 @@ usethis::with_project(dummypackage, { usethis::with_project(dummypackage, { file.remove(file.path(dummypackage, ".here")) file.remove(file.path(dummypackage, ".Rbuildignore")) - cat("", file = file.path( - dummypackage, - paste0(basename(dummypackage), ".Rproj") - )) + cat( + "", + file = file.path( + dummypackage, + paste0(basename(dummypackage), ".Rproj") + ) + ) # Add # {fusen} steps dev_file <- add_flat_template(pkg = dummypackage, overwrite = TRUE, open = FALSE) suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -510,8 +568,10 @@ flat_file <- dev_file[grepl("flat_", dev_file)] usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "# y \\ _ p n@ \u00E9 ! 1", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "# y \\ _ p n@ \u00E9 ! 1", + check = FALSE, open_vignette = FALSE ) ) @@ -543,8 +603,10 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - check = FALSE, open_vignette = FALSE + pkg = dummypackage, + flat_file = flat_file, + check = FALSE, + open_vignette = FALSE ) ), "DESCRIPTION file" @@ -593,8 +655,10 @@ if ( expect_message( inflate( pkg = dummypackage, # flat_file = flat_file, - vignette_name = "Get started", check = FALSE, - open_vignette = FALSE, overwrite = TRUE + vignette_name = "Get started", + check = FALSE, + open_vignette = FALSE, + overwrite = TRUE ), regexp = "The current file will be inflated" ) diff --git a/tests/testthat/test-inflate-part2.R b/tests/testthat/test-inflate-part2.R index c061951..b49bd8c 100644 --- a/tests/testthat/test-inflate-part2.R +++ b/tests/testthat/test-inflate-part2.R @@ -23,8 +23,10 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - check = FALSE, open_vignette = FALSE + pkg = dummypackage, + flat_file = flat_file, + check = FALSE, + open_vignette = FALSE ) ), regexp = NA @@ -40,7 +42,8 @@ usethis::with_project(dummypackage, { skip_on_cran() # Could not find function "my_norox2 in the vignette ? - expect_error(rcmdcheck::rcmdcheck(dummypackage, + expect_error(rcmdcheck::rcmdcheck( + dummypackage, quiet = TRUE, args = c("--no-manual") )) @@ -114,7 +117,8 @@ for (pkgname in create_choices_test) { skip_on_cran() # If this check is run inside a not "--as-cran" check, then it wont work as expected - check_out <- rcmdcheck::rcmdcheck(path_foosen, + check_out <- rcmdcheck::rcmdcheck( + path_foosen, quiet = TRUE, args = c("--no-manual") ) @@ -219,14 +223,16 @@ usethis::with_project(dummypackage, { flat_lines <- readLines(flat_file) # Change directory to current - flatlines <- gsub("here::here()", + flatlines <- gsub( + "here::here()", paste0('"', dummypackage, '"'), flat_lines, fixed = TRUE ) flatlines_chunk <- grep("```", flatlines) - flatlines_chunk_data <- grep("```{r development-dataset}", + flatlines_chunk_data <- grep( + "```{r development-dataset}", flatlines, fixed = TRUE ) @@ -298,7 +304,8 @@ usethis::with_project(dummypackage, { # Should not be any errors with templates # If this check is run inside a not "--as-cran" check, # then it wont work as expected - check_out <- rcmdcheck::rcmdcheck(dummypackage, + check_out <- rcmdcheck::rcmdcheck( + dummypackage, quiet = TRUE, args = c("--no-manual") ) @@ -331,7 +338,8 @@ fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package")) dev_file <- suppressMessages( add_flat_template( pkg = dummypackage, - overwrite = TRUE, open = FALSE + overwrite = TRUE, + open = FALSE ) ) flat_file <- dev_file[grepl("flat_", dev_file)] @@ -353,8 +361,10 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ), @@ -365,8 +375,10 @@ usethis::with_project(dummypackage, { expect_equal( sort(list.files(file.path(dummypackage, "R"))), sort(c( - "internal-variables.R", "my-data-doc.R", - "my-pkg-doc.R", "onload.R" + "internal-variables.R", + "my-data-doc.R", + "my-pkg-doc.R", + "onload.R" )) ) pkgdoc <- file.path(dummypackage, "R", "my-pkg-doc.R") @@ -376,7 +388,8 @@ usethis::with_project(dummypackage, { expect_equal(pkgdoc_lines[4], "\"_PACKAGE\"") expect_true(file.exists( file.path( - dummypackage, "man", + dummypackage, + "man", paste0(basename(dummypackage), "-package.Rd") ) )) @@ -416,10 +429,13 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, quiet = TRUE, - overwrite = TRUE, open_vignette = FALSE + overwrite = TRUE, + open_vignette = FALSE ) ), regexp = NA @@ -430,7 +446,8 @@ usethis::with_project(dummypackage, { # If this check is run inside a not "--as-cran" check, # then it wont work as expected - check_out <- rcmdcheck::rcmdcheck(dummypackage, + check_out <- rcmdcheck::rcmdcheck( + dummypackage, quiet = TRUE, args = c("--no-manual"), check_dir = checkdir @@ -465,10 +482,14 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = TRUE, - check_dir = checkdir, quiet = TRUE, - overwrite = TRUE, open_vignette = FALSE + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = TRUE, + check_dir = checkdir, + quiet = TRUE, + overwrite = TRUE, + open_vignette = FALSE ) ), regexp = NA @@ -477,7 +498,8 @@ usethis::with_project(dummypackage, { # Should not be any errors with templates in interactive check_lines <- readLines( file.path( - checkdir, paste0(basename(dummypackage), ".Rcheck"), + checkdir, + paste0(basename(dummypackage), ".Rcheck"), "00check.log" ) ) @@ -497,7 +519,8 @@ fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package")) dev_file <- suppressMessages( add_flat_template( pkg = dummypackage, - overwrite = TRUE, open = FALSE + overwrite = TRUE, + open = FALSE ) ) flat_file <- dev_file[grepl("flat_", dev_file)] @@ -516,8 +539,10 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE, # To avoid having {R6} in suggests document = FALSE @@ -561,8 +586,10 @@ test_that("rmd and name are deprecated works", { # flat_file = flat_file, rmd = flat_file, vignette_name = "Get started", - check = FALSE, document = TRUE, - overwrite = TRUE, open_vignette = FALSE + check = FALSE, + document = TRUE, + overwrite = TRUE, + open_vignette = FALSE ) ), regexp = "The `rmd` argument" @@ -574,8 +601,10 @@ test_that("rmd and name are deprecated works", { flat_file = flat_file, # vignette_name = "Get started", name = "Get started", - check = FALSE, document = TRUE, - overwrite = TRUE, open_vignette = FALSE + check = FALSE, + document = TRUE, + overwrite = TRUE, + open_vignette = FALSE ) ), regexp = "The `name` argument" @@ -597,8 +626,10 @@ usethis::with_project(dummypackage, { test_that("inflate() worked correctly", { expect_message( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = NA, check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = NA, + check = FALSE, open_vignette = FALSE ), regexp = "no vignette created" @@ -607,8 +638,10 @@ usethis::with_project(dummypackage, { expect_message( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = NULL, check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = NULL, + check = FALSE, open_vignette = FALSE ), regexp = "no vignette created" @@ -617,8 +650,10 @@ usethis::with_project(dummypackage, { expect_message( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "", + check = FALSE, open_vignette = FALSE ), regexp = "no vignette created" @@ -628,8 +663,10 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "It works then", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "It works then", + check = FALSE, open_vignette = FALSE ) ), @@ -661,8 +698,10 @@ usethis::with_project(dummypackage, { ) suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -719,8 +758,10 @@ usethis::with_project(dummypackage, { r_lines[21:25], c( "#' @rdname same_rdname", - "#' @importFrom stats median", "#' @export", - "#' @examples", "#' my_fun_rdname2(1:12)" + "#' @importFrom stats median", + "#' @export", + "#' @examples", + "#' my_fun_rdname2(1:12)" ) ) # Same chunk name @@ -823,8 +864,10 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -872,8 +915,10 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -920,8 +965,10 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ), @@ -969,8 +1016,10 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ), @@ -1019,8 +1068,10 @@ usethis::with_project(dummypackage, { # no title may return expect_message( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ), regexp = "Some example chunks are not associated to any function" @@ -1060,8 +1111,10 @@ flat_file <- dev_file[grepl("flat_", dev_file)] usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = c("Super title" = "01-Super Slug"), check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = c("Super title" = "01-Super Slug"), + check = FALSE, open_vignette = FALSE ) ) @@ -1098,8 +1151,10 @@ usethis::with_project(dummypackage, { ) suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = NA, check = FALSE + pkg = dummypackage, + flat_file = flat_file, + vignette_name = NA, + check = FALSE ) ) @@ -1137,8 +1192,10 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - check = FALSE, open_vignette = FALSE + pkg = dummypackage, + flat_file = flat_file, + check = FALSE, + open_vignette = FALSE ) ), regexp = NA @@ -1158,7 +1215,8 @@ usethis::with_project(dummypackage, { "#' @examples", "#' \\dontrun{", "#' my_twoexamples(10)", - "#' }", "#'", + "#' }", + "#'", "#' my_twoexamples(20)", "my_twoexamples <- function(x) {", " x + 10", @@ -1192,8 +1250,10 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = NA, check = FALSE + pkg = dummypackage, + flat_file = flat_file, + vignette_name = NA, + check = FALSE ) ) @@ -1205,23 +1265,39 @@ usethis::with_project(dummypackage, { # Example is included in .R in the right place for the first 3 functions code_fct1 <- readLines(file.path(dummypackage, "R", "real_name1.R")) expect_true(all(code_fct1[5:8] == c( - "#' @examples", "#' real_name1(1)", "real_name1 <-", " function(x){" + "#' @examples", + "#' real_name1(1)", + "real_name1 <-", + " function(x){" ))) code_fct2 <- readLines(file.path(dummypackage, "R", "real_name2.R")) expect_true(all(code_fct2[5:10] == c( - "#' @examples", "#' real_name2(2)", "", "# a comment", "real_name2 <- ", " function(x){" + "#' @examples", + "#' real_name2(2)", + "", + "# a comment", + "real_name2 <- ", + " function(x){" ))) code_fct3 <- readLines(file.path(dummypackage, "R", "real_name3.R")) expect_true(all(code_fct3[5:8] == c( - "#' @examples", "#' real_name3(3)", "real_name3 <- # a comment", " function(x){" + "#' @examples", + "#' real_name3(3)", + "real_name3 <- # a comment", + " function(x){" ))) code_fct10 <- readLines(file.path(dummypackage, "R", "real_name10.R")) expect_true(all(code_fct10[10:12] == c( - "#' @examples", "#' real_name10(2)", "real_name10 <- function(x){" + "#' @examples", + "#' real_name10(2)", + "real_name10 <- function(x){" ))) code_fct11 <- readLines(file.path(dummypackage, "R", "real_name11.R")) expect_true(all(code_fct11[5:8] == c( - "#' @examples", "#' real_name11(1)", "real_name11 <-", " function(x) {" + "#' @examples", + "#' real_name11(1)", + "real_name11 <-", + " function(x) {" ))) @@ -1236,8 +1312,10 @@ usethis::with_project(dummypackage, { expect_equal( sort(list.files(file.path(dummypackage, "tests", "testthat"))), sort(c( - "test-real_name1.R", "test-real_name11.R", - "test-real_name2.R", "test-real_name3.R" + "test-real_name1.R", + "test-real_name11.R", + "test-real_name2.R", + "test-real_name3.R" )) ) }) @@ -1278,8 +1356,10 @@ flat_file <- dev_file[grepl("flat_", dev_file)] usethis::with_project(dummypackage.special, { suppressMessages( inflate( - pkg = dummypackage.special, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage.special, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) diff --git a/tests/testthat/test-inflate_all.R b/tests/testthat/test-inflate_all.R index 08aabf7..f4b40b7 100644 --- a/tests/testthat/test-inflate_all.R +++ b/tests/testthat/test-inflate_all.R @@ -21,7 +21,8 @@ usethis::with_project(dummypackage, { # if no config file exists, we raise an error withr::with_options(list(cli.width = 80), { # cli.width is requires as cli output is wrapped to the console size - expect_error(inflate_all(), + expect_error( + inflate_all(), regexp = "requires a configuration file to[[:space:]]work properly" ) }) @@ -30,16 +31,20 @@ usethis::with_project(dummypackage, { # we inflate the flat file suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, - open_vignette = FALSE, document = TRUE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, + open_vignette = FALSE, + document = TRUE, overwrite = "yes" ) ) config_yml_ref <- yaml::read_yaml(getOption("fusen.config_file", default = "dev/config_fusen.yaml")) test_that("inflate_all says which is going to be inflated", { - expect_message(inflate_all(check = FALSE), + expect_message( + inflate_all(check = FALSE), regexp = glue::glue("The flat file {basename(flat_file)} is going to be inflated") ) }) @@ -56,7 +61,8 @@ usethis::with_project(dummypackage, { expect_true(file.exists(fun_file)) file.remove(fun_file) - expect_message(inflate_all(check = FALSE), + expect_message( + inflate_all(check = FALSE), regexp = glue::glue("The flat file {basename(flat_file)} is not going to be inflated because it is in state 'inactive or deprecated'") ) @@ -68,7 +74,8 @@ usethis::with_project(dummypackage, { flat_file2 <- gsub(x = flat_file, pattern = "flat_minimal.Rmd", replacement = "flat_minimal_2.Rmd") file.copy(from = flat_file, to = flat_file2, overwrite = TRUE) - expect_message(inflate_all(check = FALSE), + expect_message( + inflate_all(check = FALSE), regexp = glue::glue("The flat file flat_minimal_2.Rmd is not going to be inflated. It was detected in your flats directory but it is absent from the config file.") ) @@ -101,9 +108,12 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, - open_vignette = FALSE, document = TRUE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, + open_vignette = FALSE, + document = TRUE, overwrite = "yes" ) ) @@ -174,9 +184,12 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file2, - vignette_name = "Get started_2", check = FALSE, - open_vignette = FALSE, document = TRUE, + pkg = dummypackage, + flat_file = flat_file2, + vignette_name = "Get started_2", + check = FALSE, + open_vignette = FALSE, + document = TRUE, overwrite = "yes" ) ) @@ -233,9 +246,12 @@ usethis::with_project(dummypackage, { # Let's check a other way to choose the vignette name suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file2, - vignette_name = c("name" = "index"), check = FALSE, - open_vignette = FALSE, document = TRUE, + pkg = dummypackage, + flat_file = flat_file2, + vignette_name = c("name" = "index"), + check = FALSE, + open_vignette = FALSE, + document = TRUE, overwrite = "yes" ) ) @@ -246,7 +262,8 @@ usethis::with_project(dummypackage, { inflate_all(check = FALSE) expect_true(all(list.files(file.path( - dummypackage, "vignettes/" + dummypackage, + "vignettes/" )) %in% c("get-started.Rmd", "index.Rmd"))) }) }) @@ -343,20 +360,23 @@ usethis::with_project(dummypackage, { test_that("when check = FALSE we ensure no check has been performed", { # no check - utils::capture.output(inflate_all_no_check(), + utils::capture.output( + inflate_all_no_check(), file = file.path(dummypackage, "dev/inflate_all_nocheck.txt") ) expect_false(any(grepl( pattern = "R CMD check", x = readLines(file.path( - dummypackage, "dev/inflate_all_nocheck.txt" + dummypackage, + "dev/inflate_all_nocheck.txt" )) ))) }) test_that("rmdcheck does not raise errors on the created package", { - check_out <- rcmdcheck::rcmdcheck(dummypackage, + check_out <- rcmdcheck::rcmdcheck( + dummypackage, quiet = TRUE, args = c("--no-manual") ) @@ -405,13 +425,17 @@ usethis::with_project(dummypackage, { test_that("inflate_all detects unregistered files", { # Create an unregistered file - cat("# unregistered file in R\n", + cat( + "# unregistered file in R\n", file = file.path(dummypackage, "R", "unregistered_r.R") ) - cat("# unregistered file in test\n", + cat( + "# unregistered file in test\n", file = file.path( dummypackage, - "tests", "testthat", "test-unregistered_r.R" + "tests", + "testthat", + "test-unregistered_r.R" ) ) @@ -530,8 +554,10 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -559,8 +585,13 @@ usethis::with_project(dummypackage, { expect_equal( names(config_content[["flat_full.Rmd"]][["inflate"]]), c( - "flat_file", "vignette_name", "open_vignette", - "check", "document", "overwrite", "clean", + "flat_file", + "vignette_name", + "open_vignette", + "check", + "document", + "overwrite", + "clean", "codecov" ) ) @@ -581,8 +612,10 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = NA, check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = NA, + check = FALSE, open_vignette = FALSE ) ) @@ -610,8 +643,13 @@ usethis::with_project(dummypackage, { expect_equal( names(config_content[["flat_full.Rmd"]][["inflate"]]), c( - "flat_file", "vignette_name", "open_vignette", - "check", "document", "overwrite", "clean", + "flat_file", + "vignette_name", + "open_vignette", + "check", + "document", + "overwrite", + "clean", "codecov" ) ) diff --git a/tests/testthat/test-inflate_all_utils.R b/tests/testthat/test-inflate_all_utils.R index 0f45030..d8602e5 100644 --- a/tests/testthat/test-inflate_all_utils.R +++ b/tests/testthat/test-inflate_all_utils.R @@ -20,16 +20,20 @@ usethis::with_project(dummypackage, { # We inflate both flat files suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file2, - vignette_name = "Get started2", check = FALSE, + pkg = dummypackage, + flat_file = flat_file2, + vignette_name = "Get started2", + check = FALSE, open_vignette = FALSE ) ) @@ -202,7 +206,8 @@ usethis::with_project(dummypackage, { diag_expected <- structure( list( flat = c( - "flat_minimal.Rmd", "flat_minimal_2.Rmd", + "flat_minimal.Rmd", + "flat_minimal_2.Rmd", "missing_file.Rmd" ), status = structure( @@ -214,14 +219,16 @@ usethis::with_project(dummypackage, { class = c("glue", "character") ), type = c( - "cli::cli_alert_success", "cli::cli_alert_success", + "cli::cli_alert_success", + "cli::cli_alert_success", "stop" ), params = c(NA, NA, "call. = FALSE") ), row.names = c(NA, -3L), class = c( - "tbl_df", "tbl", + "tbl_df", + "tbl", "data.frame" ) ) @@ -252,8 +259,10 @@ usethis::with_project(dummypackage, { file.create(file.path(dummypackage, "R/zaza.R")) my_files_to_protect <- tibble::tribble( - ~type, ~path, - "R", "R/zaza.R" + ~type, + ~path, + "R", + "R/zaza.R" ) df_to_config(my_files_to_protect, force = TRUE) @@ -281,8 +290,10 @@ usethis::with_project(dummypackage, { expect_error( suppressMessages( inflate( - pkg = dummypackage, flat_file = new_name, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = new_name, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE, overwrite = TRUE ) @@ -297,7 +308,8 @@ usethis::with_project(dummypackage, { diag_expected <- structure( list( flat = c( - "test_minimal.Rmd", "flat_minimal_2.Rmd" + "test_minimal.Rmd", + "flat_minimal_2.Rmd" ), status = structure( c( @@ -307,13 +319,15 @@ usethis::with_project(dummypackage, { class = c("glue", "character") ), type = c( - "cli::cli_alert_success", "cli::cli_alert_success" + "cli::cli_alert_success", + "cli::cli_alert_success" ), params = c(NA, NA) ), row.names = c(NA, -2L), class = c( - "tbl_df", "tbl", + "tbl_df", + "tbl", "data.frame" ) ) @@ -341,7 +355,8 @@ usethis::with_project(dummypackage, { diag_expected <- structure( list( flat = c( - "flat_minimal.Rmd", "flat_minimal_2.Rmd" + "flat_minimal.Rmd", + "flat_minimal_2.Rmd" ), status = structure( c( @@ -351,13 +366,15 @@ usethis::with_project(dummypackage, { class = c("glue", "character") ), type = c( - "stop", "stop" + "stop", + "stop" ), params = c("call. = FALSE", "call. = FALSE") ), row.names = c(NA, -2L), class = c( - "tbl_df", "tbl", + "tbl_df", + "tbl", "data.frame" ) ) @@ -406,16 +423,20 @@ usethis::with_project(dummypackage, { # We inflate both flat files suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file2, - vignette_name = "Get started2", check = FALSE, + pkg = dummypackage, + flat_file = flat_file2, + vignette_name = "Get started2", + check = FALSE, open_vignette = FALSE ) ) @@ -484,8 +505,10 @@ usethis::with_project(dummypackage, { file.create(file.path(dummypackage, "R/zaza.R")) my_files_to_protect <- tibble::tribble( - ~type, ~path, - "R", "R/zaza.R" + ~type, + ~path, + "R", + "R/zaza.R" ) df_to_config(my_files_to_protect, force = TRUE) diff --git a/tests/testthat/test-inflate_qmd.R b/tests/testthat/test-inflate_qmd.R index 371d66c..e8b4281 100644 --- a/tests/testthat/test-inflate_qmd.R +++ b/tests/testthat/test-inflate_qmd.R @@ -24,8 +24,10 @@ usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = qmd_flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = qmd_flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) diff --git a/tests/testthat/test-inflate_utils.R b/tests/testthat/test-inflate_utils.R index 91a26bc..54a935e 100644 --- a/tests/testthat/test-inflate_utils.R +++ b/tests/testthat/test-inflate_utils.R @@ -5,7 +5,9 @@ df <- tibble::tibble( id = c(1, 2, 3), the_group = c("A", "A", "B"), the_code = list( - c("text 1.1", "text 1.2"), c("text 2.1", "text 2.2"), c("text 3.1", "text 3.2") + c("text 1.1", "text 1.2"), + c("text 2.1", "text 2.2"), + c("text 3.1", "text 3.2") ) ) @@ -47,8 +49,10 @@ usethis::with_project(dummypackage, { # create_vignette usethis::with_project(dummypackage, { inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) # See RStudio restart needed @@ -82,18 +86,24 @@ test_that( ) # create_vignette_head ---- -yaml_options <- structure(list( - title = "dev_history.Rmd for working package", - author = "S\\u00e9bastien Rochette", date = "`r Sys.Date()`", - output = "html_document", editor_options = list(chunk_output_type = "console") -), class = "rmd_yaml_list") +yaml_options <- structure( + list( + title = "dev_history.Rmd for working package", + author = "S\\u00e9bastien Rochette", + date = "`r Sys.Date()`", + output = "html_document", + editor_options = list(chunk_output_type = "console") + ), + class = "rmd_yaml_list" +) test_that("create_vignette_head works", { # Full with authors output <- create_vignette_head( - pkg = "mypkg", vignette_name = "the_name", + pkg = "mypkg", + vignette_name = "the_name", yaml_options ) @@ -106,7 +116,8 @@ test_that("create_vignette_head works", { # Only not extra yaml yaml_options <- yaml_options[c("title", "output", "editor_options")] output <- create_vignette_head( - pkg = "mypkg", vignette_name = "the_name", + pkg = "mypkg", + vignette_name = "the_name", yaml_options ) @@ -118,7 +129,8 @@ test_that("create_vignette_head works", { # No yaml options output <- create_vignette_head( - pkg = "mypkg", vignette_name = "the_name", + pkg = "mypkg", + vignette_name = "the_name", yaml_options = NULL ) @@ -138,7 +150,8 @@ dir.create(dummypackage) # {fusen} steps test_that("create_vignette_head works", { - expect_error(fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package")), + expect_error( + fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package")), regexp = NA ) usethis::with_project(dummypackage, { @@ -180,8 +193,10 @@ flat_file <- dev_file[grepl("flat_", dev_file)] test_that("get_pkg_name inflates", { usethis::with_project(dummypackage, { inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) }) diff --git a/tests/testthat/test-pre_inflate_all_diagnosis_eval.R b/tests/testthat/test-pre_inflate_all_diagnosis_eval.R index d50f5a9..e8829b3 100644 --- a/tests/testthat/test-pre_inflate_all_diagnosis_eval.R +++ b/tests/testthat/test-pre_inflate_all_diagnosis_eval.R @@ -6,7 +6,8 @@ test_that("pre_inflate_all_diagnosis_eval works", { diagnostic <- structure( list( flat = c( - "flat_minimal.Rmd", "flat_minimal_2.Rmd", + "flat_minimal.Rmd", + "flat_minimal_2.Rmd", "missing_file.Rmd" ), status = structure( @@ -18,14 +19,16 @@ test_that("pre_inflate_all_diagnosis_eval works", { class = c("glue", "character") ), type = c( - "cli::cli_alert_success", "cli::cli_alert_warning", + "cli::cli_alert_success", + "cli::cli_alert_warning", "stop" ), params = c(NA, NA, "call. = FALSE") ), row.names = c(NA, -3L), class = c( - "tbl_df", "tbl", + "tbl_df", + "tbl", "data.frame" ) ) diff --git a/tests/testthat/test-register_config_file.R b/tests/testthat/test-register_config_file.R index 760b934..d168d96 100644 --- a/tests/testthat/test-register_config_file.R +++ b/tests/testthat/test-register_config_file.R @@ -17,8 +17,10 @@ usethis::with_project(dummypackage, { # Inflate once suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -35,13 +37,15 @@ usethis::with_project(dummypackage, { test_that("check_not_registered_files works", { # All files were registered during inflate expect_true(file.exists(file.path(dummypackage, "dev", "config_fusen.yaml"))) - expect_message(out_csv <- check_not_registered_files(open = FALSE), + expect_message( + out_csv <- check_not_registered_files(open = FALSE), regexp = "There are no unregistered files" ) # Delete config file to check if al sub-functions work file.remove(file.path(dummypackage, "dev", "config_fusen.yaml")) - expect_message(out_csv <- check_not_registered_files(open = FALSE), + expect_message( + out_csv <- check_not_registered_files(open = FALSE), regexp = "Some files in your package are not registered in the configuration file" ) @@ -153,8 +157,10 @@ flat_file <- dev_file[grepl("flat_", dev_file)] usethis::with_project(dummypackage_fixed, { suppressMessages( inflate( - pkg = dummypackage_fixed, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage_fixed, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -188,8 +194,10 @@ test_that("register_all_to_config can be run twice", { suppressMessages( inflate( pkg = dummypackage_fixed, - flat_file = "dev/flat_new_one.Rmd", vignette_name = NA, - check = FALSE, open_vignette = FALSE + flat_file = "dev/flat_new_one.Rmd", + vignette_name = NA, + check = FALSE, + open_vignette = FALSE ) ) @@ -204,7 +212,8 @@ test_that("register_all_to_config can be run twice", { pkg = dummypackage_fixed, flat_file = "dev/flat_new_one.Rmd", vignette_name = "new_one", - check = FALSE, open_vignette = FALSE + check = FALSE, + open_vignette = FALSE ) ) @@ -244,8 +253,10 @@ flat_file <- dev_file[grepl("flat_", dev_file)] usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -302,7 +313,8 @@ usethis::with_project(dummypackage, { ) # expect config file with my_old_fun.R in "keep" section file.remove("R/my_old_fun.R") - expect_message(check_not_registered_files(open = FALSE), + expect_message( + check_not_registered_files(open = FALSE), regexp = "There are no unregistered files" ) @@ -319,7 +331,8 @@ usethis::with_project(dummypackage, { config_file$keep$R <- "R/to_keep.R" write_yaml_verbatim(config_file, "dev/config_fusen.yaml") - expect_message(register_all_to_config(), + expect_message( + register_all_to_config(), regexp = "R: R/my_second_old_fun.R was added to the config file" ) config_file <- yaml::read_yaml("dev/config_fusen.yaml") @@ -330,7 +343,8 @@ usethis::with_project(dummypackage, { # add new file to add to keep cat("new_to_keep\n", file = "R/newfile_to_keep.R") - expect_message(register_all_to_config(), + expect_message( + register_all_to_config(), regexp = "R: R/newfile_to_keep.R was added to the config file" ) config_file <- yaml::read_yaml("dev/config_fusen.yaml") @@ -368,17 +382,22 @@ withr::with_dir(temp_clean_inflate, { cat("# test R file\n", file = file.path("R", "to_keep.R")) cat("# test R file\n", file = file.path("R", "to_remove.R")) - cat("# test test file\n", + cat( + "# test test file\n", file = file.path("tests", "testthat", "test-zaza.R") ) cat("# test flat file\n", file = file.path("dev", "flat_test.Rmd")) all_files <- tibble::tribble( - ~type, ~path, - "R", "R/to_keep.R", - "R", "R/to_remove.R", - "test", "tests/testthat/test-zaza.R" + ~type, + ~path, + "R", + "R/to_keep.R", + "R", + "R/to_remove.R", + "test", + "tests/testthat/test-zaza.R" ) @@ -409,10 +428,18 @@ withr::with_dir(temp_clean_inflate, { cat("# test R file\n", file = file.path("R", "to_add.R")) all_files_new <- tibble::tribble( - ~origin, ~type, ~path, - "dev/flat_test.Rmd", "R", "R/to_keep.R", - "dev/flat_test.Rmd", "R", "R/to_add.R", - "dev/flat_test.Rmd", "test", "tests/testthat/test-zaza.R" + ~origin, + ~type, + ~path, + "dev/flat_test.Rmd", + "R", + "R/to_keep.R", + "dev/flat_test.Rmd", + "R", + "R/to_add.R", + "dev/flat_test.Rmd", + "test", + "tests/testthat/test-zaza.R" ) # Get all messages once with snapshot @@ -484,10 +511,14 @@ config_file_path <- tempfile(fileext = ".yaml") test_that("df_to_config fails when appropriate", { withr::with_options(list(fusen.config_file = config_file_path), { all_files <- tibble::tribble( - ~type, ~files, - "R", "zaza.R", - "R", "zozo.R", - "test", "test-zaza.R" + ~type, + ~files, + "R", + "zaza.R", + "R", + "zozo.R", + "test", + "test-zaza.R" ) expect_error( @@ -496,10 +527,14 @@ test_that("df_to_config fails when appropriate", { ) all_files <- tibble::tribble( - ~type, ~path, - "R", "zaza.R", - "R", "zozo.R", - "test", "test-zaza.R" + ~type, + ~path, + "R", + "zaza.R", + "R", + "zozo.R", + "test", + "test-zaza.R" ) expect_error( @@ -537,13 +572,18 @@ test_that("df_to_config works", { # Use full path all_files <- tibble::tribble( - ~type, ~path, - "R", "zaza.R", - "R", "zozo.R", - "test", "test-zaza.R" + ~type, + ~path, + "R", + "zaza.R", + "R", + "zozo.R", + "test", + "test-zaza.R" ) - expect_message(config_file_out <- df_to_config(all_files), + expect_message( + config_file_out <- df_to_config(all_files), regexp = "R: zaza.R was added to the config file" ) }) @@ -565,11 +605,16 @@ test_that("df_to_config works", { # Second pass all_files <- tibble::tribble( - ~type, ~path, - "r", "tata.R", - "R", "toto.R", - "tests", "test-tata.R", - "vignettes", "tata_vignette.Rmd" + ~type, + ~path, + "r", + "tata.R", + "R", + "toto.R", + "tests", + "test-tata.R", + "vignettes", + "tata_vignette.Rmd" ) file.create(file.path( @@ -605,11 +650,16 @@ test_that("df_to_config works with files having no content", { withr::with_dir(dir_tmp, { # Use relative path all_files <- tibble::tribble( - ~type, ~path, - "R", "zaza.R", - "R", "zozo.R", - "test", "test-zaza.R", - "vignette", file.path("vignettes", "my-vignette.Rmd") + ~type, + ~path, + "R", + "zaza.R", + "R", + "zozo.R", + "test", + "test-zaza.R", + "vignette", + file.path("vignettes", "my-vignette.Rmd") ) expect_message( @@ -642,14 +692,20 @@ test_that("df_to_config works with files having no content", { withr::with_dir(dir_tmp, { # Use relative path all_files <- tibble::tribble( - ~type, ~path, - "R", "zaza.R", - "R", "zozo.R", - "test", "test-zaza.R", - "vignette", file.path("vignettes", "my-vignette.Rmd") + ~type, + ~path, + "R", + "zaza.R", + "R", + "zozo.R", + "test", + "test-zaza.R", + "vignette", + file.path("vignettes", "my-vignette.Rmd") ) - expect_error(config_file_out <- df_to_config(all_files), + expect_error( + config_file_out <- df_to_config(all_files), regexp = "zaza.R" ) }) @@ -671,14 +727,19 @@ test_that( withr::with_dir(dir_tmp, { withr::with_options(list(fusen.config_file = config_file_path), { all_files <- tibble::tribble( - ~type, ~path, - "R", "zaza.R", - "R", "zozo.R", - "test", "test-zaza.R" + ~type, + ~path, + "R", + "zaza.R", + "R", + "zozo.R", + "test", + "test-zaza.R" ) expect_error( - df_to_config(all_files, + df_to_config( + all_files, inflate_parameters = list( flat_file = "dev/my_flat.Rmd", vignette_name = "My new vignette", @@ -703,7 +764,8 @@ dir.create(dummypackage) fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package")) dev_file <- suppressMessages(add_minimal_package( pkg = dummypackage, - overwrite = TRUE, open = FALSE + overwrite = TRUE, + open = FALSE )) # let's create a flat file flat_file <- dev_file[grepl("flat_", dev_file)] @@ -720,14 +782,18 @@ file.create(file.path(dummypackage, "vignettes", "minimal.Rmd")) usethis::with_project(dummypackage, { - all_files <- structure(list( - type = c("R", "test", "vignette"), - path = c( - file.path(dummypackage, "R", "my_fun.R"), - file.path(dummypackage, "tests/testthat", "test-my_fun.R"), - "vignettes/minimal.Rmd" - ) - ), row.names = c(NA, -3L), class = c("tbl_df", "tbl", "data.frame")) + all_files <- structure( + list( + type = c("R", "test", "vignette"), + path = c( + file.path(dummypackage, "R", "my_fun.R"), + file.path(dummypackage, "tests/testthat", "test-my_fun.R"), + "vignettes/minimal.Rmd" + ) + ), + row.names = c(NA, -3L), + class = c("tbl_df", "tbl", "data.frame") + ) relative_flat_file <- "dev/flat_minimal.Rmd" @@ -775,16 +841,20 @@ usethis::with_project(dummypackage, { file.path(dummypackage, "vignettes", "minimal2.Rmd") ) - all_files <- structure(list( - type = c("R", "R", "test", "test", "vignette"), - path = c( - file.path(dummypackage, "R", "my_fun.R"), - file.path(dummypackage, "R", "my_fun2.R"), - file.path(dummypackage, "tests/testthat", "test-my_fun.R"), - file.path(dummypackage, "tests/testthat", "test-my_fun2.R"), - "vignettes/minimal2.Rmd" - ) - ), row.names = c(NA, -5L), class = c("tbl_df", "tbl", "data.frame")) + all_files <- structure( + list( + type = c("R", "R", "test", "test", "vignette"), + path = c( + file.path(dummypackage, "R", "my_fun.R"), + file.path(dummypackage, "R", "my_fun2.R"), + file.path(dummypackage, "tests/testthat", "test-my_fun.R"), + file.path(dummypackage, "tests/testthat", "test-my_fun2.R"), + "vignettes/minimal2.Rmd" + ) + ), + row.names = c(NA, -5L), + class = c("tbl_df", "tbl", "data.frame") + ) config_file <- df_to_config( df_files = all_files, @@ -856,8 +926,10 @@ test_that("inflate parameters are put into config_fusen.yaml", { usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE, extra_param = "toto" ) @@ -903,12 +975,15 @@ test_that("inflate parameters are put into config_fusen.yaml", { # Let's inflate a second time with different parameters suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, + pkg = dummypackage, + flat_file = flat_file, vignette_name = "Get started again", clean = TRUE, # clean previous vignette check = FALSE, - open_vignette = FALSE, overwrite = "yes", - extra_param = "tutu", document = FALSE + open_vignette = FALSE, + overwrite = "yes", + extra_param = "tutu", + document = FALSE ) ) diff --git a/tests/testthat/test-rename_flat_file.R b/tests/testthat/test-rename_flat_file.R index e9263a3..5c2f702 100644 --- a/tests/testthat/test-rename_flat_file.R +++ b/tests/testthat/test-rename_flat_file.R @@ -8,7 +8,9 @@ fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package")) dev_file <- suppressMessages( add_flat_template( template = "full", - pkg = dummypackage, overwrite = TRUE, open = FALSE + pkg = dummypackage, + overwrite = TRUE, + open = FALSE ) ) flat_file <- dev_file[grepl("flat_", dev_file)] @@ -19,7 +21,8 @@ usethis::with_project(dummypackage, { write_yaml_verbatim(list(), config_file) test_that("rename_flat_file fails if file does not exists", { - expect_error(rename_flat_file(flat_file = "dev/flat_nonexistent.Rmd"), + expect_error( + rename_flat_file(flat_file = "dev/flat_nonexistent.Rmd"), regexp = "does not exist" ) }) @@ -95,8 +98,10 @@ usethis::with_project(dummypackage, { # Inflate the new file suppressMessages( inflate( - pkg = dummypackage, flat_file = other_new_path, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = other_new_path, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) diff --git a/tests/testthat/test-sepuku.R b/tests/testthat/test-sepuku.R index 5526c70..1476dff 100644 --- a/tests/testthat/test-sepuku.R +++ b/tests/testthat/test-sepuku.R @@ -38,9 +38,12 @@ usethis::with_project(dummypackage, { # To add the config file a first inflate is needed suppressMessages( inflate( - pkg = dummypackage, flat_file = dev_file1, - vignette_name = "Get started", check = FALSE, - open_vignette = FALSE, document = TRUE, + pkg = dummypackage, + flat_file = dev_file1, + vignette_name = "Get started", + check = FALSE, + open_vignette = FALSE, + document = TRUE, overwrite = "yes" ) ) @@ -261,7 +264,8 @@ usethis::with_project(dummypackage, { ) expect_equal( length( - list.files(file.path(dummypackage, "dev"), + list.files( + file.path(dummypackage, "dev"), pattern = "flat.*\\.Rmd" ) ), @@ -270,7 +274,8 @@ usethis::with_project(dummypackage, { expect_equal( length( - list.files(file.path(dummypackage, "dev"), + list.files( + file.path(dummypackage, "dev"), pattern = "^flat.*\\.qmd" ) ), @@ -279,7 +284,8 @@ usethis::with_project(dummypackage, { expect_equal( length( - list.files(file.path(dummypackage, "dev", "flat_history"), + list.files( + file.path(dummypackage, "dev", "flat_history"), pattern = "flat.*\\.Rmd" ) ), @@ -288,7 +294,8 @@ usethis::with_project(dummypackage, { expect_equal( length( - list.files(file.path(dummypackage, "dev", "flat_history"), + list.files( + file.path(dummypackage, "dev", "flat_history"), pattern = "^flat.*\\.qmd" ) ), diff --git a/tests/testthat/test-sepuku_utils.R b/tests/testthat/test-sepuku_utils.R index 3a0ecda..1921b51 100644 --- a/tests/testthat/test-sepuku_utils.R +++ b/tests/testthat/test-sepuku_utils.R @@ -57,7 +57,8 @@ usethis::with_project(dummypackage, { identified_flat_files <- list_flat_files_in_config_file() expect_equal( - length(identified_flat_files), 2 + length(identified_flat_files), + 2 ) expect_true( @@ -104,7 +105,8 @@ usethis::with_project(dummypackage, { identified_flat_files <- list_flat_files_in_dev_folder() expect_equal( - length(identified_flat_files), 2 + length(identified_flat_files), + 2 ) expect_true( @@ -140,7 +142,8 @@ usethis::with_project(dummypackage, { identified_flat_files <- list_flat_files_in_dev_folder(folder = "dev/flat_history") expect_equal( - length(identified_flat_files), 2 + length(identified_flat_files), + 2 ) expect_true( @@ -182,7 +185,8 @@ usethis::with_project(dummypackage, { flat_files <- list_flat_files() expect_equal( - length(flat_files), 2 + length(flat_files), + 2 ) expect_true( @@ -212,7 +216,8 @@ usethis::with_project(dummypackage, { flat_files <- list_flat_files() expect_equal( - length(flat_files), 2 + length(flat_files), + 2 ) expect_true( @@ -246,7 +251,8 @@ usethis::with_project(dummypackage, { flat_files <- list_flat_files() expect_equal( - length(flat_files), 2 + length(flat_files), + 2 ) expect_true( diff --git a/tests/testthat/test-skeleton.R b/tests/testthat/test-skeleton.R index ba4c1b0..142d8ae 100644 --- a/tests/testthat/test-skeleton.R +++ b/tests/testthat/test-skeleton.R @@ -5,7 +5,8 @@ test_that("rmardown skeleton exists", { rmarkdown::draft( file = "flat_skeleton.Rmd", template = "additional", - package = "fusen", edit = FALSE + package = "fusen", + edit = FALSE ), regexp = NA ) diff --git a/tests/testthat/test-user-story.R b/tests/testthat/test-user-story.R index 9827205..5023f6e 100644 --- a/tests/testthat/test-user-story.R +++ b/tests/testthat/test-user-story.R @@ -33,8 +33,10 @@ for (template in all_templates_second) { # Inflate first flat file suppressMessages(inflate( - flat_file = "dev/flat_first.Rmd", vignette_name = "My First", - open_vignette = FALSE, check = FALSE + flat_file = "dev/flat_first.Rmd", + vignette_name = "My First", + open_vignette = FALSE, + check = FALSE )) test_that(paste0("full process -", template, "- first minimal basis ok"), { @@ -57,8 +59,10 @@ for (template in all_templates_second) { # Inflate second flat file suppressMessages(inflate( - flat_file = "dev/flat_second.Rmd", vignette_name = "My Second", - open_vignette = FALSE, check = FALSE + flat_file = "dev/flat_second.Rmd", + vignette_name = "My Second", + open_vignette = FALSE, + check = FALSE )) expect_true(file.exists("vignettes/my-second.Rmd")) diff --git a/vignettes/deal-with-a-fusen-flat-file.Rmd b/vignettes/deal-with-a-fusen-flat-file.Rmd index 8bc79a8..6ed59dd 100644 --- a/vignettes/deal-with-a-fusen-flat-file.Rmd +++ b/vignettes/deal-with-a-fusen-flat-file.Rmd @@ -36,7 +36,9 @@ This function should avoid remaining inflated files in the repository, and ensur dev_file <- suppressMessages( add_flat_template( template = "add", - pkg = ".", overwrite = TRUE, open = FALSE + pkg = ".", + overwrite = TRUE, + open = FALSE ) ) rename_flat_file( @@ -73,7 +75,9 @@ To facilitate this transition, the function `deprecate_flat_file()` is provided. dev_file <- suppressMessages( add_flat_template( template = "add", - pkg = dummypackage, overwrite = TRUE, open = FALSE + pkg = dummypackage, + overwrite = TRUE, + open = FALSE ) ) deprecate_flat_file(flat_file = "dev/flat_additional.Rmd") diff --git a/vignettes/draw-a-tree-of-your-package-files-and-functions.Rmd b/vignettes/draw-a-tree-of-your-package-files-and-functions.Rmd index d834dc5..46b44b7 100644 --- a/vignettes/draw-a-tree-of-your-package-files-and-functions.Rmd +++ b/vignettes/draw-a-tree-of-your-package-files-and-functions.Rmd @@ -75,8 +75,10 @@ usethis::with_project(dummypackage, { # Works with 'fusen' package suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) diff --git a/vignettes/register-files-in-config.Rmd b/vignettes/register-files-in-config.Rmd index 03c8745..236fb9b 100644 --- a/vignettes/register-files-in-config.Rmd +++ b/vignettes/register-files-in-config.Rmd @@ -174,8 +174,10 @@ flat_file <- dev_file[grepl("flat_", dev_file)] usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) @@ -236,8 +238,10 @@ flat_file <- dev_file[grepl("flat_", dev_file)] usethis::with_project(dummypackage, { suppressMessages( inflate( - pkg = dummypackage, flat_file = flat_file, - vignette_name = "Get started", check = FALSE, + pkg = dummypackage, + flat_file = flat_file, + vignette_name = "Get started", + check = FALSE, open_vignette = FALSE ) ) diff --git a/vignettes/switch-from-a-package-developed-with-fusen-to-a-classical-package.Rmd b/vignettes/switch-from-a-package-developed-with-fusen-to-a-classical-package.Rmd index ca67e08..b5e093b 100644 --- a/vignettes/switch-from-a-package-developed-with-fusen-to-a-classical-package.Rmd +++ b/vignettes/switch-from-a-package-developed-with-fusen-to-a-classical-package.Rmd @@ -103,27 +103,31 @@ usethis::with_project(dummypackage, { # We check that all the flat files have been deleted length( - list.files(file.path(dummypackage, "dev"), + list.files( + file.path(dummypackage, "dev"), pattern = "^flat.*\\.Rmd" ) ) length( - list.files(file.path(dummypackage, "dev"), + list.files( + file.path(dummypackage, "dev"), pattern = "^flat.*\\.qmd" ) ) length( - list.files(file.path(dummypackage, "dev", "flat_history"), + list.files( + file.path(dummypackage, "dev", "flat_history"), pattern = "^flat.*\\.Rmd" ) ) length( - list.files(file.path(dummypackage, "dev", "flat_history"), + list.files( + file.path(dummypackage, "dev", "flat_history"), pattern = "^flat.*\\.qmd" ) ) diff --git a/vignettes/tips-and-tricks.Rmd b/vignettes/tips-and-tricks.Rmd index d97fa89..081eb27 100644 --- a/vignettes/tips-and-tricks.Rmd +++ b/vignettes/tips-and-tricks.Rmd @@ -424,4 +424,4 @@ Although default {golem} "dev/" files already contain the main actions to mainta # How can I know if R files were created from a flat or not ? You can draw the structure of your package with `fusen:::draw_package_structure(). -Read vignette "Draw a tree of your package files and functions"" for more details. \ No newline at end of file +Read vignette "Draw a tree of your package files and functions"" for more details.