Skip to content

Commit

Permalink
Allow for use of relative paths - fixes #99
Browse files Browse the repository at this point in the history
  • Loading branch information
anthonysena committed Jan 13, 2024
1 parent 2665f6a commit 13d020e
Show file tree
Hide file tree
Showing 8 changed files with 78 additions and 38 deletions.
12 changes: 7 additions & 5 deletions R/Execution.R
Original file line number Diff line number Diff line change
Expand Up @@ -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(
Expand Down Expand Up @@ -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
Expand All @@ -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(
Expand Down
10 changes: 10 additions & 0 deletions R/ModuleEnv.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)))
}
7 changes: 1 addition & 6 deletions R/ModuleInstantiation.R
Original file line number Diff line number Diff line change
Expand Up @@ -153,7 +153,7 @@ verifyModuleInstallation <- function(module, version, silent = FALSE, forceVerif
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(
Expand Down Expand Up @@ -217,11 +217,6 @@ verifyModuleInstallation <- function(module, version, silent = FALSE, forceVerif
# 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.
Expand Down
18 changes: 10 additions & 8 deletions R/ResultModelCreation.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
##
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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!")
Expand All @@ -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)
}
Expand Down
12 changes: 6 additions & 6 deletions R/ResultsUpload.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand All @@ -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)
}
Expand Down
8 changes: 4 additions & 4 deletions R/RunModule.R
Original file line number Diff line number Diff line change
Expand Up @@ -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!")
Expand All @@ -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)
}
Expand Down
8 changes: 8 additions & 0 deletions R/Settings.R
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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,
Expand Down
41 changes: 32 additions & 9 deletions extras/ExecuteStrategusOnEunomia.R
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down

0 comments on commit 13d020e

Please sign in to comment.