Introduce monitor(), install module deps and search for module datasets

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: jaspTools
 Type: Package
 Title: Helps preview and debug JASP analyses
-Version: 1.5.0
+Version: 1.6.0
 Author: Tim de Jong
 Maintainer: Tim de Jong <tim_jong@hotmail.com>
 Description: This package assists JASP developers when writing R code. It removes the necessity of building JASP every time a change is made. Rather, analyses can be called directly in R and be debugged interactively.

NAMESPACE

@@ -6,6 +6,7 @@ export(expect_equal_tables)
 export(installJaspModules)
 export(makeTestTable)
 export(manageTestPlots)
+export(monitor)
 export(runAnalysis)
 export(runTestsTravis)
 export(setPkgOption)

R/dataset.R

@@ -1,8 +1,6 @@
-loadCorrectDataset <- function(x) {
-  if (is.matrix(x) || is.data.frame(x)) {
-    return(x)
-  } else if (is.character(x)) {
-    if (! endsWith(x, ".csv")) {
+loadDataset <- function(x) {
+  if (is.character(x)) {
+    if (!endsWith(x, ".csv")) {
       x <- paste0(x, ".csv")
     }
 
@@ -11,8 +9,8 @@ loadCorrectDataset <- function(x) {
       return(utils::read.csv(x, header = TRUE, check.names = FALSE))
     }
 
-    # check if it's a name of a JASP dataset
-    locations <- getPkgOption("data.dirs")
+    # check if it's a name of a jasp-desktop, jaspTools or module dataset
+    locations <- getDatasetLocations()
     allDatasets <- c()
     for (location in locations) {
 
@@ -33,6 +31,11 @@ loadCorrectDataset <- function(x) {
     cat("It appears", x, "could not be found. Please supply either a full filepath or the name of one of the following datasets:\n",
         paste0(sort(allDatasets), collapse = '\n'), "\n")
     stop(paste(x, "not found"))
+  } else {
+    return(x)
   }
-  stop(paste("Cannot handle data of type", mode(x)))
+}
+
+getDatasetLocations <- function() {
+  return(c(getPkgOption("data.dirs"), getModuleDatasetLocations()))
 }

R/modules.R

@@ -0,0 +1,165 @@
+#' Tell jaspTools what module you are currently working on.
+#'
+#' This information is used to find the correct analysis resources and monitor the module for any changes.
+#'
+#' @param modulePaths Path to the root of the module (if no path is specified, then the current working directory will be used).
+#' @examples
+#'
+#' monitor(c("~/Documents/Github/Regression", "~/Document/Github/Frequencies"))
+#'
+#' @export monitor
+monitor <- function(modulePaths = ".") {
+  validModulePaths <- verifyModulePaths(modulePaths)
+  if (length(validModulePaths) == 0)
+    stop("No valid module(s) supplied in `modulePaths` and working directory is not a module. Note that all JASP modules should be R packages and have these files: DESCRIPTION, NAMESPACE and inst/Description.qml.")
+
+  numInvalidPaths <- length(modulePaths) - length(validModulePaths)
+  if (numInvalidPaths > 0)
+    warning("Dropped ", numInvalidPaths, " invalid module(s) supplied in `modulePaths`")
+
+  .setInternal("modulePaths", validModulePaths)
+  message("Now monitoring: ", paste(validModulePaths, collapse = ", "))
+}
+
+asNamespacedFunctionCall <- function(funName) {
+  modulePath <- getModulePathFromRFunction(funName)
+  if (is.null(modulePath))
+    stop("Could not locate the module location for `", funName, "`")
+
+  return(paste(getModuleName(modulePath), funName, sep = "::"))
+}
+
+getModulePaths <- function() {
+  modulePaths <- .getInternal("modulePaths")
+  if (modulePaths == "") {
+    if (setWorkDirAsModule())
+      modulePaths <- .getInternal("modulePaths")
+    else
+      stop("jaspTools needs to know what module to obtain resources from. Please set the current working directory to your JASP module, or specify it through `monitor(\"path/to/module\")`")
+  }
+
+  return(modulePaths)
+}
+
+setWorkDirAsModule <- function() {
+  if (!is.null(verifyModulePaths(getwd()))) {
+    message("Current working directory is a JASP module, using that (to override this behaviour use `monitor()`)")
+    monitor(getwd())
+    return(TRUE)
+  }
+  return(FALSE)
+}
+
+verifyModulePaths <- function(modulePaths) {
+  validModulePaths <- NULL
+  if (length(modulePaths) > 0 && any(modulePaths != "")) {
+    for (modulePath in modulePaths) {
+      validModuleRoot <- getValidModuleRoot(modulePath)
+      if (!is.null(validModuleRoot))
+        validModulePaths <- c(validModulePaths, validModuleRoot)
+    }
+  }
+
+  return(validModulePaths)
+}
+
+getModulePathFromRFunction <- function(funName) {
+  modulePath <- NULL
+
+  modulePaths <- getModulePaths()
+  for (i in seq_along(modulePaths)) {
+    if (rFunctionExistsInModule(funName, modulePaths[[i]])) {
+      modulePath <- modulePaths[i]
+      break
+    }
+  }
+
+  if (is.null(modulePath))
+    stop("Could not locate R function `", funName, "` in any of your specified modules. Did you type the R function correctly (it's case sensitive)?")
+
+  return(modulePath)
+}
+
+rFunctionExistsInModule <- function(funName, modulePath) {
+
+  if (isBinaryPackage(modulePath)) {
+
+    # this is how `::` looks up functions
+    moduleName <- getModuleName(modulePath)
+    ns <- asNamespace(moduleName)
+    return(!is.null(.getNamespaceInfo(ns, "exports")[[funName]]))
+
+  } else {
+
+    env <- new.env()
+    rFiles <- list.files(file.path(modulePath, "R"), pattern = "\\.[RrSsQq]$", recursive = TRUE, full.names = TRUE)
+    if (length(rFiles) == 0)
+      return(FALSE)
+
+    for (rFile in rFiles)
+      source(rFile, local = env)
+
+    if (funName %in% names(env))
+      return(TRUE)
+
+    return(FALSE)
+  }
+}
+
+getModulePathsForTesting <- function() {
+  modulesWithTests <- NULL
+  modulePaths <- getModulePaths()
+  for (modulePath in modulePaths) {
+    testDir <- file.path(modulePath, "tests", "testthat")
+    if (dir.exists(testDir) && length(list.files(testDir)) > 0)
+      modulesWithTests <- c(modulesWithTests, modulePath)
+  }
+
+  if (length(modulesWithTests) == 0)
+    message("No tests were found. Note that the tests should be in `moduleDir/tests/testthat` and named `test-analysisName.R`.")
+
+  return(modulesWithTests)
+}
+
+getModuleName <- function(moduleRoot) {
+  descrFile <- file.path(moduleRoot, "DESCRIPTION")
+  pkgName <- as.vector(read.dcf(descrFile, fields = "Package"))
+  if (is.na(pkgName))
+    stop("Could not obtain package name from `Package` field in ", descrFile)
+
+  return(pkgName)
+}
+
+getValidModuleRoot <- function(path) {
+  while (!hasJaspModuleRequisites(path)) {
+    parentDir <- dirname(path)
+    if (identical(parentDir, dirname(parentDir))) # we're at the root of the filesystem
+      return(NULL)
+    path <- parentDir
+  }
+  return(tidyPath(path))
+}
+
+sourceModuleRequisites <- function(sep = .Platform$file.sep) {
+  return(c("NAMESPACE", "DESCRIPTION", paste("inst", "Description.qml", sep = sep)))
+}
+
+binaryModuleRequisites <- function() {
+  return(c("NAMESPACE", "DESCRIPTION", "Description.qml", "qml", "Meta"))
+}
+
+hasJaspModuleRequisites <- function(path) {
+  all(file.exists(file.path(path, sourceModuleRequisites()))) ||
+    all(file.exists(file.path(path, binaryModuleRequisites())))
+}
+
+getModuleDatasetLocations <- function() {
+  dataPaths <- NULL
+  modulePaths <- getModulePaths()
+  for (i in seq_along(modulePaths)) {
+    dataFiles <- list.files(modulePaths[i], "\\.csv$", recursive = TRUE, full.names = TRUE)
+    if (length(dataFiles) > 0)
+      dataPaths <- c(dataPaths, unique(dirname(dataFiles)))
+  }
+  return(dataPaths)
+}

R/pkg-settings.R

@@ -21,9 +21,8 @@
 #' When you run an analysis or test it, jaspTools calls the *installed* version of the module.
 #' This option specifies if the installed version should be reinstalled automatically when you make any changes to your module.
 #'
-#' @details \code{module.dirs}:
-#' The directories that hold the source for the JASP module(s) you are working on.
-#' These module directories are used to find the R functions etc. in \code{runAnalysis} and the various testing functions.
+#' @details \code{install.deps}:
+#' This option specifies if jaspTools should install missing deps of the module.
 #'
 #' @return A print of the configurable options.
 #' @export viewPkgOptions
@@ -53,7 +52,7 @@ viewPkgOptions <- function() {
 #' @param value Value the option should be set to.
 #' @examples
 #'
-#' setPkgOption("module.dirs", c("~/Documents/Github/Regression", "~/Document/Github/Frequencies"))
+#' setPkgOption("reinstall.modules", FALSE)
 #'
 #' @export setPkgOption
 setPkgOption <- function(name, value) {
@@ -63,6 +62,16 @@ setPkgOption <- function(name, value) {
   if (length(name) > 1)
     stop("Please only set one option at a time")
 
+  if (name == "module.dirs") {
+    lifecycle::deprecate_warn(
+      when = "1.6.0",
+      what = "setPkgOption('module.dirs')",
+      with = "monitor()"
+    )
+    monitor(value)
+    return(invisible(NULL))
+  }
+
   if (!name %in% names(.pkgenv[["pkgOptions"]]))
     stop(name, " is not a valid option to set")
 
@@ -75,7 +84,7 @@ setPkgOption <- function(name, value) {
       if (!dir.exists(value[i])) # if the value is not a null value it should be a valid path
         stop("Directory ", value[i], " does not exist")
 
-      value[i] <- gsub("[\\/]$", "", normalizePath(value[i])) # normalize path and strip trailing slashes
+      value[i] <- tidyPath(value[i])
     }
   }
 

R/pkg-setup.R

@@ -137,8 +137,8 @@ getSetupCompleteFileName <- function() {
 
 .removeCompletedSetupFiles <- function() {
   unlink(getSetupCompleteFileName())
-  unlink(getJavascriptLocation(), recursive = TRUE)
-  unlink(getDatasetsLocations(jaspOnly = TRUE), recursive = TRUE)
+  unlink(getJaspDesktopJSLocation(), recursive = TRUE)
+  unlink(getJaspDesktopDatasetLocation(), recursive = TRUE)
   message("Removed files from previous jaspTools setup")
 }
 
@@ -165,13 +165,13 @@ fetchJaspDesktopDependencies <- function(jaspdesktopLoc = NULL, branch = "develo
   if (!isJaspDesktopDir(jaspdesktopLoc))
     return(invisible(FALSE))
 
-  fetchJavaScript(jaspdesktopLoc)
-  fetchDatasets(jaspdesktopLoc)
+  fetchJaspDesktopJS(jaspdesktopLoc)
+  fetchJaspDesktopDatasets(jaspdesktopLoc)
 
   return(invisible(TRUE))
 }
 
-getJavascriptLocation <- function(rootOnly = FALSE) {
+getJaspDesktopJSLocation <- function(rootOnly = FALSE) {
   jaspToolsDir <- getJaspToolsDir()
   htmlDir <- file.path(jaspToolsDir, "html")
   if (!rootOnly)
@@ -180,17 +180,16 @@ getJavascriptLocation <- function(rootOnly = FALSE) {
   return(htmlDir)
 }
 
-getDatasetsLocations <- function(jaspOnly = FALSE) {
-  jaspToolsDir <- getJaspToolsDir()
-  dataDirs <- file.path(jaspToolsDir, "jaspData")
-  if (!jaspOnly)
-    dataDirs <- c(dataDirs, file.path(jaspToolsDir, "extdata"))
+getJaspToolsDatasetLocation <- function() {
+  return(file.path(getJaspToolsDir(), "extdata"))
+}
 
-  return(dataDirs)
+getJaspDesktopDatasetLocation <- function() {
+  return(file.path(getJaspToolsDir(), "jaspData"))
 }
 
-fetchJavaScript <- function(path) {
-  destDir <- getJavascriptLocation(rootOnly = TRUE)
+fetchJaspDesktopJS <- function(path) {
+  destDir <- getJaspDesktopJSLocation(rootOnly = TRUE)
   if (!dir.exists(destDir))
     dir.create(destDir)
 
@@ -199,12 +198,12 @@ fetchJavaScript <- function(path) {
     stop("Could not move html files from jasp-desktop, is the path correct? ", path)
 
   file.copy(from = htmlDir, to = destDir, overwrite = TRUE, recursive = TRUE)
-  file.rename(file.path(destDir, "html"), getJavascriptLocation())
+  file.rename(file.path(destDir, "html"), getJaspDesktopJSLocation())
   message("Moved html files to jaspTools")
 }
 
-fetchDatasets <- function(path) {
-  destDir <- getDatasetsLocations(jaspOnly = TRUE)
+fetchJaspDesktopDatasets <- function(path) {
+  destDir <- getJaspDesktopDatasetLocation()
   if (!dir.exists(destDir))
     dir.create(destDir)
 
@@ -336,7 +335,7 @@ isRepoJaspModule <- function(repo, branch) {
   repoTree <- githubGET(asGithubReposUrl("jasp-stats", repo, c("git", "trees", branch), params = list(recursive = "false")))
   if (length(names(repoTree)) > 0 && "tree" %in% names(repoTree)) {
     pathNames <- unlist(lapply(repoTree[["tree"]], `[[`, "path"))
-    return(all(moduleRequisites(sep = "/") %in% pathNames))
+    return(all(sourceModuleRequisites(sep = "/") %in% pathNames))
   }
 
   return(FALSE)

R/rbridge.R

@@ -15,9 +15,7 @@
   env[[".setColumnDataAsNominalText"]] <- function(...) return(TRUE)
 
   env[[".allColumnNamesDataset"]]      <- function(...) {
-    dataset <- .getInternal("dataset")
-    dataset <- loadCorrectDataset(dataset)
-    return(colnames(dataset))
+    return(colnames(.getInternal("dataset")))
   }
 }
 
@@ -30,7 +28,6 @@
                                     columns.as.factor = c(), all.columns = FALSE) {
 
   dataset <- .getInternal("dataset")
-  dataset <- loadCorrectDataset(dataset)
 
   if (all.columns) {
     columns <- colnames(dataset)

R/run.R

@@ -114,7 +114,7 @@ runAnalysis <- function(name, dataset, options, view = TRUE, quiet = FALSE, make
 fetchRunArgs <- function(name, options) {
   possibleArgs <- list(
     name = name,
-    functionCall = findCorrectFunction(name),
+    functionCall = asNamespacedFunctionCall(name),
     title = "",
     requiresInit = TRUE,
     options = jsonlite::toJSON(options),
@@ -133,7 +133,7 @@ initAnalysisRuntime <- function(dataset, makeTests, ...) {
   reinstallChangedModules()
 
   # dataset to be found in the analysis when it needs to be read
-  .setInternal("dataset", dataset)
+  .setInternal("dataset", loadDataset(dataset))
 
   # prevent the results from being translated (unless the user explicitly wants to)
   Sys.setenv(LANG = getPkgOption("language"))
@@ -173,6 +173,11 @@ reinstallChangedModules <- function() {
         pkgload::unload(moduleName, quiet = TRUE)
 
       message("Installing ", moduleName, " from source")
+
+      if (isTRUE(getPkgOption("install.deps")))
+        suppressWarnings(remotes::install_deps(modulePath, upgrade = "never", INSTALL_opts = "--no-multiarch"))
+
+      # we use install.packages here because of https://github.com/jasp-stats/jaspTools/pull/14#issuecomment-748112692
       suppressWarnings(install.packages(modulePath, type = "source", repos = NULL, quiet = TRUE, INSTALL_opts = "--no-multiarch"))
 
       if (moduleName %in% installed.packages()) {