diff --git a/DESCRIPTION b/DESCRIPTION index 5a7aa74..b4ba48f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: jaspTools Type: Package Title: Helps Preview and Debug JASP Analyses -Version: 0.20.1 +Version: 0.21.0 Authors@R: c( person("Tim", "de Jong", role = "aut"), person("Don", "van den Bergh", role = c("ctb", "cre"), email = "d.vandenbergh@uva.nl"), @@ -14,10 +14,12 @@ LazyData: true Imports: archive (>= 1.1.6), data.table, + gh, httr, jsonlite, lifecycle, pkgload, + rappdirs, remotes, rjson, stringi, diff --git a/R/pkg-settings.R b/R/pkg-settings.R index 04ed9e9..05c4e4a 100644 --- a/R/pkg-settings.R +++ b/R/pkg-settings.R @@ -20,11 +20,35 @@ #' @details \code{reinstall.modules}: #' 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. +#' This option is deprecated in favor of \code{module.load.strategy}. +#' +#' @details \code{module.load.strategy}: +#' Controls how modules are loaded when running analyses. Options are: +#' \itemize{ +#' \item "pkgload": Uses \code{pkgload::load_all()} to load the module in development mode (fastest for iterative development). +#' \item "install": Reinstalls the module when source files change (default, ensures installed package is up-to-date). +#' \item "nothing": Does not reload or reinstall modules (uses currently installed version). +#' } #' #' @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{update.clone}: +#' Controls whether the jasp-desktop clone should be updated. Options are: +#' \itemize{ +#' \item "always": Always update the clone when \code{setupJaspTools()} is called. +#' \item "ask": Ask the user whether to update (default in interactive mode). +#' \item "never": Never update the clone automatically. +#' } +#' +#' @details \code{restore.lockfile}: +#' Controls whether to restore the renv lockfile if the library does not match. Options are: +#' \itemize{ +#' \item "ask": Ask the user whether to restore (default). +#' \item "never": Never ask about restoring (user should run \code{renv::restore()} manually if needed). +#' } +#' #' @return A print of the configurable options. #' @export viewPkgOptions viewPkgOptions <- function() { @@ -66,6 +90,25 @@ setPkgOption <- function(name, value) { if (!name %in% names(.pkgenv[["pkgOptions"]])) stop(name, " is not a valid option to set") + # validate options with fixed choices + if (name == "module.load.strategy") { + valid <- c("pkgload", "install", "nothing") + if (!value %in% valid) + stop("Invalid value for module.load.strategy. Must be one of: ", paste(valid, collapse = ", ")) + } + + if (name == "update.clone") { + valid <- c("always", "ask", "never") + if (!value %in% valid) + stop("Invalid value for update.clone. Must be one of: ", paste(valid, collapse = ", ")) + } + + if (name == "restore.lockfile") { + valid <- c("ask", "never") + if (!value %in% valid) + stop("Invalid value for restore.lockfile. Must be one of: ", paste(valid, collapse = ", ")) + } + # set relative paths to absolute paths to ensure they will work if the wd changes if (any(endsWith(name, c(".dir", ".dirs")))) { for (i in seq_along(value)) { diff --git a/R/pkg-setup.R b/R/pkg-setup.R index 7171c57..65cc088 100644 --- a/R/pkg-setup.R +++ b/R/pkg-setup.R @@ -5,13 +5,12 @@ #' If no parameters are supplied the function will interactively ask for the location of these dependencies. #' #' @param pathJaspDesktop (optional) Character path to the root of jasp-desktop if present on the system. -#' @param installJaspModules (optional) Boolean. Should jaspTools install all the JASP analysis modules as R packages (e.g., jaspAnova, jaspFrequencies)? #' @param installJaspCorePkgs (optional) Boolean. Should jaspTools install jaspBase, jaspResults and jaspGraphs? #' @param quiet (optional) Boolean. Should the installation of R packages produce output? #' @param force (optional) Boolean. Should a fresh installation of jaspResults, jaspBase, jaspGraphs and the JASP analysis modules proceed if they are already installed on your system? This is ignored if installJaspCorePkgs = FALSE. #' #' @export setupJaspTools -setupJaspTools <- function(pathJaspDesktop = NULL, installJaspModules = FALSE, installJaspCorePkgs = TRUE, quiet = FALSE, force = TRUE) { +setupJaspTools <- function(pathJaspDesktop = NULL, installJaspCorePkgs = TRUE, quiet = FALSE, force = TRUE) { argsMissing <- FALSE if (interactive()) { @@ -21,7 +20,7 @@ setupJaspTools <- function(pathJaspDesktop = NULL, installJaspModules = FALSE, i if (continue != 1) return(message("Setup aborted.")) } - if (missing(installJaspModules) || missing(pathJaspDesktop)) + if (missing(pathJaspDesktop)) argsMissing <- TRUE if (argsMissing) @@ -35,13 +34,6 @@ setupJaspTools <- function(pathJaspDesktop = NULL, installJaspModules = FALSE, i pathJaspDesktop <- validateJaspResourceDir(readline(prompt = "Please provide path/to/jasp-desktop: \n"), isJaspDesktopDir, "jasp-desktop") } - if (missing(installJaspModules)) { - wantsInstallJaspModules <- menu(c("Yes", "No"), title = "- Would you like jaspTools to install all the JASP analysis modules located at github.com/jasp-stats? This is useful if the module(s) you are working on requires functions from other JASP analysis modules.") - if (wantsInstallJaspModules == 0) return(message("Setup aborted.")) - - installJaspModules <- wantsInstallJaspModules == 1 - } - if (missing(installJaspCorePkgs)) { title <- if (jaspBaseIsLegacyVersion()) { "- Would you like jaspTools to install jaspResults, jaspBase and jaspGraphs? If you opt no, you must install them yourself." @@ -55,13 +47,13 @@ setupJaspTools <- function(pathJaspDesktop = NULL, installJaspModules = FALSE, i } } - .setupJaspTools(pathJaspDesktop, installJaspModules, installJaspCorePkgs, quiet, force) + .setupJaspTools(pathJaspDesktop, installJaspCorePkgs, quiet, force) if (argsMissing) - printSetupArgs(pathJaspDesktop, installJaspModules, installJaspCorePkgs, quiet, force) + printSetupArgs(pathJaspDesktop, installJaspCorePkgs, quiet, force) } -.setupJaspTools <- function(pathJaspDesktop, installJaspModules, installJaspCorePkgs, quiet, force) { +.setupJaspTools <- function(pathJaspDesktop, installJaspCorePkgs, quiet, force) { pathJaspDesktop <- validateJaspResourceDir(pathJaspDesktop, isJaspDesktopDir, "jasp-desktop") if (.isSetupComplete()) # in case the setup is performed multiple times @@ -87,21 +79,18 @@ setupJaspTools <- function(pathJaspDesktop = NULL, installJaspModules = FALSE, i } - if (isTRUE(installJaspModules)) - installJaspModules(force = force, quiet = quiet) - } .finalizeSetup() } -printSetupArgs <- function(pathJaspDesktop, installJaspModules, installJaspCorePkgs, quiet, force) { +printSetupArgs <- function(pathJaspDesktop, installJaspCorePkgs, quiet, force) { if (is.character(pathJaspDesktop)) showPathJasp <- paste0("\"", pathJaspDesktop, "\"") else showPathJasp <- "NULL" - message("\nIn the future you can skip the interactive part of the setup by calling `setupJaspTools(pathJaspDesktop = ", showPathJasp, ", installJaspModules = ", installJaspModules, ", installJaspCorePkgs = ", installJaspCorePkgs, ", quiet = ", quiet, ", force = ", force, ")`") + message("\nIn the future you can skip the interactive part of the setup by calling `setupJaspTools(pathJaspDesktop = ", showPathJasp, ", installJaspCorePkgs = ", installJaspCorePkgs, ", quiet = ", quiet, ", force = ", force, ")`") } validateJaspResourceDir <- function(path, validationFn, title) { @@ -142,9 +131,77 @@ getSetupCompleteFileName <- function() { .initInternalPaths() .initOutputDirs() + # Check if renv lockfile should be restored + checkRenvLockfile() + message("jaspTools setup complete") } +#' Check if renv lockfile needs to be restored +#' +#' Checks if the module has an renv lockfile and if the library doesn't match, +#' optionally prompts the user to restore it (based on restore.lockfile setting). +#' +#' @param modulePath Optional path to a specific module to check. If NULL, checks all modules. +checkRenvLockfile <- function(modulePath = NULL) { + # Only check in interactive mode + if (!interactive()) + return(invisible(FALSE)) + + # Get the restore.lockfile setting + restoreSetting <- tryCatch( + .pkgenv[["pkgOptions"]][["restore.lockfile"]], + error = function(e) "ask" + ) + + if (is.null(restoreSetting) || restoreSetting == "never") + return(invisible(FALSE)) + + # Get module paths to check + if (is.null(modulePath)) { + modulePaths <- tryCatch( + getModulePaths(), + error = function(e) NULL + ) + } else { + modulePaths <- modulePath + } + + if (is.null(modulePaths) || length(modulePaths) == 0) + return(invisible(FALSE)) + + for (modPath in modulePaths) { + lockfilePath <- file.path(modPath, "renv.lock") + + if (!file.exists(lockfilePath)) + next + + # Check if renv is available + if (!requireNamespace("renv", quietly = TRUE)) + next + + # Check if library matches lockfile + tryCatch({ + status <- renv::status(project = modPath) + if (!is.null(status) && isFALSE(status$synchronized)) { + moduleName <- getModuleName(modPath) + response <- menu(c("Yes, show me how", "No"), + title = sprintf("The library for %s does not match the renv lockfile. Would you like instructions to restore it?", moduleName)) + + if (response == 1) { + # Per issue requirements, we do not automatically restore - user must run renv::restore() manually + message("\nTo restore the lockfile, run the following command in R:\n") + message(" renv::restore(project = '", modPath, "')\n") + } + } + }, error = function(e) { + # Silently ignore errors from renv::status + }) + } + + invisible(TRUE) +} + .setSetupComplete <- function() { file <- getSetupCompleteFileName() fileConn <- file(file) @@ -162,23 +219,35 @@ getSetupCompleteFileName <- function() { # javascript and datasets fetchJaspDesktopDependencies <- function(jaspdesktopLoc = NULL, branch = "development", quiet = FALSE, force = FALSE) { if (is.null(jaspdesktopLoc) || !isJaspDesktopDir(jaspdesktopLoc)) { - baseLoc <- tempdir() + # Use rappdirs for persistent storage instead of tempdir + baseLoc <- getJaspDesktopCloneDir() jaspdesktopLoc <- file.path(baseLoc, paste0("jasp-desktop-", branch)) - if (!dir.exists(jaspdesktopLoc)) { + + shouldUpdate <- shouldUpdateClone(jaspdesktopLoc) + + if (!dir.exists(jaspdesktopLoc) || shouldUpdate) { zipFile <- file.path(baseLoc, "jasp-desktop.zip") - url <- sprintf("https://github.com/jasp-stats/jasp-desktop/archive/%s.zip", branch) + # Use gh package to get the archive URL + archiveUrl <- getJaspDesktopArchiveUrl(branch) # increase the timeout because this sometimes fails on GitHub actions oldTimeout <- getOption("timeout") # defaults to 60 seconds on.exit({options(timeout = oldTimeout)}) options(timeout = 300) # 5 minutes - res <- try(download.file(url = url, destfile = zipFile, quiet = quiet), silent = quiet) + res <- try(download.file(url = archiveUrl, destfile = zipFile, quiet = quiet), silent = quiet) if (inherits(res, "try-error") || res != 0) return(invisible(FALSE)) if (file.exists(zipFile)) { + # Remove old directory if updating + if (dir.exists(jaspdesktopLoc)) + unlink(jaspdesktopLoc, recursive = TRUE) + unzip(zipfile = zipFile, exdir = baseLoc) unlink(zipFile) + + # Record the update time + recordCloneUpdateTime(jaspdesktopLoc) } } } @@ -192,6 +261,113 @@ fetchJaspDesktopDependencies <- function(jaspdesktopLoc = NULL, branch = "develo return(invisible(TRUE)) } +#' Get the directory where jasp-desktop clone is stored +#' +#' Uses rappdirs to get a platform-agnostic user data directory. +#' +#' @return Character path to the jasp-desktop clone directory +getJaspDesktopCloneDir <- function() { + cacheDir <- rappdirs::user_cache_dir("jaspTools", "jasp-stats") + if (!dir.exists(cacheDir)) + dir.create(cacheDir, recursive = TRUE) + return(cacheDir) +} + +#' Update the jasp-desktop clone +#' +#' Updates the cached jasp-desktop clone from GitHub. This downloads the latest +#' version of the jasp-desktop repository to get updated datasets and HTML resources. +#' +#' @param branch Character. The branch to download (default: "development"). +#' @param quiet Boolean. Should download output be suppressed? +#' +#' @export updateDesktopClone +updateDesktopClone <- function(branch = "development", quiet = FALSE) { + if (!.isSetupComplete()) + stop("jaspTools is not configured yet. Did you run `setupJaspTools()`?") + + baseLoc <- getJaspDesktopCloneDir() + jaspdesktopLoc <- file.path(baseLoc, paste0("jasp-desktop-", branch)) + zipFile <- file.path(baseLoc, "jasp-desktop.zip") + + message("Updating jasp-desktop clone from GitHub...") + + archiveUrl <- getJaspDesktopArchiveUrl(branch) + + oldTimeout <- getOption("timeout") + on.exit({options(timeout = oldTimeout)}) + options(timeout = 300) + + res <- try(download.file(url = archiveUrl, destfile = zipFile, quiet = quiet), silent = quiet) + if (inherits(res, "try-error") || res != 0) + stop("Failed to download jasp-desktop archive from GitHub") + + if (file.exists(zipFile)) { + if (dir.exists(jaspdesktopLoc)) + unlink(jaspdesktopLoc, recursive = TRUE) + + unzip(zipfile = zipFile, exdir = baseLoc) + unlink(zipFile) + + recordCloneUpdateTime(jaspdesktopLoc) + message("jasp-desktop clone updated successfully") + + # Re-fetch resources + fetchJavaScript(jaspdesktopLoc) + fetchDatasets(jaspdesktopLoc) + } + + invisible(TRUE) +} + +getJaspDesktopArchiveUrl <- function(branch) { + # Direct URL for GitHub archive download - no API call needed + sprintf("https://github.com/jasp-stats/jasp-desktop/archive/%s.zip", branch) +} + +shouldUpdateClone <- function(clonePath) { + if (!dir.exists(clonePath)) + return(TRUE) + + # Check the update.clone setting + # Need to check if setup is complete first to avoid errors + updateSetting <- tryCatch( + .pkgenv[["pkgOptions"]][["update.clone"]], + error = function(e) "ask" + ) + + if (is.null(updateSetting)) + updateSetting <- "ask" + + if (updateSetting == "never") + return(FALSE) + + if (updateSetting == "always") + return(TRUE) + + # "ask" - check if update is needed and prompt user + if (interactive()) { + updateFile <- file.path(clonePath, ".jasptools_updated") + if (file.exists(updateFile)) { + lastUpdate <- as.POSIXct(readLines(updateFile, n = 1)) + daysSinceUpdate <- as.numeric(difftime(Sys.time(), lastUpdate, units = "days")) + + if (daysSinceUpdate > 7) { + response <- menu(c("Yes", "No"), + title = sprintf("The jasp-desktop clone was last updated %.0f days ago. Would you like to update it?", daysSinceUpdate)) + return(response == 1) + } + } + } + + return(FALSE) +} + +recordCloneUpdateTime <- function(clonePath) { + updateFile <- file.path(clonePath, ".jasptools_updated") + writeLines(as.character(Sys.time()), updateFile) +} + getJavascriptLocation <- function(rootOnly = FALSE) { jaspToolsDir <- getJaspToolsDir() htmlDir <- file.path(jaspToolsDir, "html") diff --git a/R/run.R b/R/run.R index 6cc31c2..9f95513 100644 --- a/R/run.R +++ b/R/run.R @@ -137,8 +137,8 @@ fetchRunArgs <- function(name, options) { } initAnalysisRuntime <- function(dataset, options, makeTests, encodedDataset = FALSE, ...) { - # first we reinstall any changed modules in the personal library - reinstallChangedModules() + # first we handle module loading based on strategy + loadChangedModules() # dataset to be found in the analysis when it needs to be read .setInternal("dataset", dataset) @@ -156,9 +156,19 @@ initAnalysisRuntime <- function(dataset, options, makeTests, encodedDataset = FA set.seed(1) } -reinstallChangedModules <- function() { +loadChangedModules <- function() { modulePaths <- getModulePaths() - if (isFALSE(getPkgOption("reinstall.modules")) || length(modulePaths) == 0) + if (length(modulePaths) == 0) + return() + + # Get the module loading strategy + strategy <- getPkgOption("module.load.strategy") + + # Handle legacy reinstall.modules option + if (isFALSE(getPkgOption("reinstall.modules"))) + strategy <- "nothing" + + if (strategy == "nothing") return() md5Sums <- .getInternal("modulesMd5Sums") @@ -178,20 +188,35 @@ reinstallChangedModules <- function() { newMd5Sums <- tools::md5sum(srcFiles) if (length(md5Sums) == 0 || !modulePath %in% names(md5Sums) || !all(newMd5Sums %in% md5Sums[[modulePath]])) { moduleName <- getModuleName(modulePath) - if (moduleName %in% loadedNamespaces()) - pkgload::unload(moduleName, quiet = TRUE) - message("Installing ", moduleName, " from source") - suppressWarnings(install.packages(modulePath, type = "source", repos = NULL, quiet = TRUE, INSTALL_opts = "--no-multiarch")) + if (strategy == "pkgload") { + # Use pkgload::load_all for faster iterative development + if (moduleName %in% loadedNamespaces()) + pkgload::unload(moduleName, quiet = TRUE) - if (moduleName %in% installed.packages()) { + message("Loading ", moduleName, " with pkgload::load_all()") + # export_all = FALSE ensures only functions explicitly exported in NAMESPACE + # are available via ::, similar to installed package behavior + pkgload::load_all(modulePath, quiet = TRUE, export_all = FALSE) md5Sums[[modulePath]] <- newMd5Sums + } else { - # to prevent the installation output from cluttering the console on each analysis run, we do this quietly. - # however, it is kinda nice to show errors, so we call the function again here and allow it to print this time (tryCatch/sink doesn't catch the installation failure reason). - install.packages(modulePath, type = "source", repos = NULL, INSTALL_opts = "--no-multiarch") - if (!moduleName %in% installed.packages()) - stop("The installation of ", moduleName, " failed; you will need to fix the issue that prevents `install.packages()` from installing the module before any analysis will work") + # Default "install" strategy - reinstall the module + if (moduleName %in% loadedNamespaces()) + pkgload::unload(moduleName, quiet = TRUE) + + message("Installing ", moduleName, " from source") + suppressWarnings(install.packages(modulePath, type = "source", repos = NULL, quiet = TRUE, INSTALL_opts = "--no-multiarch")) + + if (moduleName %in% installed.packages()) { + md5Sums[[modulePath]] <- newMd5Sums + } else { + # to prevent the installation output from cluttering the console on each analysis run, we do this quietly. + # however, it is kinda nice to show errors, so we call the function again here and allow it to print this time (tryCatch/sink doesn't catch the installation failure reason). + install.packages(modulePath, type = "source", repos = NULL, INSTALL_opts = "--no-multiarch") + if (!moduleName %in% installed.packages()) + stop("The installation of ", moduleName, " failed; you will need to fix the issue that prevents `install.packages()` from installing the module before any analysis will work") + } } } } @@ -199,6 +224,11 @@ reinstallChangedModules <- function() { .setInternal("modulesMd5Sums", md5Sums) } +# Keep the old function name as an alias for backwards compatibility +reinstallChangedModules <- function() { + loadChangedModules() +} + initializeCoreJaspPackages <- function() { require(jaspBase) if (jaspBaseIsLegacyVersion()) { diff --git a/R/utils.R b/R/utils.R index 64071ef..8b34185 100644 --- a/R/utils.R +++ b/R/utils.R @@ -233,7 +233,14 @@ getOS <- function() { } getJaspGithubRepos <- function() { - githubGET(asGithubOrganizationUrl("jasp-stats", "repos", params = list(type = "public", per_page = 1e3))) + # Use gh package for GitHub API interactions + tryCatch({ + repos <- gh::gh("/orgs/{owner}/repos", owner = "jasp-stats", type = "public", per_page = 100, .limit = Inf) + repos + }, error = function(e) { + # Fallback to httr if gh fails + githubGET(asGithubOrganizationUrl("jasp-stats", "repos", params = list(type = "public", per_page = 1e3))) + }) } asGithubOrganizationUrl <- function(owner, urlSegments = NULL, params = list()) { @@ -268,30 +275,53 @@ addParamsToUrl <- function(url, params) { } getGithubPAT <- function() { - pat <- paste0("5334959d", "c3906be2", "0391aa5d", "cecf1492", "55d38d6f") # default public key - patEnv <- Sys.getenv("GITHUB_PAT") - if (nzchar(patEnv)) - pat <- patEnv + # First try to get PAT from gh package (which handles various auth methods) + # Note: For public repositories, authentication is optional but helps with rate limits + pat <- tryCatch({ + gh::gh_token() + }, error = function(e) { + "" + }) + # Fallback to environment variable + if (!nzchar(pat)) { + patEnv <- Sys.getenv("GITHUB_PAT") + if (nzchar(patEnv)) + pat <- patEnv + } + + # Return empty string if no PAT found - unauthenticated access works for public repos return(pat) } githubGET <- function(url) { - response <- httr::GET(url = url, config = getGithubHeader()) - - if (response$status_code == 404) - stop("Could not locate GitHub repository resource at \"", url, "\" did you specify the owner and repo correctly?") - - if (response$status_code != 200) - stop("Could not retrieve information from \"", url, "\" at this time") - - suppressMessages(httr::parsed_content(response)) + # Try using gh package first + tryCatch({ + # Parse URL to extract endpoint + endpoint <- sub("https://api.github.com", "", url) + gh::gh(endpoint) + }, error = function(e) { + # Fallback to httr + response <- httr::GET(url = url, config = getGithubHeader()) + + if (response$status_code == 404) + stop("Could not locate GitHub repository resource at \"", url, "\" did you specify the owner and repo correctly?") + + if (response$status_code != 200) + stop("Could not retrieve information from \"", url, "\" at this time") + + suppressMessages(httr::parsed_content(response)) + }) } getGithubHeader <- function() { pat <- getGithubPAT() - httr::add_headers(Authorization = sprintf("token %s", pat), - Accept = "application/vnd.github.golden-comet-preview+json") + if (nzchar(pat)) { + httr::add_headers(Authorization = sprintf("token %s", pat), + Accept = "application/vnd.github.golden-comet-preview+json") + } else { + httr::add_headers(Accept = "application/vnd.github.golden-comet-preview+json") + } } # same as the internals in testthat diff --git a/R/zzz.R b/R/zzz.R index 1cce5c0..1d67199 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -4,12 +4,15 @@ state = list(), modulesMd5Sums = list() ), - pkgOptions = list(module.dirs = "", - reinstall.modules = TRUE, - view.in.rstudio = TRUE, - html.dir = "", - data.dirs = "", - language = "en" + pkgOptions = list(module.dirs = "", + reinstall.modules = TRUE, + module.load.strategy = "install", + view.in.rstudio = TRUE, + html.dir = "", + data.dirs = "", + language = "en", + update.clone = "ask", + restore.lockfile = "ask" ) ), parent = emptyenv())