From 89e9d420c3f3048b7e1490b6799e307b481b0fa4 Mon Sep 17 00:00:00 2001 From: Sebastian Warnholz Date: Sun, 19 Jul 2020 14:35:40 +0200 Subject: [PATCH 1/7] first draft --- .Rbuildignore | 4 +++- .gitignore | 2 ++ DESCRIPTION | 3 +-- R/export.R | 33 ++++++++++++++++----------- R/module-helper.R | 9 +++++++- tests/testthat/test-depend.R | 10 ++++----- tests/testthat/test-export.R | 20 ++++++++--------- tests/testthat/test-import.R | 43 ------------------------------------ tests/testthat/test-lintr.R | 4 ++-- 9 files changed, 51 insertions(+), 77 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 06cc70d..47eefe3 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -5,4 +5,6 @@ ^\.travis\.yml$ ^cran-comments\.md$ ^\.projectile$ -^\.github$ \ No newline at end of file +^\.github$ +^doc$ +^Meta$ diff --git a/.gitignore b/.gitignore index 05491fb..e940145 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,5 @@ inst/doc vignettes/*.R vignettes/*.html +doc +Meta diff --git a/DESCRIPTION b/DESCRIPTION index eb887f7..abf3eac 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,14 +17,13 @@ License: MIT + file LICENSE Encoding: UTF-8 LazyData: true Suggests: - disposables, testthat, devtools, knitr, lintr, rmarkdown, parallel -RoxygenNote: 6.1.1 +RoxygenNote: 7.1.0 Collate: 'amodule.R' 'NAMESPACE.R' diff --git a/R/export.R b/R/export.R index 2cb1f1b..de62d85 100644 --- a/R/export.R +++ b/R/export.R @@ -58,22 +58,29 @@ exportGetCurrentValue <- function(envir) { get(exportNameWithinModule(), envir = envir) } +exportExtract2List <- function(envir) { + exports <- exportResolveFinalValue(envir) + objectsAndNames <- Map(exportExtractElement(envir), exports, names(exports)) + module <- lapply(objectsAndNames, function(x) x$object) + names(module) <- vapply(objectsAndNames, function(x) x$name, character(1)) + duplicateNames <- names(module)[duplicated(names(module))] + if (length(duplicateNames) > 0) warning("Found duplicate names in exports!") + module +} + exportResolveFinalValue <- function(envir) { isRegEx <- function(s) length(s) == 1 && grepl("^\\^", s) exports <- exportGetCurrentValue(envir) - if (isRegEx(exports)) ls(envir, pattern = exports) - else exports + if (isRegEx(exports)) exports <- ls(envir, pattern = exports) + if (is.null(names(exports))) names(exports) <- rep("", length(exports)) + exports } -exportExtract2List <- function(envir) { - objectsToExport <- exportResolveFinalValue(envir) - module <- as.list(envir) - if (any(ind <- !objectsToExport %in% names(module))) { - stop( - "exports not defined: ", - paste(objectsToExport[ind], collapse = ", ") - ) - } else { - module[objectsToExport] - } +exportExtractElement <- function(where) function(element, name) { + name <- if (name == "") element else name + object <- tryCatch( + eval(parse(text = element), where, baseenv()), + error = function(e) stop(call. = FALSE, sprintf( + "unable to resolve export: %s\nfailed with\n%s", name, e))) + list(name = name, object = object) } diff --git a/R/module-helper.R b/R/module-helper.R index c0e06ff..6b73f82 100644 --- a/R/module-helper.R +++ b/R/module-helper.R @@ -9,7 +9,14 @@ deparseEllipsis <- function(mc, exclude) { } deleteQuotes <- function(x) { - gsub("\\\"|\\\'", "", x) + res <- vapply( + x, FUN.VALUE = character(1), + function(e) { + if (grepl("^[\\\"\\\'].*[\\\"\\\']$", e)) gsub("\\\"|\\\'", "", e) + else e + }) + if (is.null(names(x))) names(res) <- NULL + res } addDependency <- function(from, what, where, assignFun, name) { diff --git a/tests/testthat/test-depend.R b/tests/testthat/test-depend.R index 14048ae..ed0e5c7 100644 --- a/tests/testthat/test-depend.R +++ b/tests/testthat/test-depend.R @@ -2,9 +2,9 @@ testthat::test_that("Packages are installed", { testthat::skip_on_cran() testthat::skip_on_ci() testthat::skip_on_travis() - try(utils::remove.packages("disposables")) - modules::depend("disposables", "1.0.3", repos = "https://cloud.r-project.org") - testthat::expect_true(require("disposables")) + try(utils::remove.packages("knitr")) + modules::depend("knitr", "1.0.3", repos = "https://cloud.r-project.org") + testthat::expect_true(require("knitr")) }) testthat::test_that("Throw errors", { @@ -15,7 +15,7 @@ testthat::test_that("Throw errors", { testthat::expect_is(suppressWarnings( tmp <- try(modules::depend( - "disposables", "999", + "knitr", "999", repos = "https://cloud.r-project.org"), TRUE) ), "try-error") @@ -23,7 +23,7 @@ testthat::test_that("Throw errors", { testthat::expect_is(suppressWarnings( tmp <- try(modules::depend( - "disposables999", "999", + "knitr999", "999", repos = "https://cloud.r-project.org"), TRUE) ), "try-error") diff --git a/tests/testthat/test-export.R b/tests/testthat/test-export.R index bec551a..4e16839 100644 --- a/tests/testthat/test-export.R +++ b/tests/testthat/test-export.R @@ -7,8 +7,8 @@ test_that("Exports of module", { }) - expect_true(all(c("fun", "pFun") %in% names(m))) - expect_true(!(".fun" %in% names(m))) + testthat::expect_true(all(c("fun", "pFun") %in% names(m))) + testthat::expect_true(!(".fun" %in% names(m))) m <- module({ @@ -20,9 +20,9 @@ test_that("Exports of module", { }) - expect_true("fun" %in% names(m)) - expect_true(!(".fun" %in% names(m))) - expect_true(!("pFun" %in% names(m))) + testthat::expect_true("fun" %in% names(m)) + testthat::expect_true(!(".fun" %in% names(m))) + testthat::expect_true(!("pFun" %in% names(m))) m <- module({ @@ -34,8 +34,8 @@ test_that("Exports of module", { }) - expect_true(all(c("fun", "pFun") %in% names(m))) - expect_true(!(".fun" %in% names(m))) + testthat::expect_true(all(c("fun", "pFun") %in% names(m))) + testthat::expect_true(!(".fun" %in% names(m))) m <- module({ @@ -48,8 +48,8 @@ test_that("Exports of module", { }) - expect_true(all(c("fun", "pFun") %in% names(m))) - expect_true(!(".fun" %in% names(m))) + testthat::expect_true(all(c("fun", "pFun") %in% names(m))) + testthat::expect_true(!(".fun" %in% names(m))) }) @@ -59,6 +59,6 @@ test_that("Produce an error when 'export' is not available", { modules::export("fun", "fun1", "fun2") fun <- function(x) x }), - "exports not defined: fun1, fun2" + "unable to resolve export: fun1" ) }) diff --git a/tests/testthat/test-import.R b/tests/testthat/test-import.R index 8ed67f4..32c6961 100644 --- a/tests/testthat/test-import.R +++ b/tests/testthat/test-import.R @@ -58,49 +58,6 @@ test_that("package dependencies", { }) -test_that("cross package deps", { - ## We skip this test on remote because it produces errors on fedora and debian - ## and CI. I cannot reproduce these errors on local ubuntu. - testthat::skip_on_cran() - testthat::skip_on_ci() - testthat::skip_on_travis() - if (requireNamespace("disposables", quietly = TRUE)) { - disposables::make_packages( - - imports = "modules", - - M1 = { - m1 <- module({ - fun <- function(x) x - }) - }, - - M2 = { - m2 <- module({ - import(M1, m1) - newFun <- function(...) m1$fun(...) - }) - } - - ) - - m1 <- module( - topEncl = baseenv(), - fun <- function(x) x - ) - - expect_equal( - environmentName(parent.env(parent.env(environment(M1::m1$fun)))), - "M1" - ) - - expect_equal( - environmentName(parent.env(parent.env(environment(m1$fun)))), - "base" - )} - -}) - test_that("duplications on search path", { expectEqual <- function(a, b) { diff --git a/tests/testthat/test-lintr.R b/tests/testthat/test-lintr.R index aa20463..cc429ee 100644 --- a/tests/testthat/test-lintr.R +++ b/tests/testthat/test-lintr.R @@ -15,8 +15,8 @@ test_that("Package Style", { j = lintr::trailing_blank_lines_linter, k = lintr::trailing_whitespace_linter, l = lintr::open_curly_linter, - m = lintr::multiple_dots_linter, + m = lintr::object_name_linter(c("CamelCase", "camelCase", "dotted.case")), n = lintr::closed_curly_linter )) - } + } }) From 791182419c6b5e0dd8adbbe2300a34629a4a3d17 Mon Sep 17 00:00:00 2001 From: Sebastian Warnholz Date: Sun, 19 Jul 2020 15:56:13 +0200 Subject: [PATCH 2/7] function objects in do.call --- R/module-helper.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/module-helper.R b/R/module-helper.R index 6b73f82..ec51d8f 100644 --- a/R/module-helper.R +++ b/R/module-helper.R @@ -4,6 +4,7 @@ deparseEllipsis <- function(mc, exclude) { args <- Map(deparse, mc) args[[1]] <- NULL args[exclude] <- NULL + args <- lapply(args, paste0, collapse = "\n") args <- unlist(args) deleteQuotes(args) } From ea867d28311ba9b41baaec521116798d91657175 Mon Sep 17 00:00:00 2001 From: Sebastian Warnholz Date: Fri, 2 Oct 2020 22:03:30 +0200 Subject: [PATCH 3/7] tests examples and warning --- R/export.R | 29 ++++++++++++++++++++++++++++- tests/testthat/test-export.R | 36 ++++++++++++++++++++++++++++++++++++ 2 files changed, 64 insertions(+), 1 deletion(-) diff --git a/R/export.R b/R/export.R index de62d85..5065e7d 100644 --- a/R/export.R +++ b/R/export.R @@ -6,7 +6,7 @@ #' #' @param ... (character, or unquoted expression) names to export from module. A #' character of length 1 with a leading "^" is interpreted as regular -#' expression. +#' expression. Arguments can be named and used for renaming exports. #' @param where (environment) typically the calling environment. Should only be #' relevant for testing. #' @@ -41,9 +41,15 @@ #' foo <- function() "foo" #' bar <- function() "bar" #' }) +#' +#' module({ +#' export(bar = foo) +#' foo <- function() "foo" +#' }) #' #' @export export <- function(..., where = parent.frame()) { + exportWarnOnNonStandardCalls(match.call()) objectsToExport <- deparseEllipsis(match.call(), "where") currentExports <- exportGetCurrentValue(where) currentExports <- currentExports[currentExports != "^*"] @@ -52,6 +58,27 @@ export <- function(..., where = parent.frame()) { invisible(NULL) } +exportWarnOnNonStandardCalls <- function(call) { + # exporting with do.call is not working properly, so we throw a warning, in + # case we can detect it. Consider the following examples: + # m <- module({ + # sm <- module({ + # x <- 1 + # fun <- function() x + # }) + # do.call(export, list(fun = sm$fun)) + # }) + # It will not work, although `export(fun = sm$fun)` does work as expected. + # This is extremely difficult to dubug and it seems to be better to turn it + # off until someone can fix it. + if (length(deparse(call[[1]])) > 1) warning( + "Detected a non standard call to export. The export function relies heavily ", + "on non standard evaluation and may not work as expected combined with 'do.call' ", + "or 'lapply'. See the docs and https://github.com/wahani/modules/issues/19 for ", + "a discussion." + ) +} + exportNameWithinModule <- function() ".__exports__" exportGetCurrentValue <- function(envir) { diff --git a/tests/testthat/test-export.R b/tests/testthat/test-export.R index 4e16839..c81d418 100644 --- a/tests/testthat/test-export.R +++ b/tests/testthat/test-export.R @@ -62,3 +62,39 @@ test_that("Produce an error when 'export' is not available", { "unable to resolve export: fun1" ) }) + +test_that("Rename exports", { + m <- modules::module({ + export( + foo, + a = foo, + b = "foo", + c = function() foo() + ) + foo <- function() "foo" + }) + testthat::expect_equal(m$foo(), "foo") + testthat::expect_equal(m$a(), "foo") + testthat::expect_equal(m$b(), "foo") + testthat::expect_equal(m$c(), "foo") +}) + +test_that("Warning on duplicate names", { + testthat::expect_warning( + modules::module({ + export(foo, "foo") + foo <- function() "foo" + }), + "duplicate names in exports" + ) +}) + +test_that("Warn with do.call", { + testthat::expect_warning( + modules::module({ + do.call(export, list("foo")) + foo <- function() "foo" + }), + "non standard call to export" + ) +}) From 7d6a76d7bb128c6586510a42b96fa29c6c272775 Mon Sep 17 00:00:00 2001 From: Sebastian Warnholz Date: Fri, 2 Oct 2020 22:25:05 +0200 Subject: [PATCH 4/7] one more test description + news --- DESCRIPTION | 2 +- NEWS | 1 + tests/testthat/test-export.R | 8 ++++++++ 3 files changed, 10 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index abf3eac..e42d60e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: modules Title: Self Contained Units of Source Code -Version: 0.8.1 +Version: 0.8.2 Authors@R: person("Sebastian", "Warnholz", email = "wahani@gmail.com", role = c("aut", "cre")) Description: Provides modules as an organizational unit for source code. Modules enforce to be more rigorous when defining dependencies and have diff --git a/NEWS b/NEWS index 1ac0c51..54818f6 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,7 @@ Version 0.9.0 - Bugfix from issue #16 on Github: extend a module which has been loaded from a file now actually works +- Extending the export mechanism to allow for renaming: see #19 Version 0.8.0 - CRAN release diff --git a/tests/testthat/test-export.R b/tests/testthat/test-export.R index c81d418..178d48c 100644 --- a/tests/testthat/test-export.R +++ b/tests/testthat/test-export.R @@ -79,6 +79,14 @@ test_that("Rename exports", { testthat::expect_equal(m$c(), "foo") }) +test_that("Export .names", { + m <- modules::module({ + export(.foo = foo) + foo <- function() "foo" + }) + testthat::expect_equal(m$.foo(), "foo") +}) + test_that("Warning on duplicate names", { testthat::expect_warning( modules::module({ From d5fc6dd818e3288b3e72146e99cef471e003b2af Mon Sep 17 00:00:00 2001 From: Sebastian Warnholz Date: Fri, 2 Oct 2020 23:58:28 +0200 Subject: [PATCH 5/7] fixing lint --- R/export.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/export.R b/R/export.R index 5065e7d..f1be003 100644 --- a/R/export.R +++ b/R/export.R @@ -41,7 +41,7 @@ #' foo <- function() "foo" #' bar <- function() "bar" #' }) -#' +#' #' module({ #' export(bar = foo) #' foo <- function() "foo" From 8a155fd7e5dbe4b74db1016899be85225ca81a16 Mon Sep 17 00:00:00 2001 From: Sebastian Warnholz Date: Wed, 28 Oct 2020 08:02:04 +0100 Subject: [PATCH 6/7] import datasets --- NAMESPACE | 1 + R/NAMESPACE.R | 2 +- R/import.R | 10 +++++++++- man/amodule.Rd | 4 ++-- man/export.Rd | 7 ++++++- man/module.Rd | 4 ++-- man/modulecoerce.Rd | 3 +-- man/use.Rd | 3 +-- tests/testthat/test-import.R | 19 +++++++++++++++++++ 9 files changed, 42 insertions(+), 11 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a1ae764..780b203 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ export(getSearchPathNames) export(import) export(module) export(use) +importFrom(utils,data) importFrom(utils,download.file) importFrom(utils,install.packages) importFrom(utils,installed.packages) diff --git a/R/NAMESPACE.R b/R/NAMESPACE.R index 890c758..f637d76 100644 --- a/R/NAMESPACE.R +++ b/R/NAMESPACE.R @@ -1,4 +1,4 @@ -#' @importFrom utils download.file install.packages installed.packages +#' @importFrom utils data download.file install.packages installed.packages #' packageVersion str NULL diff --git a/R/import.R b/R/import.R index 4bb7ad1..96201aa 100644 --- a/R/import.R +++ b/R/import.R @@ -74,7 +74,7 @@ importCheckInstall <- function(pkg) { importGetSelection <- function(mc, pkg) { objectsToImport <- importDeparseEllipses(mc) - if (length(objectsToImport) == 0) getNamespaceExports(pkg) + if (length(objectsToImport) == 0) importGetNamespaceExports(pkg) else objectsToImport } @@ -87,3 +87,11 @@ importDeparseEllipses <- function(mc) { args <- unlist(args) deleteQuotes(args) } + +importGetNamespaceExports <- function(pkg) { + nsExports <- getNamespaceExports(pkg) + nsDatasets <- data(package = pkg) + nsDatasets <- nsDatasets$results[, "Item"] + nsDatasets <- gsub(" .*", "", nsDatasets) + c(nsExports, nsDatasets) +} diff --git a/man/amodule.Rd b/man/amodule.Rd index c0d4afd..87a8423 100644 --- a/man/amodule.Rd +++ b/man/amodule.Rd @@ -4,8 +4,8 @@ \alias{amodule} \title{Define Augmented and Parameterized Modules} \usage{ -amodule(expr = { }, envir = parent.frame(), enclos = baseenv(), - class = NULL) +amodule(expr = { +}, envir = parent.frame(), enclos = baseenv(), class = NULL) } \arguments{ \item{expr}{(expression) a module declaration, same as \link{module}} diff --git a/man/export.Rd b/man/export.Rd index 5953074..4350562 100644 --- a/man/export.Rd +++ b/man/export.Rd @@ -9,7 +9,7 @@ export(..., where = parent.frame()) \arguments{ \item{...}{(character, or unquoted expression) names to export from module. A character of length 1 with a leading "^" is interpreted as regular -expression.} +expression. Arguments can be named and used for renaming exports.} \item{where}{(environment) typically the calling environment. Should only be relevant for testing.} @@ -52,4 +52,9 @@ module({ bar <- function() "bar" }) +module({ + export(bar = foo) + foo <- function() "foo" +}) + } diff --git a/man/module.Rd b/man/module.Rd index f523b75..bc218e3 100644 --- a/man/module.Rd +++ b/man/module.Rd @@ -5,8 +5,8 @@ \alias{autoTopEncl} \title{Define Modules in R} \usage{ -module(expr = { }, topEncl = autoTopEncl(envir), - envir = parent.frame()) +module(expr = { +}, topEncl = autoTopEncl(envir), envir = parent.frame()) autoTopEncl(where) } diff --git a/man/modulecoerce.Rd b/man/modulecoerce.Rd index 9361a71..83d1c15 100644 --- a/man/modulecoerce.Rd +++ b/man/modulecoerce.Rd @@ -8,8 +8,7 @@ \usage{ as.module(x, ...) -\method{as.module}{character}(x, topEncl = baseenv(), reInit = TRUE, - ..., envir = parent.frame()) +\method{as.module}{character}(x, topEncl = baseenv(), reInit = TRUE, ..., envir = parent.frame()) \method{as.module}{module}(x, reInit = TRUE, ...) } diff --git a/man/use.Rd b/man/use.Rd index 1bdfa4a..b64373b 100644 --- a/man/use.Rd +++ b/man/use.Rd @@ -4,8 +4,7 @@ \alias{use} \title{Use a module as dependency} \usage{ -use(module, ..., attach = FALSE, reInit = TRUE, - where = parent.frame()) +use(module, ..., attach = FALSE, reInit = TRUE, where = parent.frame()) } \arguments{ \item{module}{(character, module) a file or folder name, or an object that diff --git a/tests/testthat/test-import.R b/tests/testthat/test-import.R index 32c6961..24f7ac8 100644 --- a/tests/testthat/test-import.R +++ b/tests/testthat/test-import.R @@ -1,3 +1,22 @@ +test_that("Import of datasets: #29", { + # import all datasets from a package + m <- module({ + import("datasets") + getIris <- function() iris + }) + data("iris", envir = environment()) + expect_equal(m$getIris(), iris) + expect_true("iris" %in% getSearchPathContent(m)[["modules:datasets"]]) + # import just one dataset, like any other object + m <- module({ + import("datasets", "iris") + getIris <- function() iris + }) + data("iris", envir = environment()) + expect_equal(m$getIris(), iris) + expect_true("iris" %in% getSearchPathContent(m)[["modules:datasets"]]) +}) + test_that("Imports of module", { # import and related functions are part of the parent scope. Not the module # itself. From 2f84f11257620923b631bda9299ad6ad2d4d1e96 Mon Sep 17 00:00:00 2001 From: Sebastian Warnholz Date: Wed, 28 Oct 2020 08:06:19 +0100 Subject: [PATCH 7/7] version buff --- DESCRIPTION | 2 +- NEWS | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c204215..9331e81 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: modules Title: Self Contained Units of Source Code -Version: 0.8.3 +Version: 0.8.4 Authors@R: person("Sebastian", "Warnholz", email = "wahani@gmail.com", role = c("aut", "cre")) Description: Provides modules as an organizational unit for source code. Modules enforce to be more rigorous when defining dependencies and have diff --git a/NEWS b/NEWS index 2339beb..4713352 100644 --- a/NEWS +++ b/NEWS @@ -2,7 +2,8 @@ Version 0.9.0 - Bugfix from issue #16 on Github: extend a module which has been loaded from a file now actually works - Extending the export mechanism to allow for renaming: see #19 -- Reattaching a module in the .GlobalEnv now actually works. See #24. +- Reattaching a module in the .GlobalEnv now actually works. See #24 +- Importing a complete package now also imports datasets. See #29 Version 0.8.0 - CRAN release