diff --git a/DESCRIPTION b/DESCRIPTION index b092671..2e8b3dc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -18,7 +18,7 @@ Imports: gert (>= 2.0.1), ids, jsonlite, - orderly2, + orderly2 (>= 1.99.13), porcelain, R6, redux, diff --git a/R/api.R b/R/api.R index c01881a..5d2a5d4 100644 --- a/R/api.R +++ b/R/api.R @@ -37,7 +37,7 @@ root <- function() { ##' state root :: root report_list <- function(root, ref) { contents <- gert::git_ls(root, ref = ref) - re <- "^src/([^/]+)/(\\1|orderly)\\.(yml|R)$" + re <- "^src/([^/]+)/(\\1|orderly)\\.R$" nms <- sub(re, "\\1", grep(re, contents$path, value = TRUE, perl = TRUE), perl = TRUE) @@ -54,3 +54,19 @@ report_list <- function(root, ref) { updated_time = updated_time, has_modifications = has_modifications) } + + +##' @porcelain +##' GET /report//parameters => json(report_parameters) +##' query ref :: string +##' state root :: root +report_parameters <- function(root, ref, name) { + params <- get_report_parameters(name, ref, root) + lapply(names(params), function(param_name) { + value <- params[[param_name]] + list( + name = scalar(param_name), + value = if (is.null(value)) value else scalar(as.character(value)) + ) + }) +} diff --git a/R/porcelain.R b/R/porcelain.R index 3d81a7d..c073969 100644 --- a/R/porcelain.R +++ b/R/porcelain.R @@ -18,5 +18,15 @@ porcelain::porcelain_state(root = state$root), returning = porcelain::porcelain_returning_json("report_list"), validate = validate) + }, + "GET /report//parameters" = function(state, validate) { + porcelain::porcelain_endpoint$new( + "GET", + "/report//parameters", + report_parameters, + porcelain::porcelain_input_query(ref = "string"), + porcelain::porcelain_state(root = state$root), + returning = porcelain::porcelain_returning_json("report_parameters"), + validate = validate) }) } diff --git a/R/reports.R b/R/reports.R new file mode 100644 index 0000000..00bf0a3 --- /dev/null +++ b/R/reports.R @@ -0,0 +1,23 @@ +get_report_parameters <- function(name, ref, root) { + path <- get_orderly_script_path(name, ref, root) + sha <- gert::git_commit_id(ref, repo = root) + contents <- git_run( + c("show", sprintf("%s:%s", sha, path)), repo = root, check = TRUE + )$output + exprs <- parse(text = contents) + orderly2::orderly_parse_expr(exprs, filename = basename(path))$parameters +} + + +get_orderly_script_path <- function(name, ref, root) { + contents <- gert::git_ls(root, ref = ref) + re <- sprintf("^src/%s/(%s|orderly)\\.R$", name, name) + matches <- grep(re, contents$path, value = TRUE, perl = TRUE) + if (length(matches) != 1) { + num <- length(matches) + cli::cli_abort( + c("Found {num} valid orderly script{?s}. There must be one and only one.", + setNames(matches, rep("*", length(matches))))) + } + matches +} diff --git a/inst/schema/report_parameters.json b/inst/schema/report_parameters.json new file mode 100644 index 0000000..0ce8e45 --- /dev/null +++ b/inst/schema/report_parameters.json @@ -0,0 +1,13 @@ +{ + "$schema": "http://json-schema.org/draft-07/schema#", + "type": "array", + "items": { + "type": "object", + "properties": { + "name": { "type": "string" }, + "value": { "type": [ "string", "null" ] } + }, + "required": [ "name", "value" ], + "additionalProperties": false + } +} diff --git a/tests/testthat/helper-orderly-runner.R b/tests/testthat/helper-orderly-runner.R index ab2bc8b..6eb76ed 100644 --- a/tests/testthat/helper-orderly-runner.R +++ b/tests/testthat/helper-orderly-runner.R @@ -69,14 +69,11 @@ copy_examples <- function(examples, path_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) + sha <- git_add_and_commit(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) + list(path = path, branch = branch, sha = sha, url = url) } @@ -88,11 +85,16 @@ initialise_git_repo <- function() { } -create_new_commit <- function(path, new_file = "new", message = "new message") { - writeLines("new file", file.path(path, new_file)) +git_add_and_commit <- function(path) { gert::git_add(".", repo = path) user <- "author " - gert::git_commit(message, author = user, committer = user, repo = path) + gert::git_commit("new commit", author = user, committer = user, repo = path) +} + + +create_new_commit <- function(path, new_file = "new") { + writeLines("new file", file.path(path, new_file)) + git_add_and_commit(path) } diff --git a/tests/testthat/test-api.R b/tests/testthat/test-api.R index 4ecc4d2..97e1e4c 100644 --- a/tests/testthat/test-api.R +++ b/tests/testthat/test-api.R @@ -34,9 +34,7 @@ test_that("can list orderly reports", { gert::git_branch_create("other", repo = repo$local) fs::dir_copy(file.path(repo$local, "src", "parameters"), file.path(repo$local, "src", "parameters2")) - gert::git_add(".", repo = repo$local) - sha <- gert::git_commit("Add report data2", repo = repo$local, - author = "Test User ") + sha <- git_add_and_commit(repo$local) ## Can list items from this sha other_res <- endpoint$run(sha) @@ -54,3 +52,22 @@ test_that("can list orderly reports", { expect_equal(first_commit_res$status_code, 200) expect_equal(first_commit_res$data, res$data) }) + + +test_that("can get parameters for a report", { + repo <- test_prepare_orderly_remote_example(c("data", "parameters")) + endpoint <- orderly_runner_endpoint("GET", "/report//parameters", + repo$local) + + res <- endpoint$run("HEAD", "data") + expect_equal(res$status_code, 200) + expect_equal(res$data, list()) + + res <- endpoint$run("HEAD", "parameters") + expect_equal(res$status_code, 200) + expect_equal(res$data, list( + list(name = scalar("a"), value = NULL), + list(name = scalar("b"), value = scalar("2")), + list(name = scalar("c"), value = NULL)) + ) +}) diff --git a/tests/testthat/test-git.R b/tests/testthat/test-git.R index 516cc73..1524cde 100644 --- a/tests/testthat/test-git.R +++ b/tests/testthat/test-git.R @@ -25,10 +25,7 @@ test_that("can get files which have been modified", { testthat::skip_on_cran() repo <- test_prepare_orderly_remote_example("data") copy_examples("parameters", repo$local) - gert::git_add(".", repo = repo$local) - user <- "author " - gert::git_commit("add parameters", author = user, committer = user, - repo = repo$local) + git_add_and_commit(repo$local) log <- gert::git_log(repo = repo$local) expect_equal(git_get_modified(log$commit[[2]], repo = repo$local), diff --git a/tests/testthat/test-reports.R b/tests/testthat/test-reports.R new file mode 100644 index 0000000..2d9fbe2 --- /dev/null +++ b/tests/testthat/test-reports.R @@ -0,0 +1,45 @@ +test_that("can get orderly script name", { + root <- test_prepare_orderly_example(c("data", "parameters")) + git_info <- helper_add_git(root) + expect_equal(get_orderly_script_path("data", "HEAD", root), "src/data/data.R") + expect_equal(get_orderly_script_path("parameters", "HEAD", root), + "src/parameters/orderly.R") + + file.copy(file.path(root, "src", "data", "data.R"), + file.path(root, "src", "data", "orderly.R")) + git_add_and_commit(root) + + expect_error( + get_orderly_script_path("data", "HEAD", root), + "Found 2 valid orderly scripts. There must be one and only one.") +}) + + +test_that("can get report parameters", { + root <- test_prepare_orderly_example(c("data", "parameters")) + git_info <- helper_add_git(root) + + params <- get_report_parameters("data", "HEAD", root) + expect_null(params) + + params <- get_report_parameters("parameters", "HEAD", root) + expect_equal(params, list(a = NULL, + b = 2, + c = NULL)) + + ## Works with a specific git hash + params_src <- file.path(root, "src", "parameters", "orderly.R") + contents <- readLines(params_src) + contents <- c("orderly2::orderly_parameters(a = 'default', b = 2, c = NULL)", + contents[-1]) + writeLines(contents, params_src) + sha <- git_add_and_commit(root) + + params_new <- get_report_parameters("parameters", sha, root) + expect_equal(params_new, list(a = "default", + b = 2, + c = NULL)) + + params_old <- get_report_parameters("parameters", git_info$sha, root) + expect_equal(params, params_old) +}) diff --git a/tests/testthat/test-util.R b/tests/testthat/test-util.R index 19bc43d..b01211b 100644 --- a/tests/testthat/test-util.R +++ b/tests/testthat/test-util.R @@ -17,4 +17,4 @@ test_that("sys_which", { prog <- "a-path-that-does-not-exist" expect_error(sys_which(prog), "Did not find 'a-path-that-does-not-exist'") -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-zzz-e2e.R b/tests/testthat/test-zzz-e2e.R index bcaf32e..fef2418 100644 --- a/tests/testthat/test-zzz-e2e.R +++ b/tests/testthat/test-zzz-e2e.R @@ -18,6 +18,7 @@ test_that("can run server", { package_version_string("orderly.runner")) }) + test_that("can list reports", { r <- bg$request("GET", "/report/list?ref=HEAD") expect_equal(httr::status_code(r), 200) @@ -28,3 +29,26 @@ test_that("can list reports", { reports <- vcapply(dat$data, "[[", "name") expect_true(all(c("data", "parameters") %in% reports)) }) + + +test_that("can get parameters", { + r <- bg$request("GET", "/report/data/parameters?ref=HEAD") + expect_equal(httr::status_code(r), 200) + + dat <- httr::content(r) + expect_equal(dat$status, "success") + expect_null(dat$errors) + expect_equal(dat$data, list()) + + r <- bg$request("GET", "/report/parameters/parameters?ref=HEAD") + expect_equal(httr::status_code(r), 200) + + dat <- httr::content(r) + expect_equal(dat$status, "success") + expect_null(dat$errors) + expect_equal(dat$data, list( + list(name = "a", value = NULL), + list(name = "b", value = "2"), + list(name = "c", value = NULL) + )) +})