Add an argufy_package function

NAMESPACE

@@ -1,4 +1,5 @@
 # Generated by roxygen2 (4.1.1): do not edit by hand
 
 export(argufy)
+export(argufy_package)
 export(as_enum)

R/argufy_package.R

@@ -0,0 +1,46 @@
+#' argufy all of the functions within a package
+#'
+#' This function is best placed either in the last file sourced (\code{zzz.R}
+#' or the last file listed in the collate directive) or in \code{.onLoad()}.
+#' @inheritParams argufy
+#' @param package the package to argufy
+#' @export
+argufy_package <- function(env = parent.frame(), ...) {
+  if (is.character(env)) {
+    env <- asNamespace(env)
+  }
+
+  argufy_environment(env, ...)
+
+  argufy_S4(env, ...)
+
+  invisible()
+}
+
+argufy_environment <- function(ns, ...) {
+  nms <- ls(ns, all.names = TRUE)
+
+  funs <- mget(nms, ns, mode = "function", ifnotfound = NA)
+
+  funs <- funs[!is.na(funs)]
+
+  Map (function(nme, fun) {
+    fun <- argufy(fun, ...)
+    assign(nme, fun, envir = ns)
+  }, names(funs), funs)
+
+  invisible()
+}
+
+argufy_S4 <- function(ns, ...) {
+  generics <- getGenerics(ns)
+
+  Map([email protected], generics@package, USE.NAMES = FALSE,
+      f = function(name, package) {
+        what <- methodsPackageMetaName("T", paste(name, package, sep = ":"))
+
+        table <- get(what, envir = ns)
+
+        argufy_environment(table, ...)
+      })
+}

R/package.R

@@ -50,6 +50,10 @@
 argufy <- function(fun, ...) {
   if (!is.function(fun)) stop("'fun' must be a function")
 
+  # these statements are needed to get S4 functions to work properly
+  was_s4 <- isS4(fun)
+  old_attributes <- attributes(fun)
+
   fmls <- formals(fun)
 
   # modify any formals specified in dots
@@ -64,6 +68,13 @@ argufy <- function(fun, ...) {
   ## Add the checks to the body of the function
   fun <- add_checks(fun, checks)
 
+  # S4 functions have additional attributes which need to be set, regular
+  # functions do not have attributes so nothing is done.
+  if (was_s4) {
+    fun <- asS4(fun)
+  }
+  attributes(fun) <- old_attributes
+
   fun
 }
 
@@ -171,6 +182,10 @@ add_checks <- function(fun, checks) {
 
   check_expr <- create_check_expr(checks)
 
+  if (length(check_expr) <= 1) {
+    return(fun)
+  }
+
   new_body <- substitute(
     { `_check_`; `_body_` },
     list("_check_" = check_expr, "_body_" = body(fun))

man/argufy_package.Rd

@@ -0,0 +1,19 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/argufy_package.R
+\name{argufy_package}
+\alias{argufy_package}
+\title{argufy all of the functions within a package}
+\usage{
+argufy_package(env = parent.frame(), ...)
+}
+\arguments{
+\item{...}{Function arguments to modify, this allows you to argufy existing
+function definitions.}
+
+\item{package}{the package to argufy}
+}
+\description{
+This function is best placed either in the last file sourced (\code{zzz.R}
+or the last file listed in the collate directive) or in \code{.onLoad()}.
+}
+

tests/testthat/TestS4/DESCRIPTION

@@ -0,0 +1,9 @@
+Package: TestS4
+Title: What the Package Does (one line, title case)
+Version: 0.0.0.9000
+Authors@R: person("Jim", "Hester", email = "[email protected]", role = c("aut", "cre"))
+Description: What the package does (one paragraph).
+Depends: R (>= 3.3.0)
+License: MIT + file LICENSE
+LazyData: true
+Suggests: argufy

tests/testthat/TestS4/NAMESPACE

@@ -0,0 +1 @@
+exportPattern("^[^\\.]")

tests/testthat/TestS4/R/package.R

@@ -0,0 +1,33 @@
+#' an example function
+#'
+#' @export
+a <- function(x = ~ is.numeric) {
+  if (x) {
+    1
+  } else {
+    2
+  }
+}
+
+#' @export
+TestS4 <- setClass("TestS4",
+  slots = list(name = "character", enabled = "logical"))
+
+#' @export
+setGeneric("paste2", function(x = ~ is.character, y) {
+   standardGeneric("paste2")
+  })
+
+setMethod("paste2",
+  signature(x = "character", y = "missing"),
+  function(x) {
+    paste(x)
+  })
+
+setMethod("paste2",
+  c(x = "character", y = "ANY"),
+  function(x, y = ~ is.character) {
+    paste(x, y)
+  })
+
+argufy:::argufy_package("TestS4")

tests/testthat/test-argufy_package.R

@@ -0,0 +1,32 @@
+{
+  temp_lib <- file.path(tempdir(), "lib")
+
+  old <- .libPaths()
+  .libPaths(temp_lib)
+  on.exit(.libPaths(old))
+  tools:::.install_packages("TestS4")
+
+  context("argufy_package")
+  test_that("argufy_package works with simple functions", {
+
+    expect_equal(TestS4::a(0), 2)
+
+    expect_equal(TestS4::a(1), 1)
+
+    expect_error(TestS4::a("a"), "is.numeric\\(x\\) is not TRUE")
+  })
+
+  test_that("argufy_package works with S4 generics and methods", {
+
+    expect_equal(TestS4::paste2("a"), "a")
+
+    expect_equal(TestS4::paste2("a", "b"), "a b")
+
+    # argufy set on generic
+    expect_error(TestS4::paste2(1), "is.character\\(x\\) is not TRUE")
+
+    # argufy set on method
+    expect_error(TestS4::paste2("a", 1), "is.character\\(y\\) is not TRUE")
+  })
+
+}

tests/testthat/test-coercions.R

@@ -1,5 +1,4 @@
-
-context("")
+context("coercions")
 
 test_that("as_enum works", {