Merge pull request #56 from vimc/i2327

i2327: add connection to the database

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: orderly
 Title: R support for montagu-reports
-Version: 0.5.4
+Version: 0.5.5
 Description: Order, create and store reports from R.
 License: MIT + file LICENSE
 Encoding: UTF-8

NEWS.md

@@ -1,3 +1,7 @@
+# 0.5.5
+
+* New `connection` column in the `report_version` table in orderly's database (VIMC-2327)
+
 # 0.5.4
 
 * New `latest` column in the `report` table in orderly's database (VIMC-2298)

R/db.R

@@ -154,6 +154,14 @@ report_db_cols <- function() {
 orderly_rebuild <- function(config = NULL, locate = TRUE, verbose = TRUE,
                             if_schema_changed = FALSE) {
   config <- orderly_config_get(config, locate)
+
+  if (length(migrate_plan(config$path, to = NULL)) > 0L) {
+    orderly_log("migrate", "archive")
+    orderly_migrate(config, locate = FALSE, verbose = verbose)
+    ## This should trigger a rebuild, regardless of what anything else thinks
+    if_schema_changed <- FALSE
+  }
+
   if (!if_schema_changed || report_db2_needs_rebuild(config)) {
     orderly_log("rebuild", "db")
     report_db_rebuild(config, verbose)

R/db2.R

@@ -6,7 +6,7 @@
 ## namespace/module feature so that implementation details can be
 ## hidden away a bit further.
 
-ORDERLY_SCHEMA_VERSION <- "0.0.3"
+ORDERLY_SCHEMA_VERSION <- "0.0.4"
 
 ## These will be used in a few places and even though they're not
 ## super likely to change it would be good
@@ -157,7 +157,7 @@ report_db2_open_existing <- function(con, config) {
   ## present in the yml and that should be the source of truth here
   ## but we shuold only load that once in a session.
   extra <- setdiff(setdiff(names(d), names(report_db_cols())),
-                   c("report", custom_name))
+                   c("report", "connection", custom_name))
   if (length(extra) > 0L) {
     stop(sprintf("custom fields %s in database not present in config",
                  paste(squote(extra), collapse = ", ")))
@@ -216,6 +216,8 @@ report_data_import <- function(con, workdir, config) {
 
   ## Was not done before 0.3.3
   stopifnot(!is.null(dat_rds$meta))
+  ## Was not done before 0.5.5
+  stopifnot(!is.null(dat_rds$meta$connection))
 
   id <- dat_rds$meta$id
   name <- dat_rds$meta$name
@@ -239,7 +241,8 @@ report_data_import <- function(con, workdir, config) {
     date = dat_rds$meta$date,
     displayname = dat_rds$meta$displayname %||% NA_character_,
     description = dat_rds$meta$description %||% NA_character_,
-    published = published)
+    published = published,
+    connection = dat_rds$meta$connection)
   if (nrow(config$fields) > 0L) {
     extra <- drop_null(set_names(
       lapply(config$fields$name, function(x) dat_in[[x]]),

R/recipe_run.R

@@ -234,6 +234,12 @@ recipe_run <- function(info, parameters, envir, config, echo = TRUE,
   orderly_log("end", as.character(t1))
   orderly_log("elapsed", sprintf("Ran report in %s", format(elapsed)))
 
+  if (!is.null(info$connection)) {
+    tryCatch(DBI::dbDisconnect(prep$con),
+             error = identity,
+             warning = identity)
+  }
+
   recipe_check_device_stack(prep$n_dev)
   hash_artefacts <- recipe_check_artefacts(info)
 
@@ -257,6 +263,7 @@ recipe_run <- function(info, parameters, envir, config, echo = TRUE,
                parameters = parameters,
                date = as.character(Sys.time()),
                message = message,
+               connection = !is.null(info$connection),
                ## Don't know what of these two are most useful:
                hash_orderly = info$hash,
                hash_input = hash_files("orderly.yml", FALSE),
@@ -540,14 +547,21 @@ orderly_prepare_data <- function(config, info, parameters, envir) {
     stop(paste("Missing packages:", 
                paste(squote(missing_packages), collapse = ", ")))
   }
+
+  ret <- list(data = ldata, hash_resources = hash_resources, n_dev = n_dev)
+
+  if (!is.null(info$connection)) {
+    ret$con <- data[[info$connection]]
+  }
+
   for (p in info$packages) {
     library(p, character.only = TRUE)
   }
   for (s in info$sources) {
     source(s, envir)
   }
 
-  list(data = ldata, hash_resources = hash_resources, n_dev = n_dev)
+  ret
 }
 
 

inst/database/schema.yml

@@ -33,6 +33,7 @@ report_version:
     - date: {type: TIMESTAMP}
     - displayname: {type: TEXT, nullable: true}
     - description: {type: TEXT, nullable: true}
+    - connection: {type: BOOLEAN}
     - published: {type: BOOLEAN}
     # NOTE: fields listed in orderly_config.yml will also be
     # included here.

inst/examples/demo/demo.yml

@@ -68,3 +68,5 @@
 - name: interactive
 
 - name: use_resource_dir
+
+- name: connection

inst/examples/demo/src/connection/orderly.yml

@@ -0,0 +1,10 @@
+data: ~
+connection: con
+script: script.R
+artefacts:
+  staticgraph:
+    description: A graph of things
+    filenames: mygraph.png
+author: Researcher McResearcherface
+requester: Funder McFunderface
+comment: This is a comment

inst/examples/demo/src/connection/script.R

@@ -0,0 +1,6 @@
+sql <- "SELECT name, number FROM thing"
+dat <- DBI::dbGetQuery(con, sql)
+png("mygraph.png")
+par(mar = c(15, 4, .5, .5))
+barplot(setNames(dat$number, dat$name), las = 2)
+dev.off()

inst/migrate/0.5.5.R

@@ -0,0 +1,8 @@
+migrate <- function(data, path, config) {
+  if (!is.null(data$meta$connection)) {
+    return(migration_result(FALSE, data))
+  }
+  d <- recipe_read(path, config, FALSE)
+  data$meta$connection <- !is.null(d$connection)
+  migration_result(TRUE, data)
+}

tests/testthat/create-reference.R

@@ -36,3 +36,12 @@ prepare_orderly_example("demo", "reference/0.5.1")
 run_orderly_demo("reference/0.5.1")
 withr::with_dir("reference", zip("0.5.1.zip", "0.5.1"))
 unlink("reference/0.5.1", recursive = TRUE)
+
+
+## 0.5.4
+unlink("reference/0.5.4", recursive = TRUE)
+unlink("reference/0.5.4.zip")
+prepare_orderly_example("demo", "reference/0.5.4")
+run_orderly_demo("reference/0.5.4")
+withr::with_dir("reference", zip("0.5.4.zip", "0.5.4"))
+unlink("reference/0.5.4", recursive = TRUE)

tests/testthat/test-migrate.R

@@ -137,6 +137,8 @@ test_that("database migrations", {
   DBI::dbDisconnect(con)
   expect_false("published" %in% names(dat))
 
+  orderly_migrate(config = path)
+
   id <- orderly_run("minimal", config = path, echo = FALSE)
   expect_error(
     orderly_commit(id, config = path),
@@ -163,3 +165,17 @@ test_that("automatic migrations", {
   expect_false(orderly_rebuild(config = path, if_schema_changed = TRUE))
   expect_true(orderly_rebuild(config = path, if_schema_changed = FALSE))
 })
+
+
+test_that("migrate 0.5.4 -> 0.5.5", {
+  path <- unpack_reference("0.5.4")
+  orderly_migrate(path, to = "0.5.5")
+  orderly_rebuild(path)
+
+  con <- orderly_db("destination", path, validate = FALSE)
+  dat <- DBI::dbReadTable(con, "report_version")
+  DBI::dbDisconnect(con)
+
+  expect_equal(dat$connection == 1,
+               dat$report == "connection")
+})

tests/testthat/test-run.R

@@ -250,6 +250,29 @@ test_that("connection", {
   DBI::dbDisconnect(data$con)
 })
 
+
+test_that("connection is saved to db", {
+  path <- prepare_orderly_example("minimal")
+
+  id1 <- orderly_run("example", config = path, echo = FALSE)
+  orderly_commit(id1, config = path)
+
+  path_example <- file.path(path, "src", "example")
+  yml <- file.path(path_example, "orderly.yml")
+  txt <- readLines(yml)
+  writeLines(c(txt, "connection: con"), yml)
+
+  id2 <- orderly_run("example", config = path, echo = FALSE)
+  orderly_commit(id2, config = path)
+
+  con <- orderly_db("destination", config = path)
+  on.exit(DBI::dbDisconnect(con))
+  d <- DBI::dbGetQuery(con, "SELECT id, connection FROM report_version")
+  expect_equal(d$connection[d$id == id1], 0L)
+  expect_equal(d$connection[d$id == id2], 1L)
+})
+
+
 test_that("no data", {
   path <- prepare_orderly_example("minimal")
   yml <- c("data: ~",