diff --git a/.github/workflows/R_CMD_check_Hades.yaml b/.github/workflows/R_CMD_check_Hades.yaml index e3ee30e..6be2765 100644 --- a/.github/workflows/R_CMD_check_Hades.yaml +++ b/.github/workflows/R_CMD_check_Hades.yaml @@ -102,7 +102,7 @@ jobs: - name: Upload source package if: success() && runner.os == 'macOS' && github.event_name != 'pull_request' && github.ref == 'refs/heads/main' - uses: actions/upload-artifact@v2 + uses: actions/upload-artifact@v4 with: name: package_tarball path: check/*.tar.gz @@ -172,7 +172,7 @@ jobs: - name: Download package tarball if: ${{ env.new_version != '' }} - uses: actions/download-artifact@v2 + uses: actions/download-artifact@4.1.7 with: name: package_tarball diff --git a/R/Cohorts.R b/R/Cohorts.R index f1ed411..89ef3e4 100644 --- a/R/Cohorts.R +++ b/R/Cohorts.R @@ -38,31 +38,41 @@ createCohorts <- function(connectionDetails, stop("connectionDetails is not valid.") } - if (connectionDetails$dbms != "sqlite") { - stop("createCohorts only supports sqlite") + if (connectionDetails$dbms != "sqlite" && connectionDetails$dbms != "duckdb") { + stop("createCohorts only supports sqlite and duckdb") } if (cdmDatabaseSchema != "main" || cohortDatabaseSchema != "main") { - stop("sqlite only supports the main schema") + stop("only main schema is supported") } if (cohortTable != "cohort") { warning("The cohortTable argument to createCohorts was deprecated in Eunomia v2.1.0") } - connection <- DBI::dbConnect(RSQLite::SQLite(), connectionDetails$server()) - on.exit(DBI::dbDisconnect(connection)) + if (connectionDetails$dbms == "sqlite") { + connection <- DBI::dbConnect(RSQLite::SQLite(), connectionDetails$server()) + on.exit(DBI::dbDisconnect(connection)) - # Create example cohort table - pathToSql <- system.file("sql", "CreateCohortTable.sql",package = "Eunomia", mustWork = TRUE) - sql <- readChar(pathToSql, file.info(pathToSql)$size) - sql <- gsub("--[a-zA-Z0-9 ]*", "", sql) # remove comments in sql - sql <- strsplit(gsub("\n", " ", sql), ";")[[1]] # remove newlines, split on semicolon - sql <- trimws(sql) # trim white space - sql <- sql[-which(sql == "")] # remove empty lines + # Create example cohort table + pathToSql <- system.file("sql", "CreateCohortTable.sql",package = "Eunomia", mustWork = TRUE) + sql <- readChar(pathToSql, file.info(pathToSql)$size) + sql <- gsub("--[a-zA-Z0-9 ]*", "", sql) # remove comments in sql + sql <- strsplit(gsub("\n", " ", sql), ";")[[1]] # remove newlines, split on semicolon + sql <- trimws(sql) # trim white space + sql <- sql[-which(sql == "")] # remove empty lines - for (i in seq_along(sql)) { - DBI::dbExecute(connection, sql[i]) + for (i in seq_along(sql)) { + DBI::dbExecute(connection, sql[i]) + } + } + else { + connection <- DatabaseConnector::connect(connectionDetails) + on.exit(DatabaseConnector::dbDisconnect(connection)) + + # Create example cohort table + cohortData <- readRDS(system.file("cohorts.rds", package = "Eunomia", mustWork = T)) + DatabaseConnector::dbWriteTable(conn = connection, name = cohortTable, value = cohortData, overwrite = TRUE) } # Fetch cohort counts: diff --git a/inst/cohorts.rds b/inst/cohorts.rds new file mode 100644 index 0000000..a8d4234 Binary files /dev/null and b/inst/cohorts.rds differ diff --git a/tests/testthat/test-basic.R b/tests/testthat/test-basic.R index 3896981..222539c 100644 --- a/tests/testthat/test-basic.R +++ b/tests/testthat/test-basic.R @@ -50,7 +50,7 @@ test_that("Query", { DatabaseConnector::disconnect(connection) }) -test_that("Cohort construction", { +test_that("Cohort construction - sqlite", { connectionDetails <- getEunomiaConnectionDetails() x <- createCohorts(connectionDetails) connection <- DatabaseConnector::connect(connectionDetails) @@ -71,6 +71,27 @@ test_that("Cohort construction", { expect_false(DatabaseConnector::dbIsValid(connection)) }) +test_that("Cohort construction - duckdb", { + connectionDetails <- getEunomiaConnectionDetails(dbms = "duckdb") + x <- createCohorts(connectionDetails) + connection <- DatabaseConnector::connect(connectionDetails) + + sql <- "SELECT COUNT(*) + FROM main.cohort + WHERE cohort_definition_id = 1;" + cohortCount <- DatabaseConnector::renderTranslateQuerySql(connection, sql) + expect_gt(cohortCount, 0) + + cohort <- DatabaseConnector::dbGetQuery(connection, "SELECT * FROM main.cohort;") + expect_false(any(is.na(cohort$cohort_definition_id))) + expect_false(any(is.na(cohort$subject_id))) + expect_false(any(is.na(cohort$cohort_start_date))) + expect_false(any(is.na(cohort$cohort_end_date))) + + DatabaseConnector::disconnect(connection) + expect_false(DatabaseConnector::dbIsValid(connection)) +}) + test_that("deprecated arguments in createCohorts", { connectionDetails <- getEunomiaConnectionDetails() expect_error(createCohorts(connectionDetails, cdmDatabaseSchema = "blah"))