OHDSI · anthonysena · Jan 13, 2024 · Jan 13, 2024
diff --git a/R/Execution.R b/R/Execution.R
@@ -110,6 +110,8 @@ execute <- function(analysisSpecifications,
     }
     dir.create(executionScriptFolder, recursive = TRUE)
   }
+  # Normalize path to convert from relative to absolute path
+  executionScriptFolder <- normalizePath(executionScriptFolder, mustWork = F)
 
   if (is(executionSettings, "CdmExecutionSettings")) {
     executionSettings$databaseId <- createDatabaseMetaData(
@@ -192,11 +194,11 @@ generateTargetsScript <- function(analysisSpecifications, executionSettings, dep
   )
 
   # Store settings objects in the temp folder so they are available in targets
-  analysisSpecificationsFileName <- gsub("\\\\", "/", file.path(executionScriptFolder, "analysisSpecifications.rds"))
+  analysisSpecificationsFileName <- .formatAndNormalizeFilePathForScript(file.path(executionScriptFolder, "analysisSpecifications.rds"))
   saveRDS(analysisSpecifications, analysisSpecificationsFileName)
-  executionSettingsFileName <- gsub("\\\\", "/", file.path(executionScriptFolder, "executionSettings.rds"))
+  executionSettingsFileName <- .formatAndNormalizeFilePathForScript(file.path(executionScriptFolder, "executionSettings.rds"))
   saveRDS(executionSettings, executionSettingsFileName)
-  keyringSettingsFileName <- gsub("\\\\", "/", file.path(executionScriptFolder, "keyringSettings.rds"))
+  keyringSettingsFileName <- .formatAndNormalizeFilePathForScript(file.path(executionScriptFolder, "keyringSettings.rds"))
   saveRDS(list(keyringName = keyringName), keyringSettingsFileName)
 
   # Generate target names by module type
@@ -210,10 +212,10 @@ generateTargetsScript <- function(analysisSpecifications, executionSettings, dep
     )
   }
   moduleToTargetNames <- bind_rows(moduleToTargetNames)
-  moduleToTargetNamesFileName <- gsub("\\\\", "/", file.path(executionScriptFolder, "moduleTargetNames.rds"))
+  moduleToTargetNamesFileName <- .formatAndNormalizeFilePathForScript(file.path(executionScriptFolder, "moduleTargetNames.rds"))
   saveRDS(moduleToTargetNames, moduleToTargetNamesFileName)
 
-  dependenciesFileName <- gsub("\\\\", "/", file.path(executionScriptFolder, "dependencies.rds"))
+  dependenciesFileName <- .formatAndNormalizeFilePathForScript(file.path(executionScriptFolder, "dependencies.rds"))
   saveRDS(dependencies, dependenciesFileName)
 
   execResultsUpload <- all(c(

diff --git a/R/ModuleEnv.R b/R/ModuleEnv.R
@@ -78,6 +78,12 @@ withModuleRenv <- function(code,
     }
   }
 
+  # Turning off verbose output to hide renv output
+  # unless the user has set this option to TRUE.
+  if (!getOption(x = "renv.verbose", default = FALSE)) {
+    options(renv.verbose = FALSE)
+  }
+
   # Import the Strategus functions we need to use in the module scripts
   script <- c("retrieveConnectionDetails <- ", base::deparse(Strategus::retrieveConnectionDetails), script)
   script <- c("unlockKeyring <- ", base::deparse(Strategus::unlockKeyring), script)
@@ -111,3 +117,7 @@ withModuleRenv <- function(code,
     paste0("# option = ", optionName, " - could not be passed to this file, likely because it is a function.")
   }
 }
+
+.formatAndNormalizeFilePathForScript <- function(filePath) {
+  return(gsub("\\\\", "/", normalizePath(path = filePath, mustWork = F)))
+}
diff --git a/R/ModuleInstantiation.R b/R/ModuleInstantiation.R
@@ -153,7 +153,7 @@
   moduleFolder <- getModuleFolder(module, version)
   if (!dir.exists(moduleFolder)) {
     if (!silent) {
-      warn("Module ", module, ", Version: ", version, " not found at: ", moduleFolder, ". This means the module was never installed.")
+      warning("Module ", module, ", Version: ", version, " not found at: ", moduleFolder, ". This means the module was never installed.")
     }
     return(
       verifyModuleInstallationReturnValue(
@@ -217,11 +217,6 @@
   # 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.

diff --git a/R/ResultModelCreation.R b/R/ResultModelCreation.R
@@ -51,6 +51,8 @@ createResultDataModels <- function(analysisSpecifications,
     }
     dir.create(executionScriptFolder, recursive = TRUE)
   }
+  # Normalize path to convert from relative to absolute path
+  executionScriptFolder <- normalizePath(executionScriptFolder, mustWork = F)
 
   script <- file.path(executionScriptFolder, "SchemaScript.R")
   ##
@@ -88,11 +90,11 @@ createResultDataModels <- function(analysisSpecifications,
   )
 
   # Store settings objects in the temp folder so they are available in targets
-  analysisSpecificationsFileName <- gsub("\\\\", "/", file.path(executionScriptFolder, "analysisSpecifications.rds"))
+  analysisSpecificationsFileName <- .formatAndNormalizeFilePathForScript(file.path(executionScriptFolder, "analysisSpecifications.rds"))
   saveRDS(analysisSpecifications, analysisSpecificationsFileName)
-  executionSettingsFileName <- gsub("\\\\", "/", file.path(executionScriptFolder, "executionSettings.rds"))
+  executionSettingsFileName <- .formatAndNormalizeFilePathForScript(file.path(executionScriptFolder, "executionSettings.rds"))
   saveRDS(executionSettings, executionSettingsFileName)
-  keyringSettingsFileName <- gsub("\\\\", "/", file.path(executionScriptFolder, "keyringSettings.rds"))
+  keyringSettingsFileName <- .formatAndNormalizeFilePathForScript(file.path(executionScriptFolder, "keyringSettings.rds"))
   saveRDS(list(keyringName = keyringName), keyringSettingsFileName)
 
   # Generate target names by module type
@@ -106,7 +108,7 @@ createResultDataModels <- function(analysisSpecifications,
     )
   }
   moduleToTargetNames <- bind_rows(moduleToTargetNames)
-  moduleToTargetNamesFileName <- gsub("\\\\", "/", file.path(executionScriptFolder, "moduleTargetNames.rds"))
+  moduleToTargetNamesFileName <- .formatAndNormalizeFilePathForScript(file.path(executionScriptFolder, "moduleTargetNames.rds"))
   saveRDS(moduleToTargetNames, moduleToTargetNamesFileName)
 
   # Settings required inside script. There is probably a much cleaner way of doing this
@@ -144,7 +146,7 @@ runSchemaCreation <- function(analysisSpecifications, keyringSettings, moduleInd
   version <- moduleSpecification$version
   remoteRepo <- moduleSpecification$remoteRepo
   remoteUsername <- moduleSpecification$remoteUsername
-  moduleInstallation <- verifyModuleInstallation(module, version)
+  moduleInstallation <- verifyModuleInstallation(module, version, silent = TRUE)
   moduleFolder <- moduleInstallation$moduleFolder
   if (isFALSE(moduleInstallation$moduleInstalled)) {
     stop("Stopping since module is not properly installed!")
@@ -168,12 +170,12 @@ runSchemaCreation <- function(analysisSpecifications, keyringSettings, moduleInd
     moduleExecutionSettings = moduleExecutionSettings,
     keyringSettings = keyringSettings
   )
-  jobContextFileName <- file.path(moduleExecutionSettings$workSubFolder, "jobContext.rds") # gsub("\\\\", "/", tempfile(fileext = ".rds"))
+  jobContextFileName <- .formatAndNormalizeFilePathForScript(file.path(moduleExecutionSettings$workSubFolder, "jobContext.rds"))
   saveRDS(jobContext, jobContextFileName)
-  dataModelExportPath <- file.path(moduleExecutionSettings$workSubFolder, "resultsDataModelSpecification.csv")
+  dataModelExportPath <- .formatAndNormalizeFilePathForScript(file.path(moduleExecutionSettings$workSubFolder, "resultsDataModelSpecification.csv"))
 
 
-  doneFile <- file.path(jobContext$moduleExecutionSettings$resultsSubFolder, "schema.creation")
+  doneFile <- .formatAndNormalizeFilePathForScript(file.path(jobContext$moduleExecutionSettings$resultsSubFolder, "schema.creation"))
   if (file.exists(doneFile)) {
     unlink(doneFile)
   }

diff --git a/R/ResultsUpload.R b/R/ResultsUpload.R
@@ -24,16 +24,16 @@ runResultsUpload <- function(analysisSpecifications, keyringSettings, moduleInde
   version <- moduleSpecification$version
   remoteRepo <- moduleSpecification$remoteRepo
   remoteUsername <- moduleSpecification$remoteUsername
-  moduleInstallation <- verifyModuleInstallation(module, version)
+  moduleInstallation <- verifyModuleInstallation(module, version, silent = TRUE)
   moduleFolder <- moduleInstallation$moduleFolder
   if (isFALSE(moduleInstallation$moduleInstalled)) {
     stop("Stopping since module is not properly installed!")
   }
 
   # Create job context
   moduleExecutionSettings <- executionSettings
-  moduleExecutionSettings$workSubFolder <- file.path(executionSettings$workFolder, sprintf("%s_%d", module, moduleIndex))
-  moduleExecutionSettings$resultsSubFolder <- file.path(executionSettings$resultsFolder, sprintf("%s_%d", module, moduleIndex))
+  moduleExecutionSettings$workSubFolder <- normalizePath(file.path(executionSettings$workFolder, sprintf("%s_%d", module, moduleIndex)), mustWork = F)
+  moduleExecutionSettings$resultsSubFolder <- normalizePath(file.path(executionSettings$resultsFolder, sprintf("%s_%d", module, moduleIndex)), mustWork = F)
 
   if (!is(executionSettings, "CdmExecutionSettings")) {
     stop("Unhandled executionSettings class! Must be CdmExecutionSettings instance")
@@ -48,11 +48,11 @@ runResultsUpload <- function(analysisSpecifications, keyringSettings, moduleInde
     moduleExecutionSettings = moduleExecutionSettings,
     keyringSettings = keyringSettings
   )
-  jobContextFileName <- file.path(moduleExecutionSettings$workSubFolder, "jobContext.rds") # gsub("\\\\", "/", tempfile(fileext = ".rds"))
+  jobContextFileName <- .formatAndNormalizeFilePathForScript(file.path(moduleExecutionSettings$workSubFolder, "jobContext.rds"))
   saveRDS(jobContext, jobContextFileName)
-  dataModelExportPath <- file.path(moduleExecutionSettings$workSubFolder, "resultsDataModelSpecification.csv")
+  dataModelExportPath <- .formatAndNormalizeFilePathForScript(file.path(moduleExecutionSettings$workSubFolder, "resultsDataModelSpecification.csv"))
 
-  doneFile <- file.path(jobContext$moduleExecutionSettings$resultsSubFolder, "results.uploaded")
+  doneFile <- .formatAndNormalizeFilePathForScript(file.path(jobContext$moduleExecutionSettings$resultsSubFolder, "results.uploaded"))
   if (file.exists(doneFile)) {
     unlink(doneFile)
   }

diff --git a/R/RunModule.R b/R/RunModule.R
@@ -28,7 +28,7 @@ runModule <- function(analysisSpecifications, keyringSettings, moduleIndex, exec
   version <- moduleSpecification$version
   remoteRepo <- moduleSpecification$remoteRepo
   remoteUsername <- moduleSpecification$remoteUsername
-  moduleInstallation <- verifyModuleInstallation(module, version)
+  moduleInstallation <- verifyModuleInstallation(module, version, silent = TRUE)
   moduleFolder <- moduleInstallation$moduleFolder
   if (isFALSE(moduleInstallation$moduleInstalled)) {
     stop("Stopping since module is not properly installed!")
@@ -51,11 +51,11 @@ runModule <- function(analysisSpecifications, keyringSettings, moduleIndex, exec
     moduleExecutionSettings = moduleExecutionSettings,
     keyringSettings = keyringSettings
   )
-  jobContextFileName <- file.path(moduleExecutionSettings$workSubFolder, "jobContext.rds") # gsub("\\\\", "/", tempfile(fileext = ".rds"))
+  jobContextFileName <- .formatAndNormalizeFilePathForScript(file.path(moduleExecutionSettings$workSubFolder, "jobContext.rds"))
   saveRDS(jobContext, jobContextFileName)
 
-  tempScriptFile <- file.path(moduleExecutionSettings$workSubFolder, "StrategusScript.R")
-  doneFile <- file.path(jobContext$moduleExecutionSettings$resultsSubFolder, "done")
+  tempScriptFile <- .formatAndNormalizeFilePathForScript(file.path(moduleExecutionSettings$workSubFolder, "StrategusScript.R"))
+  doneFile <- .formatAndNormalizeFilePathForScript(file.path(jobContext$moduleExecutionSettings$resultsSubFolder, "done"))
   if (file.exists(doneFile)) {
     unlink(doneFile)
   }

diff --git a/R/Settings.R b/R/Settings.R
@@ -128,6 +128,10 @@ createCdmExecutionSettings <- function(connectionDetailsReference,
   checkmate::assertCharacter(resultsDatabaseSchema, null.ok = TRUE, add = errorMessages)
   checkmate::reportAssertions(collection = errorMessages)
 
+  # Normalize paths to convert relative paths to absolute paths
+  workFolder <- normalizePath(workFolder, mustWork = F)
+  resultsFolder <- normalizePath(resultsFolder, mustWork = F)
+
   executionSettings <- list(
     connectionDetailsReference = connectionDetailsReference,
     workDatabaseSchema = workDatabaseSchema,
@@ -179,6 +183,10 @@ createResultsExecutionSettings <- function(resultsConnectionDetailsReference,
   checkmate::assertLogical(integer64AsNumeric, max.len = 1, add = errorMessages)
   checkmate::reportAssertions(collection = errorMessages)
 
+  # Normalize paths to convert relative paths to absolute paths
+  workFolder <- normalizePath(workFolder, mustWork = F)
+  resultsFolder <- normalizePath(resultsFolder, mustWork = F)
+
   executionSettings <- list(
     resultsConnectionDetailsReference = resultsConnectionDetailsReference,
     resultsDatabaseSchema = resultsDatabaseSchema,

diff --git a/extras/ExecuteStrategusOnEunomia.R b/extras/ExecuteStrategusOnEunomia.R
@@ -26,31 +26,54 @@ connectionDetails <- Eunomia::getEunomiaConnectionDetails(
 Strategus::storeConnectionDetails(connectionDetails = connectionDetails,
                                   connectionDetailsReference = "eunomia")
 
+# Set the working directory to studyFolder
+# and use relative paths to test
+setwd(studyFolder)
+
+# Execute the study ---------
+analysisSpecifications <- ParallelLogger::loadSettingsFromJson(
+  fileName = system.file("testdata/analysisSpecification.json",
+                         package = "Strategus")
+)
+
+resultsExecutionSettings <- Strategus::createResultsExecutionSettings(
+  resultsConnectionDetailsReference = "eunomia",
+  resultsDatabaseSchema = "main",
+  workFolder = file.path("schema_creation", "work_folder"),
+  resultsFolder = file.path("schema_creation", "results_folder")
+)
+
 executionSettings <- Strategus::createCdmExecutionSettings(
   connectionDetailsReference = "eunomia",
   workDatabaseSchema = "main",
   cdmDatabaseSchema = "main",
   cohortTableNames = CohortGenerator::getCohortTableNames(),
-  workFolder = file.path(studyFolder, "work_folder"),
-  resultsFolder = file.path(studyFolder, "results_folder"),
-  minCellCount = 5
+  workFolder = "work_folder",
+  resultsFolder = "results_folder",
+  minCellCount = 5,
+  resultsConnectionDetailsReference = "eunomia",
+  resultsDatabaseSchema = "main"
 )
 
 ParallelLogger::saveSettingsToJson(
   object = executionSettings,
   file.path(studyFolder, "eunomiaExecutionSettings.json")
 )
 
-# Execute the study ---------
-analysisSpecifications <- ParallelLogger::loadSettingsFromJson(
-  fileName = system.file("testdata/analysisSpecification.json",
-                         package = "Strategus")
-)
-
 executionSettings <- ParallelLogger::loadSettingsFromJson(
   fileName = file.path(studyFolder, "eunomiaExecutionSettings.json")
 )
 
+Strategus::storeConnectionDetails(
+  connectionDetails,
+  resultsConnectionDetailsReference
+)
+
+Strategus::createResultDataModels(
+  analysisSpecifications = analysisSpecifications,
+  executionSettings = resultsExecutionSettings
+)
+
 Strategus::execute(
   analysisSpecifications = analysisSpecifications,
   executionSettings = executionSettings,