Merge pull request #5 from jimhester/argufy_package

Add an argufy_package function

DESCRIPTION

@@ -9,4 +9,5 @@ LazyData: true
 URL: https://github.com/gaborcsardi/argufy
 BugReports: https://github.com/gaborcsardi/argufy/issues
 Suggests: 
-    testthat
+    testthat,
+    disposables

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 env the package environment 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(generics@.Data, 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{env}{the package environment to argufy}
+
+\item{...}{Function arguments to modify, this allows you to argufy existing
+function definitions.}
+}
+\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/test-argufy_package.R

@@ -0,0 +1,62 @@
+library(disposables)
+
+context("argufy_package")
+test_that("argufy_package works with simple functions", {
+  pkg <- make_packages(
+    simple = {
+      a <- function(x = ~ is.numeric) {
+        if (x) {
+          1
+        } else {
+          2
+        }
+      }
+
+      argufy::argufy_package()
+    })
+
+  expect_equal(a(0), 2)
+
+  expect_equal(a(1), 1)
+
+  expect_error(a("a"), "is.numeric\\(x\\) is not TRUE")
+
+  dispose_packages(pkg)
+})
+
+test_that("argufy_package works with S4 generics and methods", {
+
+  pkg <- make_packages(
+    TestS4 = {
+
+      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()
+    })
+
+  expect_equal(paste2("a"), "a")
+
+  expect_equal(paste2("a", "b"), "a b")
+
+  # argufy set on generic
+  expect_error(paste2(1), "is.character\\(x\\) is not TRUE")
+
+  # argufy set on method
+  expect_error(paste2("a", 1), "is.character\\(y\\) is not TRUE")
+
+  dispose_packages(pkg)
+})

tests/testthat/test-coercions.R

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