Adding renv.lock helper functions

DESCRIPTION

@@ -32,7 +32,8 @@ Imports:
   methods,
   tibble,
   ResultModelManager (>= 0.3.0),
-  SqlRender (>= 1.11.0)
+  SqlRender (>= 1.11.0),
+  semver
 Suggests:
   testthat (>= 3.0.0),
   fs,

NAMESPACE

@@ -2,6 +2,7 @@
 
 export(addModuleSpecifications)
 export(addSharedResources)
+export(compareLockFiles)
 export(createCdmExecutionSettings)
 export(createEmptyAnalysisSpecificiations)
 export(createResultDataModels)
@@ -11,7 +12,9 @@ export(execute)
 export(getModuleList)
 export(retrieveConnectionDetails)
 export(storeConnectionDetails)
+export(syncLockFile)
 export(unlockKeyring)
+export(validateLockFile)
 export(verifyModuleInstallation)
 import(CohortGenerator)
 import(DatabaseConnector)

R/ModuleInstantiation.R

@@ -426,7 +426,7 @@ getModuleRenvDependencies <- function(moduleFolder) {
     ".Rprofile",
     "renv.lock",
     "renv/activate.R",
-    "renv/settings.dcf"
+    "renv/settings.json"
   )
 
   missingFiles <- tibble::enframe(renvRequiredFiles) %>%

R/RenvHelpers.R

@@ -0,0 +1,225 @@
+#' Compare two renv.lock files
+#'
+#' @description
+#' Used to compare renv.lock files and return the results in a data.frame.
+#' The return value will include a "full join" representation of the packages
+#' across the two lock files.
+#'
+#' @param filename1 The first renv.lock file name
+#'
+#' @param filename2 The second renv.lock file name
+#'
+#' @return
+#' A data.frame with the comparison of the rev.lock files
+#'
+#' @export
+compareLockFiles <- function(filename1, filename2) {
+  # Read the lock files
+  lockfile1 <- renv::lockfile_read(
+    file = filename1
+  )
+
+  lockfile2 <- renv::lockfile_read(
+    file = filename2
+  )
+
+  # Compare lock files
+  lockfile1Packages <- lockFileToDataFrame(lockfile1)
+  names(lockfile1Packages) <- paste0("lockfile1", names(lockfile1Packages))
+  lockfile2Packages <- lockFileToDataFrame(lockfile2)
+  names(lockfile2Packages) <- paste0("lockfile2", names(lockfile2Packages))
+  mergedLockFilePackages <- merge(
+    x = lockfile1Packages,
+    y = lockfile2Packages,
+    by.x = "lockfile1Name",
+    by.y = "lockfile2Name",
+    all = TRUE
+  )
+  return(mergedLockFilePackages)
+}
+
+#' Synchronize renv.lock files and overwrite the target file
+#' (read the description)
+#'
+#' @description
+#' Used to synchronize the values from the "source of truth" renv.lock file to
+#' the target renv.lock file. Packages are compared (by name) and if the version
+#' of the package in the "source of truth" is greater the one found in the
+#' target, the target renv.lock file will be updated. This function will
+#' automatically update the target file.
+#'
+#' Version comparison is handled by the `semver` package and since most packages
+#' use semantic versioning. When a package does not use semantic versioning,
+#' a warning is provided so the user can review.
+#'
+#' @param sourceOfTruthLockFileName The renv.lock file to use as the source of
+#'                                  truth
+#'
+#' @param targetLockFileName The target renv.lock file that will be synced with
+#'                           the source of truth
+#'
+#' @return
+#' A data.frame containing the different packages and their version that
+#' were involved in the synchronization process
+#'
+#' @export
+syncLockFile <- function(sourceOfTruthLockFileName, targetLockFileName) {
+  findPackageByName <- function(list, packageName) {
+    index <- which(sapply(list, function(x) x$Package == packageName))
+    return(index)
+  }
+
+  # Read the lock files
+  sourceOfTruthLockFile <- renv::lockfile_read(
+    file = sourceOfTruthLockFileName
+  )
+  targetLockFile <- renv::lockfile_read(
+    file = targetLockFileName
+  )
+
+  # Compare the lock files to get the differences in package versions
+  comparedLockFiles <- compareLockFiles(
+    filename1 = sourceOfTruthLockFileName,
+    filename2 = targetLockFileName
+  )
+  verDiffs <- comparedLockFiles[!is.na(comparedLockFiles$lockfile2Version) &
+                                  comparedLockFiles$lockfile1Version != comparedLockFiles$lockfile2Version,]
+  verDiffs <- verDiffs[!is.na(verDiffs$lockfile1Name),]
+
+  if (nrow(verDiffs) == 0) {
+    rlang::inform("Lock files are already in sync.")
+    return(invisible(NULL))
+  }
+
+  # Update the target lock file based on the source of truth
+  for (i in 1:nrow(verDiffs)) {
+    index <- findPackageByName(targetLockFile$Packages, verDiffs[i,]$lockfile1Name)
+    tryCatch(expr = {
+      semverPattern <- "^\\d+\\.\\d+\\.\\d+(?:-[0-9A-Za-z-]+(?:\\.[0-9A-Za-z-]+)*)?(?:\\+[0-9A-Za-z-]+)?$"
+      sourceOfTruthVersion <- verDiffs[i,]$lockfile1Version
+      targetVersion <- targetLockFile$Packages[[index]]$Version
+      if (grepl(semverPattern, sourceOfTruthVersion) && grepl(semverPattern, targetVersion)) {
+        sourceOfTruthVersion <- semver::parse_version(sourceOfTruthVersion)
+        targetVersion <- semver::parse_version(targetVersion)
+        if (sourceOfTruthVersion > targetVersion) {
+          rlang::inform(
+            message = paste(verDiffs[i,]$lockfile1Name, "[", targetVersion, "->", sourceOfTruthVersion, "]")
+          )
+          targetLockFile$Packages[[index]]$Version <- verDiffs[i,]$lockfile1Version
+          if (!is.na(verDiffs[i,]$lockfile1RemoteRef)) {
+            targetLockFile$Packages[[index]]$RemoteRef <- verDiffs[i,]$lockfile1RemoteRef
+          }
+        } else {
+          rlang::inform(
+            message = paste(verDiffs[i,]$lockfile1Name, "[ SKIPPING - ", targetVersion, ">", sourceOfTruthVersion, "]")
+          )
+        }
+      } else {
+        rlang::warn(paste0("Package: [", verDiffs[i,]$lockfile1Name, "] - version number could not be parsed. Please inspect manually as it may require an upgrade."))
+      }
+    }, error = function(err) {
+      rlang::inform("An error occurred:", str(err), "\n")
+    })
+  }
+
+  # Save the updated lock file
+  renv::lockfile_write(
+    lockfile = targetLockFile,
+    file = targetLockFileName
+  )
+
+  return(invisible(verDiffs))
+}
+
+#' Validate an renv.lock file to ensure it is ready for use by Strategus
+#'
+#' @description
+#' Will check an renv.lock file for a module to verify that it only references
+#' tagged packages and includes the packages required by Strategus. It will
+#' also check for suggested packages that are useful for testing, such as
+#' RSQLite.
+#'
+#' @param filename The renv.lock file to validate
+#'
+#' @export
+validateLockFile <- function(filename) {
+  # Read the lock file
+  lockFile <- renv::lockfile_read(
+    file = filename
+  )
+  # Create a data.frame from the renv.lock file
+  df <- lockFileToDataFrame(
+    lf = lockFile
+  )
+
+  # Check that the mandatory dependencies are met
+  message("Checking mandatory packages...", appendLF = F)
+  if (length(mandatoryPackages()) != nrow(df[df$Name %in% mandatoryPackages(),])) {
+    missingPkgs <- setdiff(mandatoryPackages(), df[df$Name %in% mandatoryPackages(),]$Name)
+    message("FAILED!")
+    message(" -- Missing the mandatory packages: ", paste(missingPkgs, collapse = ", "))
+    message(" Please record these missing dependencies in your renv.lock file.")
+  } else {
+    message("PASSED!")
+  }
+
+  # Check for suggested packages
+  message("Checking suggested packages...", appendLF = F)
+  if (length(suggestedPacakges()) != nrow(df[df$Name %in% suggestedPacakges(),])) {
+    missingPkgs <- setdiff(suggestedPacakges(), df[df$Name %in% suggestedPacakges(),]$Name)
+    message("WARNING!")
+    message(" -- Missing the suggested packages: ", paste(missingPkgs, collapse = ", "))
+    message(" This is an optional set of dependencies so you may decide if you wish to have them in your renv.lock file.")
+  } else {
+    message("PASSED!")
+  }
+
+  # Check that we're using declared versions of all packages
+  message("Checking all package using tagged versions in RemoteRef...", appendLF = F)
+  # Start by filtering out the CRAN Repository entries
+  dfFiltered <- df[tolower(df$Source) != "repository",]
+  if (!all(grepl("^(v)?\\d+(\\.\\d+){2}$", dfFiltered$RemoteRef))) {
+    message("FAILED! Please check the following packages:")
+    problemPkgs <- dfFiltered[!grepl("^(v)?\\d+(\\.\\d+){2}$", dfFiltered$RemoteRef),]
+    for (i in 1:nrow(problemPkgs)) {
+      message(paste0(" -- Package: ", problemPkgs$Name[[i]], "; RemoteRef: ", problemPkgs$RemoteRef[[i]]))
+    }
+    message(" Please ensure you are only including tagged versions of package dependencies in your renv.lock file.")
+  } else {
+    message("PASSED!")
+  }
+}
+
+mandatoryPackages <- function() {
+  return(c(
+    "CohortGenerator",
+    "DatabaseConnector",
+    "keyring",
+    "ParallelLogger",
+    "renv",
+    "SqlRender"
+  ))
+}
+
+suggestedPacakges <- function() {
+  return(c("RSQLite"))
+}
+
+
+# internal function to read lock file into data frame
+lockFileToDataFrame <- function(lf) {
+  df <- data.frame()
+  for (i in 1:length(lf$Packages)) {
+    df <- rbind(
+      df,
+      data.frame(
+        Name = lf$Packages[[i]]$Package,
+        Version = lf$Packages[[i]]$Version,
+        Source = lf$Packages[[i]]$Source,
+        RemoteRef = ifelse(is.null(lf$Packages[[i]]$RemoteRef), yes = NA, no = lf$Packages[[i]]$RemoteRef)
+      )
+    )
+  }
+  return(df)
+}
+

R/ResultsUpload.R

@@ -94,7 +94,7 @@
         # If the keyring is locked, unlock it, set the value and then re-lock it
         ParallelLogger::logInfo("-- Getting result database credentials")
         keyringName <- jobContext$keyringSettings$keyringName
-        keyringLocked <- Strategus::unlockKeyring(keyringName = keyringName)
+        keyringLocked <- unlockKeyring(keyringName = keyringName)
         resultsConnectionDetails <- keyring::key_get(jobContext$moduleExecutionSettings$resultsConnectionDetailsReference, keyring = keyringName)
         resultsConnectionDetails <- ParallelLogger::convertJsonToSettings(resultsConnectionDetails)
         resultsConnectionDetails <- do.call(DatabaseConnector::createConnectionDetails, resultsConnectionDetails)

R/RunModule.R

@@ -28,10 +28,10 @@
   version <- moduleSpecification$version
   remoteRepo <- moduleSpecification$remoteRepo
   remoteUsername <- moduleSpecification$remoteUsername
-  moduleInstallation <- verifyModuleInstallation(module, version, silent = TRUE)
+  moduleInstallation <- verifyModuleInstallation(module, version)
   moduleFolder <- moduleInstallation$moduleFolder
   if (isFALSE(moduleInstallation$moduleInstalled)) {
-    stop("Stopping since module is not properly installed!")
+    stop(paste0("Stopping since module is not properly installed! Module folder: ", moduleInstallation$moduleFolder))
   }
 
   # Create job context

extras/PackageMaintenance.R

@@ -127,7 +127,8 @@ testModuleFilesToRemove <- c(
 )
 testModuleDirToRemove <- c(
   file.path(testModuleRootFolder, ".Rproj.user"),
-  file.path(testModuleRootFolder, "renv/library")
+  file.path(testModuleRootFolder, "renv/library"),
+  file.path(testModuleRootFolder, "renv/profiles/dev/renv/library")
 )
 unlink(testModuleFilesToRemove)
 unlink(testModuleDirToRemove, recursive = TRUE)

extras/TestModule1-0.0.1/.renvignore

@@ -1,3 +1,4 @@
 SettingsFunctions.R
 
 extras/
+/tests/

extras/TestModule1-0.0.1/Main.R

@@ -1,4 +1,4 @@
-# Copyright 2023 Observational Health Data Sciences and Informatics
+# Copyright 2024 Observational Health Data Sciences and Informatics
 #
 # This file is part of Strategus
 #
@@ -14,6 +14,16 @@
 # See the License for the specific language governing permissions and
 # limitations under the License.
 
+# Adding library references that are required for Strategus
+library(CohortGenerator)
+library(DatabaseConnector)
+library(keyring)
+library(ParallelLogger)
+library(SqlRender)
+
+# Adding RSQLite so that we can test modules with Eunomia
+library(RSQLite)
+
 execute <- function(jobContext) {
   rlang::inform("Validating inputs")
   checkmate::assert_list(x = jobContext)
@@ -66,7 +76,7 @@ execute <- function(jobContext) {
   message("Exporting data")
   moduleInfo <- getModuleInfo()
   resultsFolder <- jobContext$moduleExecutionSettings$resultsSubFolder
-  fileName <- file.path(resultsFolder, paste0(moduleInfo$TablePrefix, "data.csv"))
+  fileName <- file.path(resultsFolder, paste0(moduleInfo$TablePrefix, "unit_test.csv"))
   readr::write_csv(data, fileName)
 
   # Set the table names in resultsDataModelSpecification.csv