Update how workflow id is passed and expose on main run

R/db2.R

@@ -8,7 +8,7 @@
 ## namespace/module feature so that implementation details can be
 ## hidden away a bit further.
 
-orderly_schema_version <- "1.2.34"
+orderly_schema_version <- "1.2.35"
 orderly_schema_table <- "orderly_schema"
 orderly_table_list <- "orderly_schema_tables"
 
@@ -429,16 +429,13 @@ report_data_import <- function(con, name, id, config) {
 
   if (!is.null(dat_rds$meta$workflow)) {
     sql_batch <- "SELECT id FROM workflow WHERE id = $1"
-    if (nrow(DBI::dbGetQuery(con, sql_batch, dat_rds$meta$workflow$id)) == 0L) {
-      workflow <- data_frame(
-        id = dat_rds$meta$workflow$id,
-        name = dat_rds$meta$workflow$name
-      )
+    if (nrow(DBI::dbGetQuery(con, sql_batch, dat_rds$meta$workflow)) == 0L) {
+      workflow <- data_frame(id = dat_rds$meta$workflow)
       DBI::dbWriteTable(con, "workflow", workflow, append = TRUE)
     }
     report_version_workflow <- data_frame(
       report_version = id,
-      workflow_id = dat_rds$meta$workflow$id
+      workflow_id = dat_rds$meta$workflow
     )
     DBI::dbWriteTable(con, "report_version_workflow", report_version_workflow,
                       append = TRUE)

R/main.R

@@ -139,14 +139,15 @@ usage_run <- "Usage:
   orderly run [options] <name> [<parameter>...]
 
 Options:
-  --instance=NAME  Database instance to use (if instances are configured)
-  --no-commit      Do not commit the report
-  --print-log      Print the log (rather than storing it)
-  --id-file=FILE   File to write the id into
-  --ref=REF        Git reference (branch or sha) to use
-  --fetch          Fetch git before updating reference
-  --pull           Pull git before running report
-  --message=TEXT   A message explaining why the report was run
+  --instance=NAME     Database instance to use (if instances are configured)
+  --no-commit         Do not commit the report
+  --print-log         Print the log (rather than storing it)
+  --id-file=FILE      File to write the id into
+  --ref=REF           Git reference (branch or sha) to use
+  --fetch             Fetch git before updating reference
+  --pull              Pull git before running report
+  --message=TEXT      A message explaining why the report was run
+  --workflow-id=TEXT  The ID of the workflow this report is run as part of
 
 Parameters, if given, must be passed through in key=value pairs"
 
@@ -171,6 +172,7 @@ main_do_run <- function(x) {
   fetch <- x$options$fetch
   pull <- x$options$pull
   message <- x$options$message
+  workflow_id <- x$options$workflow_id
 
   if (print_log) {
     sink(stderr(), type = "output")
@@ -183,7 +185,8 @@ main_do_run <- function(x) {
   id <- orderly_run_internal(name, parameters, root = config,
                              id_file = id_file, instance = instance,
                              ref = ref, fetch = fetch, message = message,
-                             commit = commit, capture_log = !print_log)
+                             commit = commit, capture_log = !print_log,
+                             workflow_id = workflow_id)
   message("id:", id)
 }
 

R/orderly_version.R

@@ -8,7 +8,7 @@ orderly_version <- R6::R6Class(
 
     id = NULL,
     batch_id = NULL,
-    workflow_info = NULL,
+    workflow_id = NULL,
     workdir = NULL,
 
     envvar = NULL,
@@ -354,7 +354,7 @@ orderly_version <- R6::R6Class(
            tags = private$tags,
            git = private$preflight_info$git,
            batch_id = private$batch_id,
-           workflow = private$workflow_info,
+           workflow = private$workflow_id,
            data = private$postflight_info$data_info,
            view = private$postflight_info$view_info)
     },
@@ -423,7 +423,7 @@ orderly_version <- R6::R6Class(
                             use_draft = FALSE, remote = NULL,
                             ## These might move around a bit
                             id_file = NULL, batch_id = NULL,
-                            workflow_info = NULL, ref = NULL, fetch = FALSE,
+                            workflow_id = NULL, ref = NULL, fetch = FALSE,
                             capture_log = FALSE) {
       logfile <- tempfile()
       capture_log <- capture_log %||%
@@ -441,7 +441,7 @@ orderly_version <- R6::R6Class(
                               path_orderly_log(private$workdir)))
           }
           private$batch_id <- batch_id
-          private$workflow_info <- workflow_info
+          private$workflow_id <- workflow_id
           private$fetch()
           self$run_execute(echo)
           self$run_cleanup()

R/recipe_run.R

@@ -128,13 +128,13 @@ orderly_run_internal <- function(name = NULL, parameters = NULL, envir = NULL,
                                  remote = NULL, tags = NULL,
                                  # specific to run_internal
                                  id_file = NULL, batch_id = NULL,
-                                 workflow_info = NULL, fetch = FALSE,
+                                 workflow_id = NULL, fetch = FALSE,
                                  ref = NULL, capture_log = NULL,
                                  commit = FALSE) {
   version <- orderly_version$new(name, root, locate)
   id <- version$run_internal(parameters, instance, envir, message, tags, echo,
                              use_draft, remote, id_file, batch_id,
-                             workflow_info, ref, fetch, capture_log)
+                             workflow_id, ref, fetch, capture_log)
   if (commit) {
     version$commit(capture_log)
   }

inst/database/schema.yml

@@ -253,7 +253,6 @@ report_version_batch:
 workflow:
   columns:
     - id: {type: TEXT}
-    - name: {type: TEXT}
 
 report_version_workflow:
   columns:

tests/testthat/test-db.R

@@ -436,24 +436,6 @@ test_that("add batch info to db", {
     data_frame(report_version = ids, report_batch = rep(batch_id, 3)))
 })
 
-test_that("add workflow info to db", {
-  path <- prepare_orderly_example("demo")
-
-  mock_random_id <- mockery::mock("workflow_id", "report_id1", "report_id2")
-  with_mock("ids::random_id" = mock_random_id, {
-    ids <- orderly_workflow("my_workflow", root = path)
-  })
-
-  con <- orderly_db("destination", path)
-  on.exit(DBI::dbDisconnect(con))
-  expect_equal(
-    DBI::dbReadTable(con, "workflow"),
-    data_frame(id = "workflow_id",
-               name = "my_workflow"))
-  expect_equal(
-    DBI::dbReadTable(con, "report_version_workflow"),
-    data_frame(report_version = ids, workflow_id = rep("workflow_id", 2)))
-})
 
 
 ## Regression test for vimc-3652

tests/testthat/test-main.R

@@ -684,97 +684,19 @@ test_that("batch: pull before run", {
   expect_equal(git_ref_to_sha("HEAD", path_local), sha_origin)
 })
 
-test_that("workflow", {
-  testthat::skip_on_cran()
-  path <- unzip_git_demo()
-
-  args <- c("--root", path, "workflow", "my_workflow")
-
-  res <- cli_args_process(args)
-  expect_equal(res$command, "workflow")
-  expect_equal(res$options$name, "my_workflow")
-  expect_false(res$options$print_log)
-  expect_false(res$options$pull)
-  expect_equal(res$options$instance, NULL)
-  expect_equal(res$target, main_do_workflow)
-
-  expect_message(res$target(res), "ids:[\\w\\d-]*")
-
-  d <- orderly_list_archive(path)
-  expect_equal(nrow(d), 2L)
-  expect_equal(d$name, c("global", "minimal"))
-
-  log_file <- file.path(path, "archive", "global", d$id[1], "orderly.log")
-  expect_true(file.exists(log_file))
-  logs <- readLines(log_file)
-  expect_true(sprintf("[ id         ]  %s", d$id[1]) %in%
-                crayon::strip_style(logs))
-  expect_equal(sum(grepl("\\[ id         \\].*", logs)), 1)
-
-  log_file <- file.path(path, "archive", "minimal", d$id[2], "orderly.log")
-  expect_true(file.exists(log_file))
-  logs <- readLines(log_file)
-  expect_true(sprintf("[ id         ]  %s", d$id[2]) %in%
-                crayon::strip_style(logs))
-  expect_equal(sum(grepl("\\[ id         \\].*", logs)), 1)
-})
-
-test_that("workflow: pull before run", {
-  testthat::skip_on_cran()
-  path <- prepare_orderly_git_example(branch = "other")
-  path_local <- path[["local"]]
-  path_origin <- path[["origin"]]
-  sha_local <- git_ref_to_sha("HEAD", path_local)
-  sha_origin <- git_ref_to_sha("HEAD", path_origin)
-
-  args <- c("--root", path_local, "workflow", "--pull", "my_workflow")
-
-  res <- cli_args_process(args)
-  expect_equal(res$command, "workflow")
-  expect_equal(res$options$name, "my_workflow")
-  expect_equal(res$options$instance, NULL)
-  expect_true(res$options$pull)
-  expect_equal(res$target, main_do_workflow)
-
-  expect_message(res$target(res), "ids:[\\w\\d-]*")
-
-  id <- orderly_latest("minimal", root = path_local)
-  d <- readRDS(path_orderly_run_rds(
-    file.path(path_local, "archive", "minimal", id)))
-  expect_equal(d$git$sha, sha_origin)
-  expect_equal(git_ref_to_sha("HEAD", path_local), sha_origin)
-})
-
-test_that("workflow: print logs", {
-  testthat::skip_on_cran()
-  path <- unzip_git_demo()
-
-  args <- c("--root", path, "workflow", "--print-log", "my_workflow")
 
+test_that("run can save workflow metadata", {
+  path <- prepare_orderly_example("minimal")
+  args <- c("--root", path, "run", "--workflow-id", "123", "example")
   res <- cli_args_process(args)
-  expect_equal(res$command, "workflow")
-  expect_equal(res$options$name, "my_workflow")
-  expect_true(res$options$print_log)
-  expect_false(res$options$pull)
-  expect_equal(res$options$instance, NULL)
-  expect_equal(res$target, main_do_workflow)
-
-  out <- evaluate_promise(capture.output(res$target(res), type = "message"))
-
-  d <- orderly_list_archive(path)
-  expect_equal(nrow(d), 2L)
-  expect_equal(d$name, c("global", "minimal"))
-
-  expect_true(sprintf("[ id         ]  %s\n", d$id[1])
-              %in% crayon::strip_style(out$messages))
-  log_file <- file.path(path, "archive", "global", d$id[1], "orderly.log")
-  ## Logs have not been written to file
-  expect_false(file.exists(log_file))
+  expect_equal(res$options$workflow_id, "123")
 
-  expect_true(sprintf("[ id         ]  %s\n", d$id[2])
-              %in% crayon::strip_style(out$messages))
-  log_file <- file.path(path, "archive", "global", d$id[2], "orderly.log")
-  ## Logs have not been written to file
-  expect_false(file.exists(log_file))
+  capture.output(res$target(res))
+  expect_equal(orderly_list(path), "example")
+  expect_equal(nrow(orderly_list_archive(path)), 1)
+  id <- orderly_list_archive(path)$id
+  rds <- path_orderly_run_rds(file.path(path, "archive", "example", id))
+  expect_true(file.exists(rds))
+  dat <- readRDS(rds)
+  expect_equal(dat$meta$workflow, "123")
 })
-

tests/testthat/test-run.R

@@ -1093,3 +1093,39 @@ test_that("orderly_run_internal writes fail rds on error", {
   expect_match(failed_rds$error$trace[length(failed_rds$error$trace)],
                'stop\\("some error"\\)')
 })
+
+test_that("orderly_run_internal can save workflow metadata", {
+  path <- prepare_orderly_example("minimal")
+  tmp <- tempfile()
+  id <- orderly_run_internal("example", root = path, id_file = tmp,
+                             commit = TRUE, echo = FALSE,
+                             workflow_id = "123")
+  rds <- path_orderly_run_rds(file.path(path, "archive", "example", id))
+  expect_true(file.exists(rds))
+  dat <- readRDS(rds)
+  expect_equal(dat$meta$workflow, "123")
+
+  con <- orderly_db("destination", root = path)
+  on.exit(DBI::dbDisconnect(con))
+  workflow <- DBI::dbGetQuery(con, "SELECT * FROM workflow")
+  expect_equal(workflow, data_frame(id = "123"))
+  report_version_workflow <-
+    DBI::dbGetQuery(con, "SELECT * FROM report_version_workflow")
+  expect_equal(report_version_workflow, data_frame(report_version = id,
+                                                   workflow_id = "123"))
+
+  id2 <- orderly_run_internal("example", root = path, id_file = tmp,
+                             commit = TRUE, echo = FALSE,
+                             workflow_id = "123")
+  rds <- path_orderly_run_rds(file.path(path, "archive", "example", id2))
+  expect_true(file.exists(rds))
+  dat <- readRDS(rds)
+  expect_equal(dat$meta$workflow, "123")
+  workflow <- DBI::dbGetQuery(con, "SELECT * FROM workflow")
+  expect_equal(workflow, data_frame(id = "123"))
+  report_version_workflow <-
+    DBI::dbGetQuery(con, "SELECT * FROM report_version_workflow")
+  expect_equal(report_version_workflow,
+               data_frame(report_version = c(id, id2),
+                          workflow_id = c("123", "123")))
+})