Nothing
#' Package Spell Checking
#'
#' Automatically spell-check package description, documentation, and vignettes.
#'
#' Parses and checks R manual pages, rmd/rnw vignettes, and text fields in the
#' package `DESCRIPTION` file.
#'
#' The preferred spelling language (typically `en-GB` or `en-US`) should be specified
#' in the `Language` field from your package `DESCRIPTION`. To allow custom words,
#' use the package [WORDLIST][get_wordlist] file which will be added to the dictionary
#' when spell checking. See [update_wordlist] to automatically populate and update this
#' file.
#'
#' The [spell_check_setup] function adds a unit test to your package which automatically
#' runs a spell check on documentation and vignettes during `R CMD check` if the environment
#' variable `NOT_CRAN` is set to `TRUE`. By default this unit test never fails; it merely
#' prints potential spelling errors to the console. If not already done,
#' the [spell_check_setup] function will add `spelling` as a `Suggests` dependency,
#' and a `Language` field to `DESCRIPTION`.
#'
#' Hunspell includes dictionaries for `en_US` and `en_GB` by default. Other languages
#' require installation of a custom dictionary, see [hunspell][hunspell::hunspell] for details.
#'
#' @export
#' @rdname spell_check_package
#' @name spell_check_package
#' @aliases spelling
#' @family spelling
#' @param pkg path to package root directory containing the `DESCRIPTION` file
#' @param vignettes check all `rmd` and `rnw` files in the pkg root directory (e.g.
#' `readme.md`) and package `vignettes` folder.
#' @param use_wordlist ignore words in the package [WORDLIST][get_wordlist] file
#' @param lang set `Language` field in `DESCRIPTION` e.g. `"en-US"` or `"en-GB"`.
#' For supporting other languages, see the [hunspell vignette](https://docs.ropensci.org/hunspell/articles/intro.html#hunspell-dictionaries).
spell_check_package <- function(pkg = ".", vignettes = TRUE, use_wordlist = TRUE){
# Get package info
pkg <- as_package(pkg)
# Get language from DESCRIPTION
lang <- normalize_lang(pkg$language)
# Add custom words to the ignore list
add_words <- if(isTRUE(use_wordlist))
get_wordlist(pkg$path)
author <- if(length(pkg[['authors@r']])){
parse_r_field(pkg[['authors@r']])
} else {
strsplit(pkg[['author']], " ", fixed = TRUE)[[1]]
}
ignore <- unique(c(pkg$package, author, hunspell::en_stats, add_words))
# Create the hunspell dictionary object
dict <- hunspell::dictionary(lang, add_words = sort(ignore))
# Check Rd manual files
rd_files <- sort(list.files(file.path(pkg$path, "man"), "\\.rd$", ignore.case = TRUE, full.names = TRUE))
macros <- tools::loadRdMacros(
file.path(R.home("share"), "Rd", "macros", "system.Rd"),
tools::loadPkgRdMacros(pkg$path, macros = NULL)
)
rd_lines <- lapply(rd_files, spell_check_file_rd, dict = dict, macros = macros)
# Check 'DESCRIPTION' fields
pkg_fields <- c("title", "description")
pkg_lines <- lapply(pkg_fields, function(x){
spell_check_description_text(textConnection(pkg[[x]]), dict = dict)
})
# Combine
all_sources <- c(rd_files, pkg_fields)
all_lines <- c(rd_lines, pkg_lines)
if(isTRUE(vignettes)){
# Where to check for rmd/md files
vign_files <- list.files(file.path(pkg$path, "vignettes"), pattern = "\\.q?r?md$",
ignore.case = TRUE, full.names = TRUE, recursive = TRUE)
root_files <- list.files(pkg$path, pattern = "(readme|news|changes|index).r?q?md",
ignore.case = TRUE, full.names = TRUE)
# Markdown vignettes
md_files <- normalizePath(c(root_files, vign_files))
md_lines <- lapply(sort(md_files), spell_check_file_md, dict = dict)
# Sweave vignettes
rnw_files <- list.files(file.path(pkg$path, "vignettes"), pattern = "\\.[rs]nw$", ignore.case = TRUE, full.names = TRUE)
rnw_lines <- lapply(sort(rnw_files), spell_check_file_knitr, format = "latex", dict = dict)
# Combine
all_sources <- c(all_sources, md_files, rnw_files)
all_lines <- c(all_lines, md_lines, rnw_lines)
}
summarize_words(all_sources, all_lines)
}
as_package <- function(pkg){
if(inherits(pkg, 'package'))
return(pkg)
path <- pkg
description <- if(file.exists(file.path(path, "DESCRIPTION.in"))){
file.path(path, "DESCRIPTION.in")
} else {
normalizePath(file.path(path, "DESCRIPTION"), mustWork = TRUE)
}
pkg <- read.dcf(description)[1,]
Encoding(pkg) = "UTF-8"
pkg <- as.list(pkg)
names(pkg) <- tolower(names(pkg))
pkg$path <- dirname(description)
structure(pkg, class = 'package')
}
# Find all occurences for each word
summarize_words <- function(file_names, found_line){
words_by_file <- lapply(found_line, names)
bad_words <- sort(unique(unlist(words_by_file)))
out <- data.frame(
word = bad_words,
stringsAsFactors = FALSE
)
out$found <- lapply(bad_words, function(word) {
index <- which(vapply(words_by_file, `%in%`, x = word, logical(1)))
reports <- vapply(index, function(i){
paste0(basename(file_names[i]), ":", found_line[[i]][word])
}, character(1))
})
structure(out, class = c("summary_spellcheck", "data.frame"))
}
#' @export
print.summary_spellcheck <- function(x, ...){
if(!nrow(x)){
cat("No spelling errors found.\n")
return(invisible())
}
words <- x$word
fmt <- paste0("%-", max(nchar(words), 0) + 3, "s")
pretty_names <- sprintf(fmt, words)
cat(sprintf(fmt, " WORD"), " FOUND IN\n", sep = "")
for(i in seq_len(nrow(x))){
cat(pretty_names[i])
cat(paste(x$found[[i]], collapse = paste0("\n", sprintf(fmt, ""))))
cat("\n")
}
invisible(x)
}
#' @export
#' @aliases spell_check_test
#' @rdname spell_check_package
#' @param error should `CMD check` fail if spelling errors are found?
#' Default only prints results.
spell_check_setup <- function(pkg = ".", vignettes = TRUE, lang = "en-US", error = FALSE){
# Get package info
pkg <- as_package(pkg)
lang <- normalize_lang(lang)
pkg$language <- lang
update_description(pkg, lang = lang)
update_wordlist(pkg, vignettes = vignettes)
dir.create(file.path(pkg$path, "tests"), showWarnings = FALSE)
writeLines(sprintf("if(requireNamespace('spelling', quietly = TRUE))
spelling::spell_check_test(vignettes = %s, error = %s,
skip_on_cran = TRUE)",
deparse(vignettes), deparse(error)), file.path(pkg$path, "tests/spelling.R"))
cat(sprintf("Updated %s\n", file.path(pkg$path, "tests/spelling.R")))
}
#' @export
spell_check_test <- function(vignettes = TRUE, error = FALSE, lang = NULL, skip_on_cran = TRUE){
if(isTRUE(skip_on_cran)){
not_cran <- Sys.getenv('NOT_CRAN')
# See logic in tools:::config_val_to_logical
if(is.na(match(tolower(not_cran), c("1", "yes", "true"))))
return(NULL)
}
out_save <- readLines(system.file("templates/spelling.Rout.save", package = 'spelling'))
code <- format_syntax(readLines("spelling.R"))
out_save <- sub("@INPUT@", code, out_save, fixed = TRUE)
writeLines(out_save, "spelling.Rout.save")
# Try to find pkg source directory
pkg_dir <- list.files("../00_pkg_src", full.names = TRUE)
if(!length(pkg_dir)){
# This is where it is on e.g. win builder
check_dir <- dirname(getwd())
if(grepl("\\.Rcheck$", check_dir)){
source_dir <- sub("\\.Rcheck$", "", check_dir)
if(file.exists(source_dir))
pkg_dir <- source_dir
}
}
if(!length(pkg_dir) && identical(basename(getwd()), 'tests')){
if(file.exists('../DESCRIPTION')){
pkg_dir <- dirname(getwd())
}
}
if(!length(pkg_dir)){
warning("Failed to find package source directory from: ", getwd())
return(invisible())
}
results <- spell_check_package(pkg_dir, vignettes = vignettes)
if(nrow(results)){
if(isTRUE(error)){
output <- sprintf("Potential spelling errors: %s\n", paste(results$word, collapse = ", "))
stop(output, "\n", "If these are false positive, run `spelling::update_wordlist()`.", call. = FALSE)
} else {
cat("Potential spelling errors:\n")
print(results)
cat("If these are false positive, run `spelling::update_wordlist()`.")
}
}
cat("All Done!\n")
}
update_description <- function(pkg, lang = NULL){
desc <- normalizePath(file.path(pkg$path, "DESCRIPTION"), mustWork = TRUE)
lines <- readLines(desc, warn = FALSE)
if(!any(grepl("spelling", c(pkg$package, pkg$suggests, pkg$imports, pkg$depends)))){
lines <- if(!any(grepl("^Suggests", lines))){
c(lines, "Suggests:\n spelling")
} else {
sub("^Suggests:", "Suggests:\n spelling,", lines)
}
}
is_lang <- grepl("^Language:", lines, ignore.case = TRUE)
isolang <- gsub("_", "-", lang, fixed = TRUE)
if(any(is_lang)){
is_lang <- which(grepl("^Language:", lines))
lines[is_lang] <- paste("Language:", isolang)
} else {
message(sprintf("Adding 'Language: %s' to DESCRIPTION", isolang))
lines <- c(lines, paste("Language:", isolang))
}
writeLines(lines, desc)
}
format_syntax <- function(txt){
pt <- getOption('prompt')
ct <- getOption('continue')
prefix <- c(pt, rep(ct, length(txt) - 1))
paste(prefix, txt, collapse = "\n", sep = "")
}
parse_r_field <- function(txt){
tryCatch({
info <- eval(parse(text = txt))
unlist(info, recursive = TRUE, use.names = FALSE)
}, error = function(e){
NULL
})
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.