Merge branch 'main' into mrc-5102

.Rbuildignore

@@ -21,3 +21,5 @@
 ^\.covrignore$
 ^\.github$
 \.*gcov$
+^.*\.Rproj$
+^\.Rproj\.user$

DESCRIPTION

@@ -8,14 +8,14 @@ Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
 Description: Small HTTP server for running orderly reports.
 License: MIT + file LICENSE
 Encoding: UTF-8
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Roxygen: list(markdown = TRUE, roclets = c("rd", "namespace", "porcelain::porcelain_roclet"))
 URL: https://github.com/mrc-ide/orderly.runner
 BugReports: https://github.com/mrc-ide/orderly.runner/issues
 Imports:
     cli,
     docopt,
-    gert,
+    gert (>= 2.0.1),
     ids,
     jsonlite,
     orderly2,
@@ -25,6 +25,7 @@ Imports:
     rrq,
     withr
 Suggests:
+    fs,
     httr,
     lgr,
     mockery,
@@ -33,4 +34,5 @@ Config/testthat/edition: 3
 Remotes:
     mrc-ide/orderly2,
     reside-ic/porcelain,
-    mrc-ide/rrq
+    mrc-ide/rrq,
+    r-lib/gert

R/api.R

@@ -16,7 +16,6 @@
 ##'
 ##' @export
 api <- function(root, validate = NULL, log_level = "info") {
-  orderly2::orderly_list_src(root, locate = FALSE)
   logger <- porcelain::porcelain_logger(log_level)
   api <- porcelain::porcelain$new(validate = validate, logger = logger)
   api$include_package_endpoints(state = list(root = root))
@@ -30,3 +29,21 @@ root <- function() {
                    orderly.runner = package_version_string("orderly.runner"))
   lapply(versions, scalar)
 }
+
+
+##' @porcelain 
+##'   GET /report/list => json(report_list)
+##'   query hash :: string
+##'   state root :: root
+report_list <- function(root, hash) {
+  contents <- gert::git_ls(root, ref = hash)
+  re <- "^src/([^/]+)/(\\1|orderly)\\.(yml|R)$"
+  nms <- sub(re, "\\1", 
+             grep(re, contents$path, value = TRUE, perl = TRUE),
+             perl = TRUE)
+  last_changed <- function(nm) {
+    max(contents$modified[startsWith(contents$path, sprintf("src/%s", nm))])
+  }
+  data.frame(name = nms, 
+             updated_time = vnapply(nms, last_changed, USE.NAMES = FALSE))
+}

R/porcelain.R

@@ -8,5 +8,15 @@
         root,
         returning = porcelain::porcelain_returning_json("root"),
         validate = validate)
+    },
+    "GET /report/list" = function(state, validate) {
+      porcelain::porcelain_endpoint$new(
+        "GET",
+        "/report/list",
+        report_list,
+        porcelain::porcelain_input_query(hash = "string"),
+        porcelain::porcelain_state(root = state$root),
+        returning = porcelain::porcelain_returning_json("report_list"),
+        validate = validate)
     })
 }

R/util.R

@@ -11,3 +11,13 @@ scalar <- function(x) {
 package_version_string <- function(name) {
   as.character(utils::packageVersion(name))
 }
+
+
+vcapply <- function(...) {
+  vapply(FUN.VALUE = character(1), ...)
+}
+
+
+vnapply <- function(X, FUN, ...) { # nolint
+  vapply(X, FUN, numeric(1), ...)
+}

inst/schema/report_list.json

@@ -0,0 +1,11 @@
+{
+    "$schema": "http://json-schema.org/draft-07/schema#",
+    "type": "array",
+    "items": {
+      "type": "object",
+      "properties": {
+        "name": { "type": "string" },
+        "updated_time": { "type": "number" }
+      }
+    }
+}

orderly.runner.Rproj

@@ -0,0 +1,17 @@
+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source

tests/testthat/examples/data/data.R

@@ -0,0 +1,3 @@
+orderly2::orderly_artefact("Some data", "data.rds")
+d <- data.frame(a = 1:10, x = runif(10), y = 1:10 + runif(10))
+saveRDS(d, "data.rds")

tests/testthat/examples/parameters/orderly.R

@@ -0,0 +1,2 @@
+orderly2::orderly_parameters(a = NULL, b = 2, c = NULL)
+saveRDS(list(a = a, b = b, c = c), "data.rds")

tests/testthat/helper-orderly-runner.R

@@ -4,7 +4,6 @@ orderly_runner_endpoint <- function(method, path, root, validate = TRUE) {
                                         validate = validate)
 }
 
-
 create_temporary_root <- function(...) {
   path <- tempfile()
   withr::defer_parent(unlink(path, recursive = TRUE))
@@ -30,3 +29,32 @@ skip_if_no_redis <- function() {
   }
   invisible(available)
 }
+
+test_prepare_orderly_example <- function(examples, ...) {
+  tmp <- tempfile()
+  withr::defer_parent(unlink(tmp, recursive = TRUE))
+  suppressMessages(orderly2::orderly_init(tmp, ...))
+  copy_examples(examples, tmp)
+  as.character(fs::path_norm(tmp))
+}
+
+copy_examples <- function(examples, path_src) {
+  fs::dir_create(path_src)
+
+  fs::dir_create(file.path(path_src, "src"))
+  for (i in examples) {
+    fs::dir_copy(test_path("examples", i), file.path(path_src, "src"))
+  }
+}
+
+helper_add_git <- function(path) {
+  gert::git_init(path)
+  gert::git_add(".", repo = path)
+  user <- "author <[email protected]>"
+  sha <- gert::git_commit("initial", author = user, committer = user,
+                          repo = path)
+  branch <- gert::git_branch(repo = path)
+  url <- "https://example.com/git"
+  gert::git_remote_add(url, repo = path)
+  list(path = path, user = user, branch = branch, sha = sha, url = url)
+}

tests/testthat/test-api.R

@@ -18,3 +18,33 @@ test_that("Can construct the api", {
   expect_length(logs, 2)
   expect_equal(logs[[1]]$logger, "orderly.runner")
 })
+
+
+test_that("can list orderly reports", {
+  path <- test_prepare_orderly_example(c("data", "parameters"))
+  repo <- helper_add_git(path)
+  endpoint <- orderly_runner_endpoint("GET", "/report/list", path)
+
+  res <- endpoint$run(repo$branch)
+  expect_equal(res$status_code, 200)
+  expect_setequal(res$data$name, c("data", "parameters"))
+  expect_true(all(res$data$updated_time > (Sys.time() - 100)))
+
+  ## Delete a report on a 2nd branch
+  gert::git_branch_create("other", repo = path)
+  unlink(file.path(path, "src", "data"), recursive = TRUE)
+  gert::git_add(".", repo = path)
+  sha <- gert::git_commit("Remove data report", repo = path,
+                          author = "Test User <[email protected]>")
+
+  ## Can list items from this sha
+  other_res <- endpoint$run(sha)
+  expect_equal(other_res$status_code, 200)
+  expect_equal(other_res$data$name, "parameters")
+
+  ## We can still see all reports on main branch
+  first_commit_res <- endpoint$run(repo$sha)
+  expect_equal(first_commit_res$status_code, 200)
+  expect_setequal(first_commit_res$data$name, 
+                  c("data", "parameters"))
+})

tests/testthat/test-zzz-e2e.R

@@ -1,8 +1,11 @@
+skip_if_not_installed("httr")
+root <- test_prepare_orderly_example(c("data", "parameters"))
+repo <- helper_add_git(root)
+bg <- porcelain::porcelain_background$new(api, list(root))
+bg$start()
+on.exit(bg$stop())
+
 test_that("can run server", {
-  skip_if_not_installed("httr")
-  root <- create_temporary_root(use_file_store = TRUE)
-  bg <- porcelain::porcelain_background$new(api, list(root))
-  bg$start()
   r <- bg$request("GET", "/")
   expect_equal(httr::status_code(r), 200)
 
@@ -14,3 +17,14 @@ test_that("can run server", {
   expect_equal(dat$data$orderly.runner,
                package_version_string("orderly.runner"))
 })
+
+test_that("can list reports", {
+  r <- bg$request("GET", "/report/list?hash=HEAD")
+  expect_equal(httr::status_code(r), 200)
+
+  dat <- httr::content(r)
+  expect_equal(dat$status, "success")
+  expect_null(dat$errors)
+  reports <- vcapply(dat$data, "[[", "name")
+  expect_true(all(c("data", "parameters") %in% reports))
+})