diff --git a/.github/workflows/check.yml b/.github/workflows/check.yml
index 600f376..43a04ee 100644
--- a/.github/workflows/check.yml
+++ b/.github/workflows/check.yml
@@ -2,17 +2,6 @@
name: Check 📦
on:
- pull_request:
- types:
- - opened
- - synchronize
- - reopened
- - ready_for_review
- branches:
- - main
- push:
- branches:
- - main
workflow_call:
concurrency:
@@ -25,8 +14,6 @@ jobs:
runs-on: ubuntu-latest
container:
image: ${{ vars.CI_IMAGE }}
- env:
- GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
steps:
- name: Checkout project ⬇️
diff --git a/.github/workflows/gitleaks.yml b/.github/workflows/gitleaks.yml
index d9a2680..10cd967 100644
--- a/.github/workflows/gitleaks.yml
+++ b/.github/workflows/gitleaks.yml
@@ -1,18 +1,7 @@
---
name: Gitleaks 🌧️
-on:
- pull_request:
- types:
- - opened
- - synchronize
- - reopened
- - ready_for_review
- branches:
- - main
- push:
- branches:
- - main
+on:
workflow_call:
inputs:
gitleaks-version:
diff --git a/.github/workflows/lintr.yml b/.github/workflows/lintr.yml
index 34d6c75..94954cb 100644
--- a/.github/workflows/lintr.yml
+++ b/.github/workflows/lintr.yml
@@ -2,17 +2,6 @@
name: Lintr 🔍
on:
- pull_request:
- types:
- - opened
- - synchronize
- - reopened
- - ready_for_review
- branches:
- - main
- push:
- branches:
- - main
workflow_call:
inputs:
lintr_error_on_lint:
@@ -31,8 +20,6 @@ jobs:
runs-on: ubuntu-latest
container:
image: ${{ vars.CI_IMAGE }}
- env:
- GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
steps:
- name: Checkout project ⬇️
diff --git a/.github/workflows/pkgdown.yml b/.github/workflows/pkgdown.yml
index 5ad72e4..7517079 100644
--- a/.github/workflows/pkgdown.yml
+++ b/.github/workflows/pkgdown.yml
@@ -2,17 +2,6 @@
name: Pkgdown 📖
on:
- pull_request:
- types:
- - opened
- - synchronize
- - reopened
- - ready_for_review
- branches:
- - main
- push:
- branches:
- - main
workflow_call:
concurrency:
@@ -25,8 +14,6 @@ jobs:
runs-on: ubuntu-latest
container:
image: ${{ vars.CI_IMAGE }}
- env:
- GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
steps:
- name: Checkout project ⬇️
diff --git a/.github/workflows/roxygen.yml b/.github/workflows/roxygen.yml
index 14c6d3d..2dd2b6c 100644
--- a/.github/workflows/roxygen.yml
+++ b/.github/workflows/roxygen.yml
@@ -2,17 +2,6 @@
name: Roxygen 📄
on:
- pull_request:
- types:
- - opened
- - synchronize
- - reopened
- - ready_for_review
- branches:
- - main
- push:
- branches:
- - main
workflow_call:
concurrency:
@@ -25,8 +14,6 @@ jobs:
runs-on: ubuntu-latest
container:
image: ${{ vars.CI_IMAGE }}
- env:
- GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
steps:
- name: Checkout project ⬇️
diff --git a/.github/workflows/shared_ci.yml b/.github/workflows/shared_ci.yml
index 1e9fb20..9818295 100644
--- a/.github/workflows/shared_ci.yml
+++ b/.github/workflows/shared_ci.yml
@@ -2,6 +2,17 @@
name: Checks 🧩
on:
+ pull_request:
+ types:
+ - opened
+ - synchronize
+ - reopened
+ - ready_for_review
+ branches:
+ - main
+ push:
+ branches:
+ - main
workflow_call:
jobs:
@@ -10,7 +21,7 @@ jobs:
uses: boehringer-ingelheim/dv.templates/.github/workflows/check.yml@main
test:
- name: Test 📦
+ name: Test and QC 🧪
uses: boehringer-ingelheim/dv.templates/.github/workflows/test.yml@main
lintr:
diff --git a/.github/workflows/styler.yml b/.github/workflows/styler.yml
index b6db137..313d9e1 100644
--- a/.github/workflows/styler.yml
+++ b/.github/workflows/styler.yml
@@ -2,17 +2,6 @@
name: Styler 🦄
on:
- pull_request:
- types:
- - opened
- - synchronize
- - reopened
- - ready_for_review
- branches:
- - main
- push:
- branches:
- - main
workflow_call:
concurrency:
@@ -25,8 +14,6 @@ jobs:
runs-on: ubuntu-latest
container:
image: ${{ vars.CI_IMAGE }}
- env:
- GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
steps:
- name: Checkout project ⬇️
diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index d8cf070..933b991 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -1,52 +1,47 @@
---
-name: Test 📦
-
-on:
- pull_request:
- types:
- - opened
- - synchronize
- - reopened
- - ready_for_review
- branches:
- - main
- push:
- branches:
- - main
+name: Test and QC 🧪
+
+on:
workflow_call:
concurrency:
group: test-${{ github.event.pull_request.number || github.ref }}
cancel-in-progress: true
+env:
+ TEMPLATE_REF: main
+ TEMPLATE_REPO: boehringer-ingelheim/dv.templates
+
jobs:
test:
name: ${{ vars.CI_IMAGE }}
runs-on: ubuntu-latest
container:
image: ${{ vars.CI_IMAGE }}
- env:
- GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
steps:
- name: Checkout project ⬇️
uses: actions/checkout@v4
- - name: Checkout Repo Templates
+ - name: Checkout templates repo ⬇️
uses: actions/checkout@v4
with:
- ref: main
- repository: boehringer-ingelheim/dv.templates
+ ref: ${{env.TEMPLATE_REF}}
+ repository: ${{env.TEMPLATE_REPO}}
+ sparse-checkout: |
+ scripts/
+ inst/validation
path: templates
- name: Install package dependencies 📄
uses: boehringer-ingelheim/dv.templates/.github/actions/dependencies@main
- - name: Test 📦
- run: Rscript templates/scripts/test.R
+ - name: Test and QC 🧪
+ run: templates/scripts/test_qc_pkg.R
+ shell: Rscript {0}
- - name: Archive validation results
+ - name: Archive validation results ⬆️
uses: actions/upload-artifact@v4
with:
name: val_results
- path: inst/validation/results
+ path: inst/validation/results
\ No newline at end of file
diff --git a/README.md b/README.md
index bfce9c8..7e3fbf2 100644
--- a/README.md
+++ b/README.md
@@ -1,6 +1,7 @@
# dv.templates
[![Build status](https://github.com/boehringer-ingelheim/dv.templates/actions/workflows/check.yml/badge.svg)](https://github.com/boehringer-ingelheim/dv.templates/actions/workflows/check.yml?query=workflow)
+[![Build status](https://github.com/boehringer-ingelheim/dv.templates/actions/workflows/test.yml/badge.svg)](https://github.com/boehringer-ingelheim/dv.templates/actions/workflows/test.yml?query=workflow)
[![Build status](https://github.com/boehringer-ingelheim/dv.templates/actions/workflows/gitleaks.yml/badge.svg)](https://github.com/boehringer-ingelheim/dv.templates/actions/workflows/gitleaks.yml?query=workflow)
[![Build status](https://github.com/boehringer-ingelheim/dv.templates/actions/workflows/lintr.yml/badge.svg)](https://github.com/boehringer-ingelheim/dv.templates/actions/workflows/lintr.yml?query=workflow)
[![Build status](https://github.com/boehringer-ingelheim/dv.templates/actions/workflows/pkgdown.yml/badge.svg)](https://github.com/boehringer-ingelheim/dv.templates/actions/workflows/pkgdown.yml?query=workflow)
diff --git a/inst/validation/results/.gitempty b/inst/validation/results/.gitempty
new file mode 100644
index 0000000..e69de29
diff --git a/inst/validation/run_validation.R b/inst/validation/run_validation.R
new file mode 100644
index 0000000..e66e4c0
--- /dev/null
+++ b/inst/validation/run_validation.R
@@ -0,0 +1,40 @@
+local({
+ # This is evaluated inside a local because, otherwise, all the variables created in the chunks of the rendered
+ # document leak into the environment
+
+ validation_root <- "./inst/validation"
+ validation_report_rmd <- file.path(validation_root, "val_report.Rmd")
+ validation_report_html <- "val_report.html"
+ validation_results <- file.path(validation_root, "results")
+ val_param_rds <- file.path(validation_results, "val_param.rds")
+
+ stopifnot(dir.exists(validation_root))
+ stopifnot(file.exists(validation_report_rmd))
+
+ stopifnot(dir.exists(validation_results))
+ unlink(list.files(validation_results))
+
+ saveRDS(
+ list(
+ package = pkg_name,
+ tests = test_results,
+ version = pkg_version
+ ),
+ val_param_rds
+ )
+
+ rmarkdown::render(
+ input = validation_report_rmd,
+ params = list(
+ package = pkg_name,
+ tests = test_results,
+ version = pkg_version
+ ),
+ output_dir = validation_results,
+ output_file = validation_report_html
+ )
+
+ # We use one of the leaked variables, created inside the validation report to asses if the validation is
+ # succesful or not
+ VALIDATION_PASSED
+})
diff --git a/inst/validation/specs.R b/inst/validation/specs.R
new file mode 100644
index 0000000..4903b4f
--- /dev/null
+++ b/inst/validation/specs.R
@@ -0,0 +1,7 @@
+# Use a list to declare the specs
+
+specs_list <- list
+
+example_spec <- specs_list(
+ a_spec = "spec"
+)
diff --git a/inst/validation/utils-validation.R b/inst/validation/utils-validation.R
new file mode 100644
index 0000000..5dc7360
--- /dev/null
+++ b/inst/validation/utils-validation.R
@@ -0,0 +1,148 @@
+#' Setting up the validation
+#'
+#' 1. Add package_name
+#' 2. Copy that variable and the contents of if block to tests/testthat/setup.R
+#' (If you are using the template this may already be in place for you)
+
+package_name <- "dv.templates"
+
+if (FALSE) {
+ # validation (S)
+ vdoc <- source(
+ system.file("validation", "utils-validation.R", package = package_name, mustWork = TRUE),
+ local = TRUE
+ )[["value"]]
+ specs <- vdoc[["specs"]]
+ # validation (F)
+}
+
+#' 2. For those tests that cover an specific spec
+
+if (FALSE) {
+ test_that(
+ vdoc[["add_spec"]]("my test description", specs[["a_spec"]]),
+ {
+ expect_true(TRUE)
+ }
+ )
+}
+#' The specs variable on the call references the one declared in point 1
+
+#' 3. For those tests covering more than one spec.
+#' NOTE: It must be c() and not list()
+#'
+
+if (FALSE) {
+ test_that(
+ vdoc[["add_spec"]]("my test_description", c(specs$my$hier$spec, vdoc_specs$my$hier$other_spec)),
+ {
+ expect_true(TRUE)
+ }
+ )
+}
+
+#' Considerations:
+#' - parse_spec uses deparse(substitute()). These spec_ids are later used to check if all requirements
+#' are covered or not, therefore those calls cannot by substituted for:
+
+if (FALSE) {
+ my_spec <- specs$my$hier$spec
+ test_that(vdoc$parse_spec(my_spec, "my test_description"), {
+ ...
+ })
+}
+
+# In this case the substitute captures my_spec and cannot be used later.
+# If you want to do this you must use the spec_id parameter where you pass a
+# character vector with the ids.
+# Notice that the ids in character form do no longer have the specs particle
+# at the beginning, only the pathing of the spec is needed.
+
+if (FALSE) {
+ my_spec <- specs$my$hier$spec
+ test_that(vdoc$parse_spec(my_spec, "my test_description", spec_id = c("my$hier$spec")), {
+ ...
+ })
+}
+
+# Validation code
+
+local({
+ specs <- source(
+ system.file("validation", "specs.R", package = package_name, mustWork = TRUE),
+ local = TRUE
+ )[["value"]]
+ recursive_ids <- function(x, parent = character(0)) {
+ if (!is.list(x)) {
+ return(parent)
+ }
+ unlist(mapply(recursive_ids,
+ x,
+ paste(parent, names(x),
+ sep = if (identical(parent, character(0))) "" else "$"
+ ),
+ SIMPLIFY = FALSE, USE.NAMES = FALSE
+ ))
+ }
+
+ recursive_ids <- function(x, parent = character(0)) {
+ if (!is.list(x)) {
+ return(parent)
+ }
+ unlist(mapply(recursive_ids, x,
+ paste(parent, names(x),
+ sep = if (identical(parent, character(0))) "" else "$"
+ ),
+ SIMPLIFY = FALSE, USE.NAMES = FALSE
+ ))
+ }
+
+
+ spec_id_list <- recursive_ids(specs)
+
+ list(
+ specs = specs,
+ spec_id_list = spec_id_list,
+ add_spec = function(desc, spec, spec_id) {
+ if (missing(spec_id)) {
+ if (!is.character(spec) || length(spec) == 0) stop("spec must be a non-empty character vector")
+ s_spec <- substitute(spec)
+ if (s_spec[[1]] == "c") {
+ spec_id <- sapply(s_spec[2:length(s_spec)], identity)
+ } else {
+ spec_id <- list(s_spec) # Otherwise the posterior vapply iterates over the expression
+ }
+
+ spec_id_chr <- vapply(spec_id, function(x) {
+ sub("^[^$]*\\$", "", deparse(x))
+ }, FUN.VALUE = character(1))
+
+ if (!all(spec_id_chr %in% spec_id_list)) {
+ stop("At least one spec is not declared in the spec list")
+ } # This should be covered by pack of constants but just in case
+ } else {
+ spec_id_chr <- spec_id
+ }
+ structure(desc, spec_id = spec_id_chr, spec = spec)
+ },
+ get_spec = function(result) {
+ lapply(
+ result,
+ function(x) {
+ first_result <- try(
+ x[[1]][["test"]],
+ silent = TRUE
+ )
+ if (inherits(first_result, "try-error")) {
+ list(spec_id = NULL, desc = NULL)
+ } else {
+ list(
+ spec_id = attr(first_result, "spec_id", exact = TRUE),
+ spec = attr(first_result, "spec", exact = TRUE)
+ )
+ }
+ }
+ )
+ }
+ )
+})
diff --git a/inst/validation/val_report.Rmd b/inst/validation/val_report.Rmd
new file mode 100644
index 0000000..26a97e9
--- /dev/null
+++ b/inst/validation/val_report.Rmd
@@ -0,0 +1,17 @@
+---
+title: "Quality Control"
+output:
+ html_document:
+ toc: true
+ toc_depth: 2
+ code_folding: hide
+toc-title: "----\nIndex"
+
+params:
+ package: NULL
+ tests: NULL
+ version: NULL
+---
+
+```{r, child = "val_report_child.Rmd"}
+```
diff --git a/inst/validation/val_report_child.Rmd b/inst/validation/val_report_child.Rmd
new file mode 100644
index 0000000..38e631f
--- /dev/null
+++ b/inst/validation/val_report_child.Rmd
@@ -0,0 +1,205 @@
+
+
+
+```{r setup, message = FALSE}
+# Import vdoc functions ----
+vdoc <- source(
+ system.file("validation", "utils-validation.R", package = params[["package"]], mustWork = TRUE),
+ local = TRUE
+)[["value"]]
+
+# Set required packages ----
+suppressPackageStartupMessages(stopifnot(requireNamespace("DT")))
+suppressPackageStartupMessages(stopifnot(requireNamespace("devtools")))
+
+# Parse tests ----
+
+tests <- as.data.frame(params[["tests"]])
+tests[["validation_data"]] <- vdoc[["get_spec"]](tests[["result"]])
+tests[["spec_id"]] <- sapply(tests[["validation_data"]], function(x) x[["spec_id"]])
+tests[["spec"]] <- sapply(tests[["validation_data"]], function(x) x[["spec"]])
+tests[["spec_id_paste"]] <- vapply(tests[["spec_id"]], function(x) paste(x, collapse = "\n"), FUN.VALUE = character(1))
+tests[["spec_paste"]] <- vapply(tests[["spec"]], function(x) paste(x, collapse = "\n"), FUN.VALUE = character(1))
+tests[["desc"]] <- paste0("(#", seq_len(nrow(tests)), "): ", tests[["test"]])
+tests[["with_spec"]] <- vapply(tests[["spec_id"]], Negate(is.null), FUN.VALUE = logical(1))
+
+spec_tests <- tests[tests[["with_spec"]], ]
+no_spec_tests <- tests[!tests[["with_spec"]], ]
+
+declared_spec <- vdoc[["spec_id_list"]]
+tested_spec <- unique(unlist(tests[["spec_id"]]))
+uncovered_spec <- declared_spec[!declared_spec %in% tested_spec]
+undeclared_spec <- tested_spec[!tested_spec %in% declared_spec]
+
+spec_tests[["are_declared"]] <- sapply(spec_tests[["spec_id"]], function(x) all(x %in% declared_spec))
+
+# Count tests in the different categories ----
+
+mask_failed <- !!spec_tests[["failed"]]
+mask_skipped <- !!spec_tests[["skipped"]]
+mask_declared <- spec_tests[["are_declared"]]
+n_pass_dec <- sum(!mask_failed & !mask_skipped & mask_declared)
+n_fail_dec <- sum(mask_failed & mask_declared)
+n_skip_dec <- sum(mask_skipped & mask_declared)
+n_uncov <- length(uncovered_spec)
+n_undec <- sum(!mask_declared)
+
+render_spec_table <- function(t) {
+ t <- t[trac_matrix_col]
+ colnames(t) <- names(trac_matrix_col)
+ t <- t[order(t[["Spec ID"]]), ]
+ DT::datatable(t, options = list(dom = "ltp"), filter = list(position = "top"))
+}
+
+data_frame_by_row <- function(colnames, data) {
+ n <- length(data)
+ n_cols <- length(colnames)
+ stopifnot(n %% n_cols == 0)
+ columns <- vector("list", length = n_cols)
+ for (i in 1:n_cols) columns[[i]] <- unlist(data[seq(i, n, n_cols)])
+ do.call(data.frame, setNames(columns, colnames))
+}
+
+# Select columns to be included in the tables ----
+trac_matrix_col <- c("Spec ID" = "spec_id_paste", "Spec" = "spec_paste", "Test Desc" = "desc", "File" = "file")
+
+# Check that validation passes and set title ----
+VALIDATION_PASSED <- n_fail_dec == 0 && n_uncov == 0 && n_undec == 0 && n_uncov == 0 # nolint
+
+result_symbol <- if (VALIDATION_PASSED) "\U02705" else "\U274C"
+title <- paste(result_symbol, params[["package"]], params[["version"]])
+```
+
+## `r title`
+
+The following document generates a report for R packages, to satisfy the criteria of a "Released" status under the **Non-GxP** project. The QC report contains the following information:
+
+- **Specifications (specs):** These can be attached to every test that the user adds.
+- **Traceability matrix:** Contains test cases with passed, failed, or skipped expectations.
+- **Uncovered or undeclared specs**
+- **Session Info and System Configuration**
+
+::: {.infobox .warning}
+Please be advised that the QC report generated for this module does not imply validation according to any other GxP criteria.
+The QC report only satisfies our internally developed quality checks for non-GxP criteria.
+For clinical reporting purposes, it is essential to note that any outputs generated using this module must be checked and verified within a validated system that adheres to the appropriate GxP guidelines.
+:::
+
+----
+# Traceability matrix
+
+In this traceability matrix only those tests that point to an specification are included.
+
+Test cases can contain several expectations a test is considered:
+
+ - **passed** if all expectations in the test pass.
+
+ - **failed** if at least one expectation in the test fails.
+
+ - **skipped** if at least one expectation in the test is skipped.
+
+A test can be both **failed** and **skipped**.
+
+## Summary
+
+```{r summary}
+data_frame_by_row(
+ colnames = c("Spec Exists", "Test", "Count", "color"),
+ data = list(
+ "Yes", "Pass", n_pass_dec, "white",
+ "Yes", "Failed", n_fail_dec, if (n_fail_dec > 0) "red" else "green",
+ "Yes", "Skipped", n_skip_dec, if (n_skip_dec > 0) "red" else "green",
+ "Yes", "No Test", n_uncov, if (n_uncov > 0) "red" else "green",
+ "No", "NA", n_undec, if (n_undec > 0) "red" else "green"
+ )
+) |>
+ DT::datatable(
+ rownames = FALSE,
+ options = list(columnDefs = list(list(visible = FALSE, targets = c(3))), dom = "tp"),
+ filter = list(position = "top")
+ ) |>
+ DT::formatStyle(
+ c("Count"),
+ valueColumns = "color",
+ backgroundColor = DT::JS("value")
+ )
+```
+
+## Passed tests
+
+```{r passed_test}
+render_spec_table(spec_tests[!mask_failed & !mask_skipped & mask_declared, ])
+```
+
+## Failed tests
+
+```{r failed_test}
+render_spec_table(spec_tests[mask_failed & mask_declared, ])
+```
+
+## Skipped tests
+
+```{r skipped_test}
+render_spec_table(spec_tests[mask_skipped & mask_declared, ])
+```
+
+## Uncovered specifications
+
+```{r uncovered_spec, echo=FALSE}
+data.frame("Uncovered Specifications" = uncovered_spec) |>
+ DT::datatable(
+ options = list(dom = "ltp"),
+ filter = list(position = "top")
+ )
+```
+
+## Undeclared specifications
+
+This should always be empty, as non existant specs are controlled during test execution.
+
+```{r undeclared_spec, echo=FALSE, results = "asis"}
+render_spec_table(spec_tests[!mask_declared, ])
+```
+
+# Session Info and System Configuration
+
+```{r system_conf}
+devtools::session_info()
+```
+
+# List of specifications
+```{r spec_list}
+j <- vapply(
+ vdoc[["spec_id_list"]],
+ function(x) {
+ eval(
+ str2expression(
+ paste0("vdoc[[\"specs\"]]$", x)
+ )
+ )
+ },
+ FUN.VALUE = character(1)
+) |>
+ gsub("\n", "", x = _, fixed = TRUE)
+
+data.frame(spec_id = names(j), spec = j) |>
+ DT::datatable(
+ rownames = FALSE,
+ options = list(
+ dom = "ltp"
+ ),
+ filter = list(position = "top"),
+ escape = FALSE
+ )
+```
diff --git a/scripts/test.R b/scripts/test_qc_pkg.R
similarity index 72%
rename from scripts/test.R
rename to scripts/test_qc_pkg.R
index 79804f9..517785c 100644
--- a/scripts/test.R
+++ b/scripts/test_qc_pkg.R
@@ -55,21 +55,32 @@ message("#######################################")
message("###### RENDERING VALIDATION (S) ######")
message("#######################################")
-success[["valdoc"]] <- local({
- # This is evaluated inside a local because, otherwise, all the variables created in the chunks of the rendered
- # document leak into the environment
+validation_root <- "./inst/validation"
+validation_exists <- dir.exists(validation_root)
+validation_report_rmd <- file.path(validation_root, "val_report.Rmd")
+validation_skip <- file.path(validation_root, "skip_qc")
+validation_report_html <- "val_report.html"
+validation_results <- file.path(validation_root, "results")
+val_param_rds <- file.path(validation_results, "val_param.rds")
- validation_root <- "./inst/validation"
- validation_report_rmd <- file.path(validation_root, "val_report.Rmd")
- validation_report_html <- "val_report.html"
- validation_results <- file.path(validation_root, "results")
- val_param_rds <- file.path(validation_results, "val_param.rds")
- stopifnot(dir.exists(validation_root))
- stopifnot(file.exists(validation_report_rmd))
+if (!dir.exists(validation_root)) {
+ message("### Quality Control documentation is not present")
+ message("### Include quality control documentation or skip it by creating following file 'inst/validation/skip_qc'")
+ stop("QC_doc_not_present")
+}
- stopifnot(dir.exists(validation_results))
- unlink(list.files(validation_results))
+if (file.exists(validation_skip)) {
+ success[["valdoc"]] <- NA
+} else {
+
+stopifnot(file.exists(validation_report_rmd))
+stopifnot(dir.exists(validation_results))
+unlink(list.files(validation_results))
+
+success[["valdoc"]] <- local({
+ # This is evaluated inside a local because, otherwise, all the variables created in the chunks of the rendered
+ # document leak into the environment
saveRDS(
list(
@@ -95,6 +106,8 @@ success[["valdoc"]] <- local({
VALIDATION_PASSED
})
+}
+
message("#######################################")
message("###### RENDERING VALIDATION (F) ######")
@@ -112,14 +125,20 @@ github_summary_file <- Sys.getenv("GITHUB_STEP_SUMMARY")
summary <- "# Test Summary"
summary <- c(
summary,
- purrr::imap_chr(success, ~ paste(" - ", if (.x) "\U02705" else "\U274C", "\t", .y))
+ purrr::imap_chr(success, ~{
+ symbol <- "\U02753"
+ symbol <- if (isTRUE(.x)) "\U02705"
+ symbol <- if (isFALSE(.x)) "\U0274C"
+ symbol <- if (is.na(.x)) "\U02757"
+ paste(" - ", symbol, .y)
+ })
)
CON <- file(github_summary_file, "a")
on.exit(close(CON))
writeLines(summary, CON)
-stopifnot(all(success))
+stopifnot(isTRUE(all(success)))
message("##############################")
message("###### BUILD RESULT (F) ######")
diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
new file mode 100644
index 0000000..92d0bdb
--- /dev/null
+++ b/tests/testthat/setup.R
@@ -0,0 +1,8 @@
+package_name <- "dv.templates"
+# validation (S)
+vdoc <- source(
+ system.file("validation", "utils-validation.R", package = package_name, mustWork = TRUE),
+ local = TRUE
+)[["value"]]
+specs <- vdoc[["specs"]]
+# validation (F)
diff --git a/tests/testthat/shiny-app/app.R b/tests/testthat/shiny-app/app.R
deleted file mode 100644
index 1b5835f..0000000
--- a/tests/testthat/shiny-app/app.R
+++ /dev/null
@@ -1,6 +0,0 @@
-if (Sys.getenv("CI") == "true") {
- pkgload::load_all(Sys.getenv("GITHUB_WORKSPACE"))
-} else {
- pkgload::load_all()
-}
-run_app()
diff --git a/tests/testthat/test-hello.R b/tests/testthat/test-hello.R
index 4dccc45..2d13182 100644
--- a/tests/testthat/test-hello.R
+++ b/tests/testthat/test-hello.R
@@ -3,3 +3,10 @@ test_that("hello greets the entity", {
expected <- "Hello, Foo"
expect_identical(result, expected)
})
+
+test_that(
+ vdoc[["add_spec"]]("my test description", specs$a_spec),
+ {
+ expect_true(TRUE)
+ }
+)
diff --git a/tests/testthat/test-shiny.R b/tests/testthat/test-shiny.R
index ed05572..9cc0283 100644
--- a/tests/testthat/test-shiny.R
+++ b/tests/testthat/test-shiny.R
@@ -1,5 +1,5 @@
test_that("the greeter app updates user's name on clicking the button", {
- app <- shinytest2::AppDriver$new(app_dir = "./shiny-app", name = "greeting_app")
+ app <- shinytest2::AppDriver$new(app_dir = run_app(), name = "greeting_app")
# WHEN: the user enters their name and clicks the "Greet" button
app$set_inputs(name = "Hello Bar")
diff --git a/workflows.md b/workflows.md
index ac4d256..4063b3e 100644
--- a/workflows.md
+++ b/workflows.md
@@ -4,6 +4,10 @@
Runs devtools::check() and devtools::test() on the R package inside the checked out repository.
+### [`test.yml`](https://github.com/boehringer-ingelheim/dv.templates/blob/main/.github/workflows/test.yml)
+
+Runs tests on the installed package, generates the qc documentation and uploads it as an artifact for later consumption.
+
### [`gitleaks.yml`](https://github.com/boehringer-ingelheim/dv.templates/blob/main/.github/workflows/gitleaks.yml)
Runs [`gitleaks`](https://github.com/zricethezav/gitleaks) on the repo to discover any secrets that might have been hardcoded.