Merge pull request #282 from PredictiveEcology/newModuleUseGetPaths

newModule --> Allow use of getPaths()$modulePath if not specified

DESCRIPTION

@@ -15,7 +15,7 @@ URL:
     https://spades-core.predictiveecology.org/,
     https://github.com/PredictiveEcology/SpaDES.core
 Date: 2024-06-03
-Version: 2.1.0.9003
+Version: 2.1.0.9004
 Authors@R: c(
     person("Alex M", "Chubaty", , "achubaty@for-cast.ca", role = c("aut"),
            comment = c(ORCID = "0000-0001-7146-8135")),

NAMESPACE

@@ -195,10 +195,13 @@ export(sessInfo)
 export(setPaths)
 export(simFile)
 export(simInit)
+export(simInit2)
 export(simInitAndExperiment)
 export(simInitAndSpades)
+export(simInitAndSpades2)
 export(simInitDefaults)
 export(spades)
+export(spades2)
 export(spadesOptions)
 export(spadesTimes)
 export(start)

R/module-repository.R

@@ -395,7 +395,9 @@ setMethod(
                 repo = "missing", data = "missing", quiet = "missing",
                 quickCheck = "ANY", overwrite = "ANY"),
   definition = function(name, quickCheck, overwrite) {
-    files <- downloadModule(name, path = getOption("spades.modulePath"),
+    path <- checkModulePath()
+
+    files <- downloadModule(name, path = path,
                             version = NA_character_,
                             repo = getOption("spades.moduleRepo",
                                              defaultGitRepoToSpaDESModules),

R/module-template.R

@@ -142,7 +142,7 @@ openIsRequested <- function(open, suff) {
 #'
 #'
 #'
-setGeneric("newModule", function(name, path, ..., events, envir = parent.frame()) {
+setGeneric("newModule", function(name, path, ..., events = NULL, envir = parent.frame()) {
   standardGeneric("newModule")
 })
 
@@ -154,7 +154,15 @@ setMethod(
   signature = c(name = "character", path = "character"),
   definition = function(name, path, ..., events, envir) {
     events <- substitute(events)
+
+    # This if for methods that passed to here
+    if (is.null(names(events)))
+      events <- eval(events, parent.frame())
+
     argsFull <- substitute(list(...))
+    # if (is.null(names(argsFull)))
+    #   argsFull <- eval(argsFull, parent.frame())
+
     argsNames <- ...names()
 
     simpleArgsHere <- intersect(argsNames, simpleArgs)
@@ -234,8 +242,13 @@ setMethod(
 setMethod(
   "newModule",
   signature = c(name = "character", path = "missing"),
-  definition = function(name, ..., events = list(), envir) {
-    newModule(name = name, path = ".", ..., events = events, envir = envir)
+  definition = function(name, ..., events = NULL, envir = parent.frame()) {
+
+    browser()
+    # Take "." if not set, but it could be set by user with setPaths(modulePath = ...)
+    path <- checkModulePath()
+    events <- substitute(events)
+    newModule(name = name, path = path, ..., events = events, envir = envir)
 })
 
 #' @return `newModuleCode` is invoked for its side effect of creating new module code files.
@@ -329,7 +342,7 @@ setMethod(
                                                     paste0("module", templ, ".R.template")))
     }
 
-    if (!missing(events)) {
+    if (!missing(events) && !is.null(events) && !(length(events) == 0)) {
       evs <- names(events)[nzchar(names(events))]
       ord <- c(evs, templs)
       if (length(evs)) {
@@ -373,21 +386,6 @@ setMethod(
       "## this is a parent module and as such does not have any events."
     }
 
-    # if (length(argsNames)) {
-    #
-    #   pp <- parse(text = moduleEvents)
-    #   doEvent <- grep("doEvent\\.", pp)
-    #   df <- deparse(as.list(argsFull)[[argsNames]])
-    #   # fn <- defineEventFnMaker(df)
-    #   eventFnName <-  makeEventFn(name, argsNames)
-    #   fn <- defineEventFnMaker(df, eventFnName)
-    #
-    #   pp[[doEvent]] <- fn
-    #   eventFnName <-  makeEventFn(name, argsNames)
-    #
-    #
-    # }
-
     moduleData <- list(
       authors = deparse(moduleDefaults[["authors"]], width.cutoff = 500),
       children = children_char,
@@ -526,7 +524,9 @@ setMethod(
 setMethod("newModuleDocumentation",
           signature = c(name = "character", path = "missing"),
           definition = function(name, ...) {
-            newModuleDocumentation(name = name, path = ".", ...)
+            path <- checkModulePath()
+
+            newModuleDocumentation(name = name, path = path, ...)
 })
 
 #' Use GitHub actions for automated module checking
@@ -696,7 +696,9 @@ setMethod(
 setMethod("openModules",
           signature = c(name = "missing", path = "missing"),
           definition = function() {
-            openModules(name = "all", path = ".")
+            path <- checkModulePath()
+
+            openModules(name = "all", path = path)
 })
 
 #' @export
@@ -712,14 +714,17 @@ setMethod("openModules",
 setMethod("openModules",
           signature = c(name = "character", path = "missing"),
           definition = function(name) {
-            openModules(name = name, path = ".")
+            path <- checkModulePath()
+
+            openModules(name = name, path = path)
 })
 
 #' @export
 #' @rdname openModules
 setMethod("openModules",
           signature = c(name = "simList", path = "missing"),
           definition = function(name) {
+
             mods <- unlist(modules(name))
             openModules(name = mods, path = modulePath(name))
 })
@@ -803,6 +808,8 @@ setMethod(
 setMethod("copyModule",
           signature = c(from = "character", to = "character", path = "missing"),
           definition = function(from, to, ...) {
+            path <- checkModulePath()
+
             copyModule(from, to, path = getOption("spades.modulePath"), ...)
 })
 
@@ -876,6 +883,8 @@ setMethod(
 setMethod("zipModule",
           signature = c(name = "character", path = "missing", version = "character"),
           definition = function(name, version, data, ...) {
+            path <- checkModulePath()
+
             zipModule(name = name, path = "..", version = version, data = data, ...)
 })
 
@@ -884,6 +893,8 @@ setMethod("zipModule",
 setMethod("zipModule",
           signature = c(name = "character", path = "missing", version = "missing"),
           definition = function(name, data, ...) {
+            path <- checkModulePath()
+
             zipModule(name = name, path = "..", data = data, ...)
 })
 
@@ -897,3 +908,17 @@ setMethod("zipModule",
 })
 
 simpleArgs <- c("children", "open", "type", "unitTests", "useGitHub")
+
+
+#' Uses "." if getPath not set
+#'
+#' Will compare default in spadesOptions to getPaths ... these will be same if use
+#' has not set them. For such case, use ".". They will be different if the user has
+#' used `setPaths`. If that is the case, then use `getPaths()[["modulePath"]]`
+checkModulePath <- function() {
+  gp <- getPaths()
+  mp1 <- normalizePath(gp[["modulePath"]], winslash = "/", mustWork = FALSE)
+  mp2 <- normalizePath(spadesOptions()[["spades.modulePath"]], winslash = "/", mustWork = FALSE)
+  path <- if (identical(mp1, mp2)) "." else gp[["modulePath"]]
+  path
+}

R/moduleMetadata.R

@@ -103,6 +103,8 @@ setMethod(
   "moduleMetadata",
   signature = c(sim = "missing", module = "character", path = "missing"),
   definition = function(module, defineModuleListItems) {
+    path <- checkModulePath()
+
     moduleMetadata(module = module, path = getOption("spades.modulePath"),
                    defineModuleListItems = defineModuleListItems)
 })
@@ -193,6 +195,8 @@ setMethod(
   "moduleVersion",
   signature = c(module = "character", path = "missing", sim = "missing", envir = "ANY"),
   definition = function(module, envir) {
+    path <- checkModulePath()
+
     moduleVersion(module = module, path = getOption("spades.modulePath"), envir = envir)
 })
 
@@ -202,6 +206,8 @@ setMethod(
   "moduleVersion",
   signature = c(module = "character", path = "missing", sim = "simList", envir = "ANY"),
   definition = function(module, sim, envir) {
+    path <- checkModulePath()
+
     v <- .parseModulePartial(sim = sim, modules = list(module),
                              defineModuleElement = "version", envir = envir) |>
       (function(x) x[[module]])()

R/simulation-simInit.R

@@ -1058,6 +1058,37 @@ setMethod(
     return(invisible(sim))
 })
 
+
+#' `simInit2` is a convenience wrapper for `do.call(simInit, listOfArgs)`,
+#' i.e., a user can pass a list of all the arguments.
+#'
+#' @export
+#' @rdname simInit
+#' @param l A list of arguments to passed to `simInit`.
+simInit2 <- function(l) {
+  do.call(simInit, l)
+}
+
+#' `spades2` is a convenience wrapper for `do.call(spades, listOfArgs)`,
+#' i.e., a user can pass a list of all the arguments.
+#'
+#' @export
+#' @rdname spades
+#' @param l A list of arguments to passed to `spades`.
+spades2 <- function(l) {
+  do.call(spades, l)
+}
+
+#' `simInitAndSpades2` is a convenience wrapper for `do.call(simInitAndSpades, listOfArgs)`,
+#' i.e., a user can pass a list of all the arguments.
+#'
+#' @export
+#' @rdname simInitAndSpades
+#' @param l A list of arguments to passed to `simInitAndSpades`.
+simInitAndSpades2 <- function(l) {
+  do.call(simInitAndSpades, l)
+}
+
 #' Call `simInit` and `spades` together
 #'
 #' These functions are convenience wrappers that may allow for more efficient caching.