[DRAFT] Execution Settings R6 Class

R/R6ClassFunctions.R

@@ -0,0 +1,99 @@
+
+.getAssertChoices <- function(category) {
+  readr::read_csv(file = system.file(package = pkgload::pkg_name(), "csv", "assertChoices.csv"), show_col_types = FALSE) |>
+    dplyr::filter(category == !!category) |>
+    dplyr::pull(choice)
+}
+
+.getCaseSql <- function(covariateValues,
+                        then) {
+
+  sql <- glue::glue("when covariate_value >= {thresholdMin} and covariate_value <= {thresholdMax} then {covariateId}")
+  caseSql <- glue::glue("case {sql} end as covariate_id", sql = paste(caseSql, collapse = "\n"))
+}
+
+.setString <- function(private, key, value, naOk = FALSE) {
+  checkmate::assert_string(x = value, na.ok = naOk, min.chars = 1, null.ok = FALSE)
+  private[[key]] <- value
+  invisible(private)
+}
+
+.setCharacter <- function(private, key, value) {
+  checkmate::assert_character(x = value, min.chars = 1, null.ok = FALSE)
+  private[[key]] <- value
+  invisible(private)
+}
+
+.setNumber <- function(private, key, value, nullable = FALSE) {
+  checkmate::assert_numeric(x = value, null.ok = nullable)
+  private[[key]] <- value
+  invisible(private)
+}
+
+.setInteger <- function(private, key, value, nullable = FALSE) {
+  checkmate::assert_integer(x = value, null.ok = nullable)
+  private[[key]] <- value
+  invisible(private)
+}
+
+
+.setLogical <- function(private, key, value) {
+  checkmate::assert_logical(x = value, null.ok = FALSE)
+  private[[key]] <- value
+  invisible(private)
+}
+
+.setClass <- function(private, key, value, class, nullable = FALSE) {
+  checkmate::assert_class(x = value, classes = class, null.ok = nullable)
+  private[[key]] <- value
+  invisible(private)
+}
+
+.setListofClasses <- function(private, key, value, classes) {
+  checkmate::assert_list(x = value, types = classes, null.ok = FALSE, min.len = 1)
+  private[[key]] <- value
+  invisible(private)
+}
+
+.setChoice <- function(private, key, value, choices) {
+  checkmate::assert_choice(x = value, choices = choices, null.ok = FALSE)
+  private[[key]] <- value
+  invisible(private)
+}
+
+.setChoiceList <- function(private, key, value, choices) {
+  checkmate::assert_subset(x = value, choices = choices, empty.ok = FALSE)
+  private[[key]] <- value
+  invisible(private)
+}
+
+
+.setActiveLogical <- function(private, key, value) {
+  # return the value if nothing added
+  if(missing(value)) {
+    vv <- private[[key]]
+    return(vv)
+  }
+  # replace the codesetTempTable
+  .setLogical(private = private, key = key, value = value)
+}
+
+.setActiveString <- function(private, key, value) {
+  # return the value if nothing added
+  if(missing(value)) {
+    vv <- private[[key]]
+    return(vv)
+  }
+  # replace the codesetTempTable
+  .setString(private = private, key = key, value = value)
+}
+
+
+.setActiveInteger <- function(private, key, value) {
+  # return the value if nothing added
+  if(missing(value)) {
+    vv <- private[[key]]
+    return(vv)
+  }
+  .setInteger(private = private, key = key, value = value)
+}

R/executionSettings.R

@@ -0,0 +1,198 @@
+
+# ExecutionSettings ----
+
+#' @description
+#' An R6 class to define an ExecutionSettings object
+#'
+#' @export
+ExecutionSettings <- R6::R6Class(
+  classname = "ExecutionSettings",
+  public = list(
+    initialize = function(connectionDetails = NULL,
+                          connection = NULL,
+                          cdmDatabaseSchema = NULL,
+                          workDatabaseSchema = NULL,
+                          tempEmulationSchema = NULL,
+                          targetCohortTable = NULL,
+                          cdmSourceName = NULL) {
+      stopifnot(is.null(connectionDetails) || is.null(connection))
+      .setClass(private = private, key = "connectionDetails", value = connectionDetails, class = "ConnectionDetails")
+      .setClass(private = private, key = ".connection", value = connection,
+                class = "DatabaseConnectorJdbcConnection", nullable = TRUE)
+      .setString(private = private, key = ".cdmDatabaseSchema", value = cdmDatabaseSchema)
+      .setString(private = private, key = ".workDatabaseSchema", value = workDatabaseSchema)
+      .setString(private = private, key = ".tempEmulationSchema", value = tempEmulationSchema)
+      .setString(private = private, key = ".targetCohortTable", value = targetCohortTable)
+      .setString(private = private, key = ".cdmSourceName", value = cdmSourceName)
+    },
+
+    getDbms = function() {
+      dbms <- private$connectionDetails$dbms
+      return(dbms)
+    },
+
+    # connect to database
+    connect = function() {
+
+      # check if private$connection is NULL
+      conObj <- private$.connection
+      if (is.null(conObj)) {
+        private$.connection <- DatabaseConnector::connect(private$connectionDetails)
+      } else{
+        cli::cat_bullet(
+          "Connection object already open",
+          bullet = "info",
+          bullet_col = "blue"
+        )
+      }
+    },
+
+    # disconnect to database
+    disconnect = function() {
+
+      # check if private$connection is NULL
+      conObj <- private$.connection
+      if (class(conObj) == "DatabaseConnectorJdbcConnection") {
+        # disconnect connection
+        DatabaseConnector::disconnect(private$.connection)
+        private$.connection <- NULL
+      }
+
+      cli::cat_bullet(
+        "Connection object has been disconected",
+        bullet = "info",
+        bullet_col = "blue"
+      )
+      invisible(conObj)
+    },
+
+    #TODO make this more rigorous
+    # add warning if no connection available
+    getConnection = function() {
+      conObj <- private$.connection
+      return(conObj)
+    }
+
+  ),
+
+  private = list(
+    connectionDetails = NULL,
+    .connection = NULL,
+    .cdmDatabaseSchema = NULL,
+    .workDatabaseSchema = NULL,
+    .tempEmulationSchema = NULL,
+    .targetCohortTable = NULL,
+    .cdmSourceName = NULL
+  ),
+
+  active = list(
+
+    cdmDatabaseSchema = function(value) {
+      # return the value if nothing added
+      if(missing(value)) {
+        cds <- private$.cdmDatabaseSchema
+        return(cds)
+      }
+      # replace the cdmDatabaseSchema
+      .setString(private = private, key = ".cdmDatabaseSchema", value = value)
+      cli::cat_bullet(
+        glue::glue("Replaced {crayon::cyan('cdmDatabaseSchema')} with {crayon::green(value)}"),
+        bullet = "info",
+        bullet_col = "blue"
+      )
+    },
+
+    workDatabaseSchema = function(value) {
+      # return the value if nothing added
+      if(missing(value)) {
+        cds <- private$.workDatabaseSchema
+        return(cds)
+      }
+      # replace the workDatabaseSchema
+      .setString(private = private, key = ".workDatabaseSchema", value = value)
+      cli::cat_bullet(
+        glue::glue("Replaced {crayon::cyan('workDatabaseSchema')} with {crayon::green(value)}"),
+        bullet = "info",
+        bullet_col = "blue"
+      )
+    },
+
+
+    tempEmulationSchema = function(value) {
+      # return the value if nothing added
+      if(missing(value)) {
+        tes <- private$.tempEmulationSchema
+        return(tes)
+      }
+      # replace the tempEmulationSchema
+      .setString(private = private, key = ".tempEmulationSchema", value = value)
+      cli::cat_bullet(
+        glue::glue("Replaced {crayon::cyan('tempEmulationSchema')} with {crayon::green(value)}"),
+        bullet = "info",
+        bullet_col = "blue"
+      )
+    },
+
+    targetCohortTable = function(value) {
+      # return the value if nothing added
+      if(missing(value)) {
+        tct <- private$.targetCohortTable
+        return(tct)
+      }
+      # replace the targetCohortTable
+      .setString(private = private, key = ".targetCohortTable", value = value)
+      cli::cat_bullet(
+        glue::glue("Replaced {crayon::cyan('targetCohortTable')} with {crayon::green(value)}"),
+        bullet = "info",
+        bullet_col = "blue"
+      )
+    },
+
+    cdmSourceName = function(value) {
+      # return the value if nothing added
+      if(missing(value)) {
+        csn <- private$.cdmSourceName
+        return(csn)
+      }
+      # replace the cdmSourceName
+      .setString(private = private, key = ".cdmSourceName", value = value)
+      cli::cat_bullet(
+        glue::glue("Replaced {crayon::cyan('cdmSourceName')} with {crayon::green(value)}"),
+        bullet = "info",
+        bullet_col = "blue"
+      )
+    }
+
+  )
+)
+
+
+#' @title
+#' Create an ExecutionSettings object and set its attributes
+#'
+#' @param connectionDetails A DatabaseConnector connectionDetails object (optional if connection is specified)
+#' @param connection A DatabaseConnector connection object (optional if connectionDetails is specified)
+#' @param cdmDatabaseSchema The schema of the OMOP CDM database
+#' @param workDatabaseSchema The schema to which results will be written
+#' @param tempEmulationSchema Some database platforms like Oracle and Snowflake do not truly support temp tables. To emulate temp tables, provide a schema with write privileges where temp tables can be created.
+#' @param targetCohortTable The name of the table where the target cohort(s) are stored
+#' @param cdmSourceName A human-readable name for the OMOP CDM source
+#'
+#' @return An ExecutionSettings object
+#' @export
+createExecutionSettings <- function(connectionDetails,
+                                    connection = NULL,
+                                    cdmDatabaseSchema,
+                                    workDatabaseSchema,
+                                    tempEmulationSchema,
+                                    targetCohortTable,
+                                    cdmSourceName) {
+  executionSettings <- ExecutionSettings$new(connectionDetails = connectionDetails,
+                                             connection = connection,
+                                             cdmDatabaseSchema = cdmDatabaseSchema,
+                                             workDatabaseSchema = workDatabaseSchema,
+                                             tempEmulationSchema = tempEmulationSchema,
+                                             targetCohortTable = targetCohortTable,
+                                             cdmSourceName = cdmSourceName)
+  return(executionSettings)
+}