Skip to content
This repository has been archived by the owner on Mar 27, 2019. It is now read-only.

Add an argufy_package function #5

Merged
merged 5 commits into from
Aug 11, 2015
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -9,4 +9,5 @@ LazyData: true
URL: https://github.com/gaborcsardi/argufy
BugReports: https://github.com/gaborcsardi/argufy/issues
Suggests:
testthat
testthat,
disposables
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
# Generated by roxygen2 (4.1.1): do not edit by hand

export(argufy)
export(argufy_package)
export(as_enum)
46 changes: 46 additions & 0 deletions R/argufy_package.R
Original file line number Diff line number Diff line change
@@ -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([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, ...)
})
}
15 changes: 15 additions & 0 deletions R/package.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Btw. I think it is nice to have independent changes like this and the next chunk in a separate commit.

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Also, this is not quite good, because attr(, "srcref") is copied as well, and it is used for printing the (new) function. I am not entirely sure what to do with this, though. If we don't copy, then the new function will have no srcref, which might be a problem sometimes, no? But we also do not want to reparse the function....

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That is true. In some respects the srcref version is more useful interactively, because the function definition is not cluttered by the additional checking code (which will become a larger problem when inlining functions (#6)). On the other hand the printed function is not exactly what is called by R, which may make things confusing.

It is possible to view the real source with print(fun, useSource = FALSE) even with the copied srcref.

The only downside to not having a srcref at all is that you lose comments and formatting, because R then simply prints the parsed expressions, it shouldn't actually cause any errors anywhere though.

I personally would lean towards leaving the srcref copied as it is, but if you feel it is confusing simply dropping that attribute shouldn't cause any problems.

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If the code can be printed easily then it is fine as it is now. I'll just add it to the docs. This confused me until I debugged argufy(), because it did not seem to do anything. :)

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Agreed I was confused as well, easy way to see the real function definition
is body(fun) or print(fun, useSource = FALSE)

On Tue, Aug 11, 2015 at 4:41 PM, Gábor Csárdi [email protected]
wrote:

In R/package.R
#5 (comment):

@@ -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)

If the code can be printed easily then it is fine as it is now. I'll just
add it to the docs. This confused me until I debugged argufy(), because
it did not seem to do anything. :)


Reply to this email directly or view it on GitHub
https://github.com/gaborcsardi/argufy/pull/5/files#r36795931.

fmls <- formals(fun)

# modify any formals specified in dots
Expand All @@ -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
}

Expand Down Expand Up @@ -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))
Expand Down
19 changes: 19 additions & 0 deletions man/argufy_package.Rd
Original file line number Diff line number Diff line change
@@ -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()}.
}

62 changes: 62 additions & 0 deletions tests/testthat/test-argufy_package.R
Original file line number Diff line number Diff line change
@@ -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)
})
3 changes: 1 addition & 2 deletions tests/testthat/test-coercions.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@

context("")
context("coercions")

test_that("as_enum works", {

Expand Down