Code tweaks (#6)

R/checkers.R

@@ -16,7 +16,7 @@ is_referenced <- function(pkg) {
 
 is_bib <- function(x) {
   n <- nchar(x)
-  substr(x, n - 3L, n) == ".bib"
+  tolower(substr(x, n - 3L, n)) == ".bib"
 }
 
 is_unit_set <- function(x) {
@@ -75,41 +75,41 @@ error <- function(msg, ...) {
   sprintf(msg, ...)
 }
 
-caller_arg <- function(x) {
+caller_arg <- function() {
   deparse(substitute(x, env = parent.frame()))
 }
 
-check_type <- function(x, asserter, expected, arg = caller_arg(x)) {
+check_type <- function(x, asserter, expected, arg = caller_arg()) {
   if (asserter(x)) {
     return(invisible())
   }
   abort(paste0("`%s` must be ", expected, "."), arg)
 }
 
-check_string <- function(x, arg = caller_arg(x)) {
+check_string <- function(x, arg = caller_arg()) {
   check_type(x, is_string, "a string", arg)
 }
 
-check_bool <- function(x, arg = caller_arg(x)) {
+check_bool <- function(x, arg = caller_arg()) {
   check_type(x, is.logical, "`TRUE` or `FALSE`", arg)
 }
 
-check_character <- function(x, arg = caller_arg(x)) {
+check_character <- function(x, arg = caller_arg()) {
   check_type(x, is.character, "a character vector", arg)
 }
 
-check_unit_set <- function(x, arg = caller_arg(x)) {
+check_unit_set <- function(x, arg = caller_arg()) {
   check_atomic(x, arg)
   asserter <- function(x) is.null(x) || is_unit_set(x)
   check_type(x, asserter, "a single element vector", arg)
 }
 
-check_atomic <- function(x, arg = caller_arg(x)) {
+check_atomic <- function(x, arg = caller_arg()) {
   asserter <- function(x) is.null(x) || is.atomic(x)
   check_type(x, asserter, "an atomic vector", arg)
 }
 
-check_named <- function(x, arg = caller_arg(x)) {
+check_named <- function(x, arg = caller_arg()) {
   if (is_named(x)) {
     return(invisible())
   }
@@ -156,7 +156,7 @@ check_invalid_vars <- function(x, allowed, arg) {
   abort("Invalid placeholder `:%s` found in `%s`.", not_allowed, arg)
 }
 
-check_option_bib <- function(x, arg = caller_arg(x)) {
+check_option_bib <- function(x, arg = caller_arg()) {
   asserter <- function(x) is.numeric(x) || is_string(x)
   check_type(x, asserter, "a numeric value or a string", arg)
 }
@@ -183,7 +183,7 @@ check_bib_target <- function(x) {
   abort("`%s.bib` doesn't exist in the bibliography list.", x)
 }
 
-check_bib <- function(x, arg = caller_arg(x)) {
+check_bib <- function(x, arg = caller_arg()) {
   check_type(x, is_bib, "a `.bib` file", arg)
 }
 

R/pakret.R

@@ -11,7 +11,7 @@ collapse <- function(x) {
 }
 
 bib_name <- function(x) {
-  sub("\\.bib$", "", basename(x))
+  sub("(?i)\\.bib$", "", basename(x))
 }
 
 extract <- function(x, pattern) {

R/pkrt-list.R

@@ -23,7 +23,7 @@
 #' @export
 pkrt_list <- function(...) {
   pkgs <- unique(c(...))
-  check_character(pkgs)
+  check_character(pkgs, arg = "...")
   pkgs <- drop_base(pkgs)
   itemize_citations(pkgs)
 }

R/pkrt.R

@@ -4,14 +4,14 @@
 #'   in which case `pkrt()` automatically references the cited package in the
 #'   first (by default) `.bib` file specified in the YAML header if no
 #'   references of the package already exist.
-#' @param x A string of the package to cite.
+#' @param pkg A string of the package to cite.
 #' @returns A character string.
 #' @examples
 #' pkrt("pakret")
 #'
 #' pkrt("R")
 #' @export
-pkrt <- function(x) {
-  check_character(x)
-  cite(as_pkg(x))
+pkrt <- function(pkg) {
+  check_character(pkg)
+  cite(as_pkg(pkg))
 }

R/utils-local.R

@@ -71,8 +71,7 @@ local_pkg <- function(Package, ..., bib_entries = NULL, env = parent.frame()) {
   if (!is.null(bib_entries)) {
     add_bib_entries(pkg_path, bib_entries)
   }
-  pkgload::load_all(pkg_path, export_all = FALSE, quiet = TRUE)
-  withr::defer(pkgload::unload(Package, quiet = TRUE), envir = env)
+  load_pkg(pkg_path, env)
 }
 
 add_bib_entries <- function(dir, types) {
@@ -104,6 +103,11 @@ bib_field <- function(name) {
   sprintf('%s = "%s"', name, name)
 }
 
+load_pkg <- function(path, env) {
+  withr::defer(pkgload::unload(basename(path), quiet = TRUE), envir = env)
+  pkgload::load_all(path, export_all = FALSE, quiet = TRUE)
+}
+
 load_foo <- function(..., env = parent.frame()) {
   local_pkg(
     Package = "foo",

tests/testthat/_snaps/pkrt-list.md

@@ -32,5 +32,5 @@
       pkrt_list(1)
     Condition
       Error:
-      ! `pkgs` must be a character vector.
+      ! `...` must be a character vector.
 

tests/testthat/_snaps/pkrt.md

@@ -54,7 +54,7 @@
     Code
       (expect_error(pkrt(1)))
     Output
-      <simpleError: `x` must be a character vector.>
+      <simpleError: `pkg` must be a character vector.>
     Code
       (expect_error(pkrt("a")))
     Output