From 9a98c44a615660d64a6a9d18b9cc601a20b7527d Mon Sep 17 00:00:00 2001 From: Anthony Sena Date: Tue, 12 Dec 2023 21:48:12 -0500 Subject: [PATCH 1/4] Initial module verification function --- NAMESPACE | 1 + R/ModuleInstantiation.R | 203 ++++++++++++++++++++++- R/ResultModelCreation.R | 6 +- R/ResultsUpload.R | 6 +- R/RunModule.R | 6 +- R/Settings.R | 9 + R/Strategus.R | 1 + inst/testdata/analysisSpecification.json | 10 +- man/verifyModuleInstallation.Rd | 39 +++++ tests/testthat/setup.R | 14 +- 10 files changed, 277 insertions(+), 18 deletions(-) create mode 100644 man/verifyModuleInstallation.Rd diff --git a/NAMESPACE b/NAMESPACE index 2671ea51..4dca0c1e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,7 @@ export(getModuleList) export(retrieveConnectionDetails) export(storeConnectionDetails) export(unlockKeyring) +export(verifyModuleInstallation) import(CohortGenerator) import(DatabaseConnector) import(dplyr) diff --git a/R/ModuleInstantiation.R b/R/ModuleInstantiation.R index df27152f..5b3dd856 100644 --- a/R/ModuleInstantiation.R +++ b/R/ModuleInstantiation.R @@ -73,9 +73,207 @@ ensureAllModulesInstantiated <- function(analysisSpecifications) { stop(message) } + # Verify all modules are properly installed + moduleInstallStatus <- list() + for (i in 1:nrow(modules)) { + status <- verifyModuleInstallation( + module = modules$module[i], + version = modules$version[i] + ) + moduleInstallStatus <- append(status, moduleInstallStatus) + } + attr(modules, 'moduleInstallStatus') <- moduleInstallStatus + return(modules) } + +#' Verify a module is properly installed +#' +#' @description +#' In some instances a module may fail to instantiate and install due to problems +#' when calling renv::restore for the module's renv.lock file. This function +#' will allow you to surface inconsistencies between the module renv.lock file +#' and the module's renv project library. This function will check to that a +#' module has been properly installed using internal functions of the `renv` +#' package. If a module is verified to work via this function, the hash of +#' the module's renv.lock file will be written to a text file in the module +#' directory to indicate that it is ready for use. This will allow subsequent +#' calls to work faster since the initial verification process can take some +#' time.It is possible to re-run the verification of a module +#' by using the `forceVerification` parameter. +#' +#' To fix issues with a module, you will need to open the module's .Rproj in +#' RStudio instance and debug the issues when calling renv::restore(). +#' +#' @param module The name of the module to verify (i.e. "CohortGeneratorModule") +#' +#' @param version The version of the module to verify (i.e. "0.2.1") +#' +#' @param forceVerification When set to TRUE, the verification process is forced +#' to re-evaluate if the module is properly installed. The default is FALSE +#' since if the module is successfully validated by this function, it will cache +#' the hash value of the module's renv.lock file in the file system so it can +#' by-pass running this check every time. +#' +#' @return +#' A list with the output of the consistency check +#' +#' @export +verifyModuleInstallation <- function(module, version, forceVerification = FALSE) { + # Internal helper function + verifyModuleInstallationReturnValue <- function(moduleFolder, moduleInstalled, issues = NULL) { + returnVal <- list( + moduleFolder = moduleFolder, + moduleInstalled = moduleInstalled, + issues = issues + ) + return(returnVal) + } + + moduleFolder <- getModuleFolder(module, version) + if (!dir.exists(moduleFolder)) { + warn("Module ", module, ", Version: ", version, " not found at: ", moduleFolder, ". This means the module was never installed.") + return( + verifyModuleInstallationReturnValue( + moduleFolder = moduleFolder, + moduleInstalled = FALSE + ) + ) + } + + message("Verifying module: ", module, ", (", version, ") at ", moduleFolder, "...", appendLF = F) + + moduleStatusFileName <- "moduleStatus.txt" + renvLockFileName <- "renv.lock" + + # If the lock file doesn't exist, we're not sure if we're dealing with a module. + if (!file.exists(file.path(moduleFolder, renvLockFileName))) { + message("ERROR - renv.lock file missing.") + return( + verifyModuleInstallationReturnValue( + moduleFolder = moduleFolder, + moduleInstalled = FALSE + ) + ) + } + + # Check to see if we've already performed the verification by looking at the + # moduleStatus.txt file to see if the md5 in that file matches the one + # created by hashing the renv.lock file + lockfileContents <- ParallelLogger::loadSettingsFromJson( + fileName = file.path(moduleFolder, renvLockFileName) + ) + lockfileHash <- digest::digest( + object = lockfileContents, + algo = "md5" + ) + if (!forceVerification && file.exists(file.path(moduleFolder, moduleStatusFileName))) { + lockfileHashFromModuleStatusFile <- SqlRender::readSql( + sourceFile = file.path(moduleFolder, moduleStatusFileName) + ) + + # If the values match, the module is installed correctly + # return and exit + if (lockfileHashFromModuleStatusFile == lockfileHash) { + message("MODULE READY!") + return( + verifyModuleInstallationReturnValue( + moduleFolder = moduleFolder, + moduleInstalled = TRUE + ) + ) + } + } + + + # Now perform the consistency check to verify that the renv::restore() + # process executed successfully. We must do this in the module's context + Strategus:::withModuleRenv( + code = { + # Start by turning off verbose output to hide renv output + verboseOption <- getOption("renv.verbose") + options(renv.verbose = FALSE) + on.exit(options(renv.verbose = verboseOption)) + + # Get the renv project status and then identify the packages used + # in the project to determine if there were issues when restoring + # the project from the renv.lock file. + projectStatus <- renv::status() + + # Get the packages in the project - adapted from + # https://github.com/rstudio/renv/blob/v1.0.3/R/status.R + project <- renv:::renv_project_resolve() + libpaths <- renv:::renv_libpaths_resolve() + dependencies <- renv:::renv_snapshot_dependencies(project, dev = FALSE) + packages <- sort(union(dependencies, "renv")) + paths <- renv:::renv_package_dependencies(packages, libpaths = libpaths, project = project) + packages <- as.character(names(paths)) + # remove ignored packages + ignored <- c( + renv:::renv_project_ignored_packages(project), + renv:::renv_packages_base() + ) + packages <- setdiff(packages, ignored) + projectStatus$packages <- packages + saveRDS(projectStatus, file="projectStatus.rds") + }, + moduleFolder = moduleFolder + ) + + # The module's project status is written to the + # file system. Now we can get the module status and use the information + # to determine the restoration status + projectStatus <- readRDS(file.path(moduleFolder, "projectStatus.rds")) + + library <- names(projectStatus$library$Packages) + lockfile <- names(projectStatus$lockfile$Packages) + + packages <- sort(unique(c(library, lockfile, projectStatus$packages))) + + packageStatus <- data.frame( + package = packages, + installed = packages %in% library, + recorded = packages %in% lockfile, + used = packages %in% packages + ) + + # If all of the used & recorded packages are installed, then + # return TRUE for the module installed status. If not, return + # FALSE and set an attribute of the list that contains the issues + # discovered + ok <- packageStatus$installed & (packageStatus$used == packageStatus$recorded) + issues <- packageStatus[!ok, , drop = FALSE] + missing <- !issues$installed + issues$installed <- ifelse(issues$installed, "y", "n") + issues$recorded <- ifelse(issues$recorded, "y", "n") + issues$used <- ifelse(issues$used, "y", if (any(missing)) "?" else "n") + issues <- issues[issues$installed == "n" & issues$recorded == "y" & issues$used == "y", ] + + moduleInstalled <- nrow(issues) == 0 + + if (isTRUE(moduleInstalled)) { + message("MODULE READY!") + # Write the contents of the md5 hash of the module's + # renv.lock file to the file system to note that the + # module's install status was successful and verified + SqlRender::writeSql( + sql = lockfileHash, + targetFile = file.path(moduleFolder, "moduleStatus.txt") + ) + } else { + message("MODULE HAS ISSUES!") + } + + return( + verifyModuleInstallationReturnValue( + moduleFolder = moduleFolder, + moduleInstalled = moduleInstalled, + issues = issues + ) + ) +} + getModuleTable <- function(analysisSpecifications, distinct = FALSE) { modules <- lapply( analysisSpecifications$moduleSpecifications, @@ -121,15 +319,14 @@ getModuleMetaData <- function(moduleFolder) { } getModuleFolder <- function(module, version) { + assertModulesFolderSetting(x = Sys.getenv("INSTANTIATED_MODULES_FOLDER")) moduleFolder <- file.path(Sys.getenv("INSTANTIATED_MODULES_FOLDER"), sprintf("%s_%s", module, version)) invisible(moduleFolder) } ensureModuleInstantiated <- function(module, version, remoteRepo, remoteUsername) { + assertModulesFolderSetting(x = Sys.getenv("INSTANTIATED_MODULES_FOLDER")) instantiatedModulesFolder <- Sys.getenv("INSTANTIATED_MODULES_FOLDER") - if (instantiatedModulesFolder == "") { - stop("The INSTANTIATED_MODULES_FOLDER environment variable has not been set.") - } if (!dir.exists(instantiatedModulesFolder)) { dir.create(instantiatedModulesFolder, recursive = TRUE) } diff --git a/R/ResultModelCreation.R b/R/ResultModelCreation.R index 2446561a..9b4dfec0 100644 --- a/R/ResultModelCreation.R +++ b/R/ResultModelCreation.R @@ -141,7 +141,11 @@ runSchemaCreation <- function(analysisSpecifications, keyringSettings, moduleInd version <- moduleSpecification$version remoteRepo <- moduleSpecification$remoteRepo remoteUsername <- moduleSpecification$remoteUsername - moduleFolder <- ensureModuleInstantiated(module, version, remoteRepo, remoteUsername) + moduleInstallation <- verifyModuleInstallation(module, version) + moduleFolder <- moduleInstallation$moduleFolder + if (isFALSE(moduleInstallation$moduleInstalled)) { + stop("Stopping since module is not properly installed!") + } # Create job context moduleExecutionSettings <- executionSettings diff --git a/R/ResultsUpload.R b/R/ResultsUpload.R index 0a3ad60a..dfd2752d 100644 --- a/R/ResultsUpload.R +++ b/R/ResultsUpload.R @@ -24,7 +24,11 @@ runResultsUpload <- function(analysisSpecifications, keyringSettings, moduleInde version <- moduleSpecification$version remoteRepo <- moduleSpecification$remoteRepo remoteUsername <- moduleSpecification$remoteUsername - moduleFolder <- ensureModuleInstantiated(module, version, remoteRepo, remoteUsername) + moduleInstallation <- verifyModuleInstallation(module, version) + moduleFolder <- moduleInstallation$moduleFolder + if (isFALSE(moduleInstallation$moduleInstalled)) { + stop("Stopping since module is not properly installed!") + } # Create job context moduleExecutionSettings <- executionSettings diff --git a/R/RunModule.R b/R/RunModule.R index d7087afb..932a8858 100644 --- a/R/RunModule.R +++ b/R/RunModule.R @@ -28,7 +28,11 @@ runModule <- function(analysisSpecifications, keyringSettings, moduleIndex, exec version <- moduleSpecification$version remoteRepo <- moduleSpecification$remoteRepo remoteUsername <- moduleSpecification$remoteUsername - moduleFolder <- ensureModuleInstantiated(module, version, remoteRepo, remoteUsername) + moduleInstallation <- verifyModuleInstallation(module, version) + moduleFolder <- moduleInstallation$moduleFolder + if (isFALSE(moduleInstallation$moduleInstalled)) { + stop("Stopping since module is not properly installed!") + } # Create job context moduleExecutionSettings <- executionSettings diff --git a/R/Settings.R b/R/Settings.R index fe2a72f3..3106ed39 100644 --- a/R/Settings.R +++ b/R/Settings.R @@ -355,6 +355,15 @@ unlockKeyring <- function(keyringName) { } } +#' @keywords internal +.checkModuleFolderSetting <- function(x) { + if (length(x) == 0 || x == "") { + return(paste0("INSTANTIATED_MODULES_FOLDER environment variable has not been set. INSTANTIATED_MODULES_FOLDER must be set using Sys.setenv(INSTANTIATED_MODULES_FOLDER = \"/somepath\")")) + } else { + return(TRUE) + } +} + #' Used when serializing connection details to retain NULL values #' #' @keywords internal diff --git a/R/Strategus.R b/R/Strategus.R index 5f8c93f6..6cfdb25e 100644 --- a/R/Strategus.R +++ b/R/Strategus.R @@ -26,3 +26,4 @@ NULL # Add custom asssertions assertKeyringPassword <- checkmate::makeAssertionFunction(.checkKeyringPasswordSet) +assertModulesFolderSetting <- checkmate::makeAssertionFunction(.checkModuleFolderSetting) diff --git a/inst/testdata/analysisSpecification.json b/inst/testdata/analysisSpecification.json index 4ecb641d..bf417726 100644 --- a/inst/testdata/analysisSpecification.json +++ b/inst/testdata/analysisSpecification.json @@ -223,7 +223,7 @@ "moduleSpecifications": [ { "module": "CohortGeneratorModule", - "version": "0.2.0", + "version": "0.2.1", "remoteRepo": "github.com", "remoteUsername": "ohdsi", "settings": { @@ -292,7 +292,7 @@ }, { "module": "CohortIncidenceModule", - "version": "0.1.0", + "version": "0.3.0", "remoteRepo": "github.com", "remoteUsername": "ohdsi", "settings": { @@ -489,7 +489,7 @@ }, { "module": "CohortMethodModule", - "version": "0.2.0", + "version": "0.2.1", "remoteRepo": "github.com", "remoteUsername": "ohdsi", "settings": { @@ -1341,7 +1341,7 @@ }, { "module": "SelfControlledCaseSeriesModule", - "version": "0.2.0", + "version": "0.3.2", "remoteRepo": "github.com", "remoteUsername": "ohdsi", "settings": { @@ -2360,7 +2360,7 @@ }, { "module": "PatientLevelPredictionModule", - "version": "0.2.0", + "version": "0.2.1", "remoteRepo": "github.com", "remoteUsername": "ohdsi", "settings": [ diff --git a/man/verifyModuleInstallation.Rd b/man/verifyModuleInstallation.Rd new file mode 100644 index 00000000..5c535096 --- /dev/null +++ b/man/verifyModuleInstallation.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ModuleInstantiation.R +\name{verifyModuleInstallation} +\alias{verifyModuleInstallation} +\title{Verify a module is properly installed} +\usage{ +verifyModuleInstallation(module, version, forceVerification = FALSE) +} +\arguments{ +\item{module}{The name of the module to verify (i.e. "CohortGeneratorModule")} + +\item{version}{The version of the module to verify (i.e. "0.2.1")} + +\item{forceVerification}{When set to TRUE, the verification process is forced +to re-evaluate if the module is properly installed. The default is FALSE +since if the module is successfully validated by this function, it will cache +the hash value of the module's renv.lock file in the file system so it can +by-pass running this check every time.} +} +\value{ +A list with an attribute for the installation status and the +output of the consistency check +} +\description{ +In some instances a module may fail to instantiate and install due to problems +when calling renv::restore for the module's renv.lock file. This function +will allow you to surface inconsistencies between the module renv.lock file +and the module's renv project library. This function will check to that a +module has been properly installed using internal functions of the \code{renv} +package. If a module is verified to work via this function, the hash of +the module's renv.lock file will be written to a text file in the module +directory to indicate that it is ready for use. This will allow subsequent +calls to work faster since the initial verification process can take some +time.It is possible to re-run the verification of a module +by using the \code{forceVerification} parameter. + +To fix issues with a module, you will need to open the module's .Rproj in +RStudio instance and debug the issues when calling renv::restore(). +} diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index a8b35c1b..3eb8535e 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -34,17 +34,17 @@ if (dir.exists(Sys.getenv("DATABASECONNECTOR_JAR_FOLDER"))) { tableSuffix <- paste0(substr(.Platform$OS.type, 1, 3), format(Sys.time(), "%y%m%d%H%M%S"), sample(1:100, 1)) tableSuffix <- abs(digest::digest2int(tableSuffix)) -tempDir <- tempfile() # "D:" +tempDir <- "C:/TEMP/strategus_test" #tempfile() tempDir <- gsub("\\\\", "/", tempDir) # Correct windows path renvCachePath <- file.path(tempDir, "strategus/renv") moduleFolder <- file.path(tempDir, "strategus/modules") Sys.setenv("INSTANTIATED_MODULES_FOLDER" = moduleFolder) -withr::defer( - { - unlink(c(tempDir, renvCachePath, moduleFolder), recursive = TRUE, force = TRUE) - }, - testthat::teardown_env() -) +# withr::defer( +# { +# unlink(c(tempDir, renvCachePath, moduleFolder), recursive = TRUE, force = TRUE) +# }, +# testthat::teardown_env() +# ) # Assemble a list of connectionDetails for the tests ----------- connectionDetailsList <- list() From fb092b7735c35a39ad2ca00bcd3f93f32ca62404 Mon Sep 17 00:00:00 2001 From: Anthony Sena Date: Wed, 13 Dec 2023 14:02:41 -0500 Subject: [PATCH 2/4] Prevent execution when modules are not verified --- R/Execution.R | 5 ++- R/ModuleInstantiation.R | 66 +++++++++++++++++++++-------- R/ResultModelCreation.R | 3 ++ man-roxygen/forceVerification.R | 5 +++ man/ensureAllModulesInstantiated.Rd | 12 +++++- man/verifyModuleInstallation.Rd | 16 ++++--- tests/testthat/setup.R | 14 +++--- 7 files changed, 88 insertions(+), 33 deletions(-) create mode 100644 man-roxygen/forceVerification.R diff --git a/R/Execution.R b/R/Execution.R index c4e29680..727f3a4f 100644 --- a/R/Execution.R +++ b/R/Execution.R @@ -61,6 +61,9 @@ execute <- function(analysisSpecifications, ) } modules <- ensureAllModulesInstantiated(analysisSpecifications) + if (isFALSE(modules$allModulesInstalled)) { + stop("Stopping execution due to module issues") + } if (is.null(executionScriptFolder)) { executionScriptFolder <- tempfile("strategusTempSettings") @@ -79,7 +82,7 @@ execute <- function(analysisSpecifications, keyringName = keyringName ) } - dependencies <- extractDependencies(modules) + dependencies <- extractDependencies(modules$modules) fileName <- generateTargetsScript( diff --git a/R/ModuleInstantiation.R b/R/ModuleInstantiation.R index 5b3dd856..674664cc 100644 --- a/R/ModuleInstantiation.R +++ b/R/ModuleInstantiation.R @@ -29,11 +29,15 @@ #' #' @template AnalysisSpecifications #' +#' @template forceVerification +#' #' @return -#' A tibble listing the instantiated modules. +#' A list containing the install status of all modules +#' (TRUE if all are installed properly) and a tibble listing +#' the instantiated modules. #' #' @export -ensureAllModulesInstantiated <- function(analysisSpecifications) { +ensureAllModulesInstantiated <- function(analysisSpecifications, force = FALSE) { modules <- getModuleTable(analysisSpecifications, distinct = TRUE) # Verify only one version per module: @@ -78,13 +82,30 @@ ensureAllModulesInstantiated <- function(analysisSpecifications) { for (i in 1:nrow(modules)) { status <- verifyModuleInstallation( module = modules$module[i], - version = modules$version[i] + version = modules$version[i], + forceVerification = forceVerification ) - moduleInstallStatus <- append(status, moduleInstallStatus) + moduleInstallStatus[[length(moduleInstallStatus) + 1]] <- status } attr(modules, 'moduleInstallStatus') <- moduleInstallStatus - return(modules) + installStatus <- unlist(lapply(moduleInstallStatus, FUN = function(x) { x$moduleInstalled })) + if (!all(installStatus)) { + problemModules <- status[!installStatus] + message("There were ", length(problemModules), " issue(s) found with your Strategus modules!") + for (i in seq_along(problemModules)) { + message("Issue #", i, ": Module ", problemModules[[i]]$moduleFolder, " could not install the following R packages:") + print(problemModules[[i]]$issues) + } + message("To fix these issues, open the module project at the path specified above and re-run \"renv::restore()\" and correct all issues") + } + + return( + list( + allModulesInstalled = all(installStatus), + modules = modules + ) + ) } @@ -110,17 +131,15 @@ ensureAllModulesInstantiated <- function(analysisSpecifications) { #' #' @param version The version of the module to verify (i.e. "0.2.1") #' -#' @param forceVerification When set to TRUE, the verification process is forced -#' to re-evaluate if the module is properly installed. The default is FALSE -#' since if the module is successfully validated by this function, it will cache -#' the hash value of the module's renv.lock file in the file system so it can -#' by-pass running this check every time. +#' @param silent When TRUE output of this verification process is suppressed +#' +#' @template forceVerification #' #' @return #' A list with the output of the consistency check #' #' @export -verifyModuleInstallation <- function(module, version, forceVerification = FALSE) { +verifyModuleInstallation <- function(module, version, silent = FALSE, forceVerification = FALSE) { # Internal helper function verifyModuleInstallationReturnValue <- function(moduleFolder, moduleInstalled, issues = NULL) { returnVal <- list( @@ -133,7 +152,9 @@ verifyModuleInstallation <- function(module, version, forceVerification = FALSE) moduleFolder <- getModuleFolder(module, version) if (!dir.exists(moduleFolder)) { - warn("Module ", module, ", Version: ", version, " not found at: ", moduleFolder, ". This means the module was never installed.") + if (!silent) { + warn("Module ", module, ", Version: ", version, " not found at: ", moduleFolder, ". This means the module was never installed.") + } return( verifyModuleInstallationReturnValue( moduleFolder = moduleFolder, @@ -142,14 +163,17 @@ verifyModuleInstallation <- function(module, version, forceVerification = FALSE) ) } - message("Verifying module: ", module, ", (", version, ") at ", moduleFolder, "...", appendLF = F) - + if (!silent) { + message("Verifying module: ", module, ", (", version, ") at ", moduleFolder, "...", appendLF = F) + } moduleStatusFileName <- "moduleStatus.txt" renvLockFileName <- "renv.lock" # If the lock file doesn't exist, we're not sure if we're dealing with a module. if (!file.exists(file.path(moduleFolder, renvLockFileName))) { - message("ERROR - renv.lock file missing.") + if (!silent) { + message("ERROR - renv.lock file missing.") + } return( verifyModuleInstallationReturnValue( moduleFolder = moduleFolder, @@ -176,7 +200,9 @@ verifyModuleInstallation <- function(module, version, forceVerification = FALSE) # If the values match, the module is installed correctly # return and exit if (lockfileHashFromModuleStatusFile == lockfileHash) { - message("MODULE READY!") + if (!silent) { + message("MODULE READY!") + } return( verifyModuleInstallationReturnValue( moduleFolder = moduleFolder, @@ -253,7 +279,9 @@ verifyModuleInstallation <- function(module, version, forceVerification = FALSE) moduleInstalled <- nrow(issues) == 0 if (isTRUE(moduleInstalled)) { - message("MODULE READY!") + if (!silent) { + message("MODULE READY!") + } # Write the contents of the md5 hash of the module's # renv.lock file to the file system to note that the # module's install status was successful and verified @@ -262,7 +290,9 @@ verifyModuleInstallation <- function(module, version, forceVerification = FALSE) targetFile = file.path(moduleFolder, "moduleStatus.txt") ) } else { - message("MODULE HAS ISSUES!") + if (!silent) { + message("MODULE HAS ISSUES!") + } } return( diff --git a/R/ResultModelCreation.R b/R/ResultModelCreation.R index 9b4dfec0..53b3ee3f 100644 --- a/R/ResultModelCreation.R +++ b/R/ResultModelCreation.R @@ -36,6 +36,9 @@ createResultDataModels <- function(analysisSpecifications, checkmate::reportAssertions(collection = errorMessages) modules <- ensureAllModulesInstantiated(analysisSpecifications) + if (isFALSE(modules$allModulesInstalled)) { + stop("Stopping execution due to module issues") + } if (is.null(executionScriptFolder)) { diff --git a/man-roxygen/forceVerification.R b/man-roxygen/forceVerification.R new file mode 100644 index 00000000..540cf869 --- /dev/null +++ b/man-roxygen/forceVerification.R @@ -0,0 +1,5 @@ +#' @param forceVerification When set to TRUE, the verification process is forced +#' to re-evaluate if a module is properly installed. The default is FALSE +#' since if a module is successfully validated, the module will contain +#' the hash value of the module's renv.lock file in the file system so it can +#' by-pass running this check every time. diff --git a/man/ensureAllModulesInstantiated.Rd b/man/ensureAllModulesInstantiated.Rd index e672a528..8334cd65 100644 --- a/man/ensureAllModulesInstantiated.Rd +++ b/man/ensureAllModulesInstantiated.Rd @@ -4,14 +4,22 @@ \alias{ensureAllModulesInstantiated} \title{Ensure all modules are instantiated} \usage{ -ensureAllModulesInstantiated(analysisSpecifications) +ensureAllModulesInstantiated(analysisSpecifications, force = FALSE) } \arguments{ \item{analysisSpecifications}{An object of type \code{AnalysisSpecifications} as created by \code{\link[=createEmptyAnalysisSpecificiations]{createEmptyAnalysisSpecificiations()}}.} + +\item{forceVerification}{When set to TRUE, the verification process is forced +to re-evaluate if a module is properly installed. The default is FALSE +since if a module is successfully validated, the module will contain +the hash value of the module's renv.lock file in the file system so it can +by-pass running this check every time.} } \value{ -A tibble listing the instantiated modules. +A list containing the install status of all modules +(TRUE if all are installed properly) and a tibble listing +the instantiated modules. } \description{ Ensure that all modules referenced in the analysis specifications are instantiated diff --git a/man/verifyModuleInstallation.Rd b/man/verifyModuleInstallation.Rd index 5c535096..d0b96c1b 100644 --- a/man/verifyModuleInstallation.Rd +++ b/man/verifyModuleInstallation.Rd @@ -4,22 +4,28 @@ \alias{verifyModuleInstallation} \title{Verify a module is properly installed} \usage{ -verifyModuleInstallation(module, version, forceVerification = FALSE) +verifyModuleInstallation( + module, + version, + silent = FALSE, + forceVerification = FALSE +) } \arguments{ \item{module}{The name of the module to verify (i.e. "CohortGeneratorModule")} \item{version}{The version of the module to verify (i.e. "0.2.1")} +\item{silent}{When TRUE output of this verification process is suppressed} + \item{forceVerification}{When set to TRUE, the verification process is forced -to re-evaluate if the module is properly installed. The default is FALSE -since if the module is successfully validated by this function, it will cache +to re-evaluate if a module is properly installed. The default is FALSE +since if a module is successfully validated, the module will contain the hash value of the module's renv.lock file in the file system so it can by-pass running this check every time.} } \value{ -A list with an attribute for the installation status and the -output of the consistency check +A list with the output of the consistency check } \description{ In some instances a module may fail to instantiate and install due to problems diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 3eb8535e..700aae1f 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -34,17 +34,17 @@ if (dir.exists(Sys.getenv("DATABASECONNECTOR_JAR_FOLDER"))) { tableSuffix <- paste0(substr(.Platform$OS.type, 1, 3), format(Sys.time(), "%y%m%d%H%M%S"), sample(1:100, 1)) tableSuffix <- abs(digest::digest2int(tableSuffix)) -tempDir <- "C:/TEMP/strategus_test" #tempfile() +tempDir <- tempfile() tempDir <- gsub("\\\\", "/", tempDir) # Correct windows path renvCachePath <- file.path(tempDir, "strategus/renv") moduleFolder <- file.path(tempDir, "strategus/modules") Sys.setenv("INSTANTIATED_MODULES_FOLDER" = moduleFolder) -# withr::defer( -# { -# unlink(c(tempDir, renvCachePath, moduleFolder), recursive = TRUE, force = TRUE) -# }, -# testthat::teardown_env() -# ) +withr::defer( + { + unlink(c(tempDir, renvCachePath, moduleFolder), recursive = TRUE, force = TRUE) + }, + testthat::teardown_env() +) # Assemble a list of connectionDetails for the tests ----------- connectionDetailsList <- list() From 37543a249bf75940dca3e7f975f0d10640d74fbc Mon Sep 17 00:00:00 2001 From: Anthony Sena Date: Wed, 13 Dec 2023 14:57:19 -0500 Subject: [PATCH 3/4] Fix parameter name mismatch --- R/ModuleInstantiation.R | 2 +- man/ensureAllModulesInstantiated.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/ModuleInstantiation.R b/R/ModuleInstantiation.R index 674664cc..33622fda 100644 --- a/R/ModuleInstantiation.R +++ b/R/ModuleInstantiation.R @@ -37,7 +37,7 @@ #' the instantiated modules. #' #' @export -ensureAllModulesInstantiated <- function(analysisSpecifications, force = FALSE) { +ensureAllModulesInstantiated <- function(analysisSpecifications, forceVerification = FALSE) { modules <- getModuleTable(analysisSpecifications, distinct = TRUE) # Verify only one version per module: diff --git a/man/ensureAllModulesInstantiated.Rd b/man/ensureAllModulesInstantiated.Rd index 8334cd65..7d9e2ff9 100644 --- a/man/ensureAllModulesInstantiated.Rd +++ b/man/ensureAllModulesInstantiated.Rd @@ -4,7 +4,7 @@ \alias{ensureAllModulesInstantiated} \title{Ensure all modules are instantiated} \usage{ -ensureAllModulesInstantiated(analysisSpecifications, force = FALSE) +ensureAllModulesInstantiated(analysisSpecifications, forceVerification = FALSE) } \arguments{ \item{analysisSpecifications}{An object of type \code{AnalysisSpecifications} as created From 8924173ae0ccab16ea7ccdfac51d680947774989 Mon Sep 17 00:00:00 2001 From: Anthony Sena Date: Fri, 15 Dec 2023 19:14:37 -0500 Subject: [PATCH 4/4] Revise to use renv public functions only --- R/ModuleInstantiation.R | 40 +++++++++++++++++++--------------------- 1 file changed, 19 insertions(+), 21 deletions(-) diff --git a/R/ModuleInstantiation.R b/R/ModuleInstantiation.R index 33622fda..9db6724f 100644 --- a/R/ModuleInstantiation.R +++ b/R/ModuleInstantiation.R @@ -91,13 +91,13 @@ ensureAllModulesInstantiated <- function(analysisSpecifications, forceVerificati installStatus <- unlist(lapply(moduleInstallStatus, FUN = function(x) { x$moduleInstalled })) if (!all(installStatus)) { - problemModules <- status[!installStatus] + problemModules <- moduleInstallStatus[!installStatus] message("There were ", length(problemModules), " issue(s) found with your Strategus modules!") for (i in seq_along(problemModules)) { message("Issue #", i, ": Module ", problemModules[[i]]$moduleFolder, " could not install the following R packages:") print(problemModules[[i]]$issues) } - message("To fix these issues, open the module project at the path specified above and re-run \"renv::restore()\" and correct all issues") + message("To fix these issues, open the module project (.Rproj file) at the path specified above and re-run \"renv::restore()\" and correct all issues") } return( @@ -227,22 +227,21 @@ verifyModuleInstallation <- function(module, version, silent = FALSE, forceVerif # the project from the renv.lock file. projectStatus <- renv::status() - # Get the packages in the project - adapted from - # https://github.com/rstudio/renv/blob/v1.0.3/R/status.R - project <- renv:::renv_project_resolve() - libpaths <- renv:::renv_libpaths_resolve() - dependencies <- renv:::renv_snapshot_dependencies(project, dev = FALSE) - packages <- sort(union(dependencies, "renv")) - paths <- renv:::renv_package_dependencies(packages, libpaths = libpaths, project = project) - packages <- as.character(names(paths)) - # remove ignored packages - ignored <- c( - renv:::renv_project_ignored_packages(project), - renv:::renv_packages_base() - ) - packages <- setdiff(packages, ignored) + # Identify the list of package dependencies by using + # the data returned from renv::status() and + # renv::dependencies for the project. + library <- names(projectStatus$library$Packages) + lockfile <- names(projectStatus$lockfile$Packages) + packages <- sort(union(renv::dependencies(quiet = TRUE)$Package, "renv")) + packages <- sort(unique(c(library, lockfile, packages))) projectStatus$packages <- packages - saveRDS(projectStatus, file="projectStatus.rds") + saveRDS(object = list( + library = library, + lockfile = lockfile, + packages = packages + ), + file="projectStatus.rds" + ) }, moduleFolder = moduleFolder ) @@ -252,10 +251,9 @@ verifyModuleInstallation <- function(module, version, silent = FALSE, forceVerif # to determine the restoration status projectStatus <- readRDS(file.path(moduleFolder, "projectStatus.rds")) - library <- names(projectStatus$library$Packages) - lockfile <- names(projectStatus$lockfile$Packages) - - packages <- sort(unique(c(library, lockfile, projectStatus$packages))) + library <- projectStatus$library + lockfile <- projectStatus$lockfile + packages <- projectStatus$packages packageStatus <- data.frame( package = packages,