diff --git a/.Rbuildignore b/.Rbuildignore index 1212a32..baae540 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -21,3 +21,5 @@ ^\.covrignore$ ^\.github$ \.*gcov$ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/DESCRIPTION b/DESCRIPTION index b6ed713..b092671 100644 --- a/DESCRIPTION +++ b/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 diff --git a/R/api.R b/R/api.R index 14d3fb7..5520ae5 100644 --- a/R/api.R +++ b/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)) +} diff --git a/R/porcelain.R b/R/porcelain.R index 4381491..e290b13 100644 --- a/R/porcelain.R +++ b/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) }) } diff --git a/R/util.R b/R/util.R index e376947..1cc2dd9 100644 --- a/R/util.R +++ b/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), ...) +} diff --git a/inst/schema/report_list.json b/inst/schema/report_list.json new file mode 100644 index 0000000..130b0de --- /dev/null +++ b/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" } + } + } +} diff --git a/orderly.runner.Rproj b/orderly.runner.Rproj new file mode 100644 index 0000000..21a4da0 --- /dev/null +++ b/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 diff --git a/tests/testthat/examples/data/data.R b/tests/testthat/examples/data/data.R new file mode 100644 index 0000000..c7a6add --- /dev/null +++ b/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") diff --git a/tests/testthat/examples/parameters/orderly.R b/tests/testthat/examples/parameters/orderly.R new file mode 100644 index 0000000..ecdcd5b --- /dev/null +++ b/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") diff --git a/tests/testthat/helper-orderly-runner.R b/tests/testthat/helper-orderly-runner.R index 51332af..3c8e3ba 100644 --- a/tests/testthat/helper-orderly-runner.R +++ b/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 " + 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) +} diff --git a/tests/testthat/test-api.R b/tests/testthat/test-api.R index f2d9155..ecd24f5 100644 --- a/tests/testthat/test-api.R +++ b/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 ") + + ## 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")) +}) diff --git a/tests/testthat/test-zzz-e2e.R b/tests/testthat/test-zzz-e2e.R index 5df394e..7cc6ee9 100644 --- a/tests/testthat/test-zzz-e2e.R +++ b/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)) +})