diff --git a/R/Execution.R b/R/Execution.R index 46289feb..5ad8fb47 100644 --- 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 index 85cc2a9c..a82dee01 100644 --- 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 index efb899af..4bbaf730 100644 --- a/R/ModuleInstantiation.R +++ b/R/ModuleInstantiation.R @@ -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( @@ -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. diff --git a/R/ResultModelCreation.R b/R/ResultModelCreation.R index 7c9fdc18..1fe62c88 100644 --- 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 index dfd2752d..e0901044 100644 --- a/R/ResultsUpload.R +++ b/R/ResultsUpload.R @@ -24,7 +24,7 @@ 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!") @@ -32,8 +32,8 @@ runResultsUpload <- function(analysisSpecifications, keyringSettings, moduleInde # 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 index 646e7409..0a7d074e 100644 --- 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 index 0713b365..6243e087 100644 --- 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 index ff17b7bb..2e23fdf9 100644 --- a/extras/ExecuteStrategusOnEunomia.R +++ b/extras/ExecuteStrategusOnEunomia.R @@ -26,14 +26,33 @@ 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( @@ -41,16 +60,20 @@ ParallelLogger::saveSettingsToJson( 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,