diff --git a/R/use.R b/R/use.R index 62f70e7..42db0f6 100644 --- a/R/use.R +++ b/R/use.R @@ -13,50 +13,140 @@ #' `DESCRIPTION` file. #' #' @export -use_rd_roclet <- function(path = getwd(), check = NA) { +use_testex <- function(path = getwd(), check = NA, quiet = FALSE) { + msg <- if (quiet) identity else message + na <- NA_character_ path <- file.path(find_package_root(path), "DESCRIPTION") desc <- read.dcf(path) desc <- read.dcf(path, keep.white = colnames(desc)) + report <- report(quiet) + desc <- update_desc_roxygen(desc, report) + desc <- update_desc_suggests(desc, report) + desc <- update_desc_config_options(desc, check, report) + update_testthat(path, report) + report$show("Configuring `testex`:") + + write.dcf( + desc, + path, + keep.white = setdiff(colnames(desc), "Roxygen"), + width = 80L, + indent = 2L + ) +} + +report <- function(quiet) { + messages <- character() + add <- function(message) { + messages <<- append(messages, message) + } + show <- function(title) { + out <- paste0(title, "\n", paste0(paste0(" * ", messages), collapse = "\n")) + if (!quiet && length(messages)) { + message(out) + } else if (!length(messages)) { + message(paste0("No changes made")) + } + } + environment() +} + + +update_desc_roxygen <- function(desc, report) { # update Roxygen settings - roxygen <- if (!"Roxygen" %in% colnames(desc)) { - list(markdown = TRUE, roclets = c("namespace")) + roxygen_orig <- if (!"Roxygen" %in% colnames(desc)) { + list() } else { eval( - parse(text = desc[1L,"Roxygen"], keep.source = FALSE), + parse(text = desc[1L, "Roxygen"], keep.source = FALSE), envir = new.env(parent = baseenv()) ) } - roxygen$roclets <- c( - setdiff(roxygen$roclets, c("rd", "testex::rd")), - "testex::rd" - ) + # add testex to packages + roxygen <- roxygen_orig + roxygen$packages <- unique(c(roxygen$packages, packageName())) + if (!identical(roxygen, roxygen_orig)) { + msg <- sprintf( + 'Including `packages = "%s"` in Roxygen DESCRIPTION field', + packageName() + ) + report$add(msg) + } + + roxygen_str <- paste0("\n ", deparse(roxygen), collapse = "") + desc_update(desc, Roxygen = roxygen_str) +} +update_desc_suggests <- function(desc, report) { # add testex to Suggests suggests <- if (!"Suggests" %in% colnames(desc)) { character(0L) } else { - desc[1L,"Suggests"] + desc[1L, "Suggests"] } - if (!any(grepl("\\btestex\\b", suggests))) { - suggests <- paste(c(suggests, "testex"), collapse = "\n") + package_re <- paste0("\\b", packageName(), "\\b") + if (!any(grepl(package_re, suggests))) { + lines <- Filter(nchar, strsplit(suggests, "\n")[[1]]) + ws <- min(nchar(gsub("[^ ].*", "", lines))) + package <- paste0(strrep(" ", ws), packageName()) + suggests <- paste(c(suggests, package), collapse = ",\n") + report$add(sprintf('Adding Suggests package "%s"', packageName())) } - if (!"Roxygen" %in% colnames(desc)) desc <- cbind(desc, "Roxygen" = NA_character_) - if (!"Suggests" %in% colnames(desc)) desc <- cbind(desc, "Suggests" = NA_character_) + desc_update(desc, Suggests = suggests) +} - desc[1L, "Roxygen"] <- paste0("\n ", deparse(roxygen), collapse = "") - desc[1L, "Suggests"] <- suggests +update_desc_config_options <- function(desc, check, report) { + config <- paste("Config", packageName(), "options", sep = "/") - write.dcf( + if (!config %in% colnames(desc)) { + desc <- cbind(desc, matrix(NA_character_, dimnames = list(c(), config))) + desc[1L, config] <- paste0("\n ", deparse(list(check = TRUE))) + msg <- sprintf( + "Configuring DESCRIPTION %s to run testex on R CMD check by default", + config + ) + report$add(msg) + } else if (is.logical(check) && !is.na(check)) { + desc[1L, config] <- paste0("\n ", deparse(list(check = check))) + msg <- sprintf("Configuring DESCRIPTION %s", config) + report$add(smg) + } + + desc +} + +update_testthat <- function(path, report) { + tryCatch( + { + f <- use_testex_as_testthat(path = path, quiet = TRUE) + report$add(sprintf("Adding test file '%s'", f)) + }, + error = function(e) NULL + ) +} + +desc_update <- function(desc, ...) { + cols <- list(...) + new_cols <- setdiff(names(cols), colnames(desc)) + desc <- cbind( desc, - path, - keep.white = setdiff(colnames(desc), "Roxygen"), - width = 80L, - indent = 2L + matrix( + NA_character_, + nrow = nrow(desc), + ncol = length(new_cols), + dimnames = list(c(), new_cols) + ) ) + + for (col in names(cols)) { + desc[, col] <- cols[[col]] + } + + desc } @@ -73,29 +163,32 @@ use_rd_roclet <- function(path = getwd(), check = NA) { #' #' @importFrom utils packageName #' @export -use_testex_as_testthat <- function(path = getwd(), context = "testex") { +use_testex_as_testthat <- function(path = getwd(), context = "testex", quiet = FALSE) { path <- find_package_root(path) package <- read.dcf(file.path(path, "DESCRIPTION"), fields = "Package")[[1L]] testthat_path <- file.path(path, "tests", "testthat") test_file <- file.path(testthat_path, paste0("test-", context, ".R")) if (!dir.exists(testthat_path)) { - stop( + if (!quiet) stop( "It looks like you don't have any testthat tests yet. Start ", "by setting up your package to use testthat, then try again." ) + return() } if (file.exists(test_file)) { - stop(sprintf( + if (!quiet) stop(sprintf( "testthat test file '%s' already exists.", basename(test_file) )) + return() } test_contents <- c( - paste0(packageName(), "::test_examples_as_testthat(\"", package, "\")") + paste0(packageName(), "::test_examples_as_testthat()") ) writeLines(test_contents, test_file) + test_file } diff --git a/README.md b/README.md index f9e9f25..65454d5 100644 --- a/README.md +++ b/README.md @@ -35,16 +35,15 @@ To enable this roclet, you'll also need to modify your package's `DESCRIPTION` to include the `testex::rd` roclet. Adding it is as easy as calling: ```r -testex::use_rd_roclet() +testex::use_testex() ``` -This will modify your existing roclets, replacing the default `roxygen2` `"rd"` -roclet with `testex`'s: +This will take a few steps to set up your package: -```diff -- Roxygen: list(markdown = TRUE, roclets = c("namespace", "rd")) -+ Roxygen: list(markdown = TRUE, roclets = c("namespace", "testex::rd")) -``` +- [x] Adds `packages = "testex"` to the `Roxygen` field in `DESCRIPTION` +- [x] Adds `testex` as a `Suggests` dependency +- [x] Adds settings to the `Config/testex/options` field in `DESCRIPTION` +- [x] Adds a `test-testex.R` test file if you're using `testthat` ### 3. Configure how you want to run your tests diff --git a/inst/pkg.example/DESCRIPTION b/inst/pkg.example/DESCRIPTION index e84fe06..7ceaa10 100644 --- a/inst/pkg.example/DESCRIPTION +++ b/inst/pkg.example/DESCRIPTION @@ -5,12 +5,13 @@ Authors@R: person("First", "Last", , "first.last@example.com", role = c("aut", "cre")) Description: What the package does (one paragraph). Suggests: - testex, testthat (>= 3.0.0), - roxygen2 + roxygen2, + testex Encoding: UTF-8 Roxygen: list(markdown = TRUE, packages = "testex") RoxygenNote: 7.3.1 License: MIT + file LICENSE Config/testthat/edition: 3 -Config/testex/options: list(check = TRUE) +Config/testex/options: + list(check = TRUE)