prep to move running of .inputObject (#72)

tests passing
PredictiveEcology · Sep 7, 2018 · ad7d136 · ad7d136
1 parent da205c4
commit ad7d136
Show file tree

Hide file tree

Showing 4 changed files with 115 additions and 92 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -11,6 +11,7 @@ version 0.2.2.9000
 
 ## bugfixes
 * resolved `.inputObjects()` name conflict (internal `.inputObjects` renamed to `._inputObjectsDF`; `.outputObjects` renamed to `._outputObjectsDF`)
+* module `.inputObjects` evaluated based on module load order (#72)
 
 version 0.2.2
 =============

diff --git a/R/code-checking.R b/R/code-checking.R
@@ -283,7 +283,8 @@ cantCodeCheckMessage <- ": line could not be checked "
   hasConflicts <- fg[fg %in% conflictingFnsSimple]
 
   # Can't code check:
-  allChecks <- list(simAssigns = simAssigns, simGets = simGets, returnsSim = returnsSim, assignToSim = assignToSim, fg = fg)
+  allChecks <- list(simAssigns = simAssigns, simGets = simGets,
+                    returnsSim = returnsSim, assignToSim = assignToSim, fg = fg)
   cantCodeCheck <- lapply(allChecks, function(xx) grepl(cantCodeCheckMessage, xx))
   anyCantCodeCheck <- unlist(lapply(cantCodeCheck, any))
   if (any(anyCantCodeCheck)) {

diff --git a/R/simulation-parseModule.R b/R/simulation-parseModule.R
@@ -178,7 +178,8 @@ setMethod(
         NULL
       }
 
-      if (!(m %in% prevNamedModules)) { # This is about duplicate named modules
+      # This is about duplicate named modules
+      if (!(m %in% prevNamedModules)) {
         filename <- paste(sim@paths[["modulePath"]], "/", m, "/", m, ".R", sep = "")
         tmp <- .parseConditional(envir = envir, filename = filename)
 
@@ -332,108 +333,23 @@ setMethod(
           parent_ids <- c(parent_ids, j)
         }
 
-        ## run .inputObjects() from each module file from each module, one at a time,
-        ## and remove it from the simList so next module won't rerun it.
-
-        # If user supplies the needed objects, then test whether all are supplied.
-        # If they are all supplied, then skip the .inputObjects code
-        cacheIt <- FALSE
-
-        allObjsProvided <- sim@depends@dependencies[[i]]@inputObjects[["objectName"]] %in%
-          userSuppliedObjNames
-        if (!all(allObjsProvided)) {
-          if (!is.null(sim@.envir[[m]][[".inputObjects"]])) {
-            list2env(objs[sim@depends@dependencies[[i]]@inputObjects[["objectName"]][allObjsProvided]], # nolint
-                     envir = sim@.envir)
-            a <- sim@params[[m]][[".useCache"]]
-            if (!is.null(a)) {
-              # user supplied values
-              if (".useCache" %in% names(list(...)[["params"]])) {
-                b <- list(...)[["params"]][[i]][[".useCache"]]
-                if (!is.null(b)) a <- b
-              }
-              #.useCache is a parameter
-              if (!identical(FALSE, a)) {
-                #.useCache is not FALSE
-                if (!isTRUE(a)) {
-                  #.useCache is not TRUE
-                  if (".inputObjects" %in% a) {
-                    cacheIt <- TRUE
-                  }
-                } else {
-                  cacheIt <- TRUE
-                }
-              }
-            }
-
-            if (cacheIt) {
-              message(crayon::green("Using or creating cached copy of .inputObjects for ",
-                                    m, sep = ""))
-              moduleSpecificInputObjects <- sim@depends@dependencies[[i]]@inputObjects[["objectName"]] # nolint
-
-              # ensure backwards compatibility with non-namespaced modules
-              if (doesntUseNamespacing) {
-                objectsToEvaluateForCaching <- c(grep(ls(sim@.envir, all.names = TRUE),
-                                                      pattern = m, value = TRUE),
-                                                 na.omit(moduleSpecificInputObjects))
-                .inputObjects <- sim@.envir[[".inputObjects"]]
-              } else {
-                # moduleSpecificObjs <- ls(sim@.envir[[m]], all.names = TRUE)
-                # moduleSpecificObjs <- paste(m, moduleSpecificObjs, sep = ":")
-                moduleSpecificObjs <- paste(m, ".inputObjects", sep = ":")
-                objectsToEvaluateForCaching <- c(moduleSpecificObjs)#,
-                                           #na.omit(moduleSpecificInputObjects))
-                .inputObjects <- sim@.envir[[m]][[".inputObjects"]]
-              }
-
-              args <- as.list(formals(.inputObjects))
-              env <- environment()
-              args <- lapply(args[unlist(lapply(args, function(x)
-                all(nzchar(x))))], eval, envir = env)
-              args[["sim"]] <- sim
-
-              ## This next line will make the Caching sensitive to userSuppliedObjs
-              ##  (which are already in the simList) or objects supplied by another module
-              inSimList <- suppliedElsewhere(moduleSpecificInputObjects, sim, where = "sim")
-              if (any(inSimList)) {
-                objectsToEvaluateForCaching <- c(objectsToEvaluateForCaching,
-                                                 moduleSpecificInputObjects[inSimList])
-              }
-
-              .inputObjects <- .getModuleInputObjects(sim, m)
-              sim <- Cache(FUN = do.call, .inputObjects, args,
-                           objects = objectsToEvaluateForCaching,
-                           notOlderThan = notOlderThan,
-                           outputObjects = moduleSpecificInputObjects,
-                           quick = getOption("reproducible.quick", FALSE),
-                           userTags = c(paste0("module:", m),
-                                        "eventType:.inputObjects",
-                                        "function:.inputObjects"))
-
-            } else {
-              message(crayon::green("Running .inputObjects for ", m, sep = ""))
-              .modifySearchPath(pkgs = sim@depends@dependencies[[i]]@reqdPkgs)
-
-              .inputObjects <- .getModuleInputObjects(sim, m)
-              sim <- .inputObjects(sim)
-            }
-          }
-        }
+        ## TODO: move this down after loadOrder computed
+        sim <- .runModuleInputObjects(sim, m, i, objs, notOlderThan, userSuppliedObjNames, ...)
 
         ## SECTION ON CODE SCANNING FOR POTENTIAL PROBLEMS
         opt <- getOption("spades.moduleCodeChecks")
         if (isTRUE(opt) || length(names(opt)) > 1) {
           # the code will always have magenta colour, which has an m
           codeCheckMsgsThisMod <- any(grepl(paste0("m", m, ":"), codeCheckMsgs))
           mess <- capture.output(type = "message", .runCodeChecks(sim, m, k, codeCheckMsgsThisMod))
-          if (length(mess) | length(codeCheckMsgsThisMod)==0)
+          if (length(mess) | length(codeCheckMsgsThisMod) == 0) {
             mess <- c(capture.output(type = "message",
                                      message(grep(paste0(m, ".R"),
                                                   ls(sim@.envir$.parsedFiles), value = TRUE))),
                       mess)
+          }
           codeCheckMsgs <- c(codeCheckMsgs, mess)
-
-        } # End of code checking
+        } ## End of code checking
 
         lockBinding(m, sim@.envir)
         names(sim@depends@dependencies)[[k]] <- m
@@ -553,3 +469,94 @@ evalWithActiveCode <- function(parsedModuleNoDefineModule, envir, parentFrame =
 .isNamespaced <- function(sim, m) {
   !isTRUE(any(grepl(paste0("^", m), ls(sim@.envir[[m]]))))
 }
+
+#' Run module's \code{.inputObjects}
+#'
+#' Run \code{.inputObjects()} from each module file from each module, one at a time,
+#' and remove it from the \code{simList} so next module won't rerun it.
+#'
+#' @keywords internal
+#' @rdname runModuleInputsObjects
+.runModuleInputObjects <- function(sim, m, i, objs, notOlderThan, userSuppliedObjNames, ...) {
+  # If user supplies the needed objects, then test whether all are supplied.
+  # If they are all supplied, then skip the .inputObjects code
+  cacheIt <- FALSE
+
+  allObjsProvided <- sim@depends@dependencies[[i]]@inputObjects[["objectName"]] %in%
+    userSuppliedObjNames
+  if (!all(allObjsProvided)) {
+    if (!is.null(sim@.envir[[m]][[".inputObjects"]])) {
+      list2env(objs[sim@depends@dependencies[[i]]@inputObjects[["objectName"]][allObjsProvided]], # nolint
+               envir = sim@.envir)
+      a <- sim@params[[m]][[".useCache"]]
+      if (!is.null(a)) {
+        # user supplied values
+        if (".useCache" %in% names(list(...)[["params"]])) {
+          b <- list(...)[["params"]][[i]][[".useCache"]]
+          if (!is.null(b)) a <- b
+        }
+        #.useCache is a parameter
+        if (!identical(FALSE, a)) {
+          #.useCache is not FALSE
+          if (!isTRUE(a)) {
+            #.useCache is not TRUE
+            if (".inputObjects" %in% a) {
+              cacheIt <- TRUE
+            }
+          } else {
+            cacheIt <- TRUE
+          }
+        }
+      }
+
+      if (cacheIt) {
+        message(crayon::green("Using or creating cached copy of .inputObjects for ",
+                              m, sep = ""))
+        moduleSpecificInputObjects <- sim@depends@dependencies[[i]]@inputObjects[["objectName"]] # nolint
+
+        # ensure backwards compatibility with non-namespaced modules
+        if (.isNamespaced(sim, m)) {
+          moduleSpecificObjs <- paste(m, ".inputObjects", sep = ":")
+          objectsToEvaluateForCaching <- c(moduleSpecificObjs)
+          .inputObjects <- sim@.envir[[m]][[".inputObjects"]]
+        } else {
+          objectsToEvaluateForCaching <- c(grep(ls(sim@.envir, all.names = TRUE),
+                                                pattern = m, value = TRUE),
+                                           na.omit(moduleSpecificInputObjects))
+          .inputObjects <- sim@.envir[[".inputObjects"]]
+        }
+
+        args <- as.list(formals(.inputObjects))
+        env <- environment()
+        args <- lapply(args[unlist(lapply(args, function(x)
+          all(nzchar(x))))], eval, envir = env)
+        args[["sim"]] <- sim
+
+        ## This next line will make the Caching sensitive to userSuppliedObjs
+        ##  (which are already in the simList) or objects supplied by another module
+        inSimList <- suppliedElsewhere(moduleSpecificInputObjects, sim, where = "sim")
+        if (any(inSimList)) {
+          objectsToEvaluateForCaching <- c(objectsToEvaluateForCaching,
+                                           moduleSpecificInputObjects[inSimList])
+        }
+
+        .inputObjects <- .getModuleInputObjects(sim, m)
+        sim <- Cache(FUN = do.call, .inputObjects, args,
+                     objects = objectsToEvaluateForCaching,
+                     notOlderThan = notOlderThan,
+                     outputObjects = moduleSpecificInputObjects,
+                     quick = getOption("reproducible.quick", FALSE),
+                     userTags = c(paste0("module:", m),
+                                  "eventType:.inputObjects",
+                                  "function:.inputObjects"))
+
+      } else {
+        message(crayon::green("Running .inputObjects for ", m, sep = ""))
+        .modifySearchPath(pkgs = sim@depends@dependencies[[i]]@reqdPkgs)
+        .inputObjects <- .getModuleInputObjects(sim, m)
+        sim <- .inputObjects(sim)
+      }
+    }
+  }
+  return(sim)
+}
diff --git a/man/runModuleInputsObjects.Rd b/man/runModuleInputsObjects.Rd