feat: unit testing framework

DESCRIPTION

@@ -1,12 +1,12 @@
 Package: mighty.component
-Title: Standard Components for ADaM Generation
-Version: 0.0.0.9016
+Title: Mighty Components for ADaM Generation
+Version: 0.0.0.9017
 Authors@R: c(
     person("Aksel", "Thomsen", , "oath@enovonordisk.com", role = c("aut", "cre")),
     person("Matthew", "Phelps", , "mewp@enovonordisk.com", role = c("aut")),
     person("Novo Nordisk A/S", role = "cph")
   )
-Description: Standard components library to be used inside the 'mighty'
+Description: Components to be used inside the 'mighty'
     framework for generation of ADaM programs.
 License: Apache License (>= 2)
 URL: https://novonordisk-opensource.github.io/mighty.component,
@@ -16,13 +16,16 @@ Depends:
 Imports: 
     cli,
     glue,
-    R6,
+    R6 (>= 2.4.0),
     rlang,
     whisker,
     xmlparsedata,
-    xml2
+    xml2,
+    zephyr
 Suggests: 
     admiral,
+    callr,
+    covr,
     dplyr,
     jsonlite,
     knitr,

NAMESPACE

@@ -4,9 +4,11 @@ export(get_component)
 export(get_rendered_component)
 export(get_rendered_standard)
 export(get_standard)
+export(get_test_component)
 export(list_standards)
 export(mighty_component)
 export(mighty_component_rendered)
+export(mighty_component_test)
 importFrom(R6,R6Class)
 importFrom(rlang,list2)
 importFrom(whisker,whisker.render)

R/component.R

@@ -58,3 +58,47 @@ get_rendered_component <- function(component, params = list()) {
   x <- get_component(component)
   do.call(what = x$render, args = params)
 }
+
+#' Create a testable component for unit testing
+#'
+#' @description
+#' Creates a `mighty_component_test` object from a rendered component,
+#' enabling structured unit testing with optional coverage checking.
+#'
+#' See [mighty_component_test] for a description of the testing workflow.
+#'
+#' @inheritParams get_component
+#' @param check_coverage `logical(1)` Whether to automatically check test
+#' coverage when the test completes. If `TRUE` (default), coverage is
+#' verified via `test_component$check_coverage()` in a deferred call.
+#' @param teardown_env The environment in which to register the deferred
+#' coverage check. Defaults to the caller's environment (`parent.frame()`).
+#' This controls when `check_coverage()` executes during test teardown.
+#'
+#' @return A `mighty_component_test` object.
+#'
+#' @seealso [get_rendered_component()], [mighty_component_test]
+#'
+#' @export
+get_test_component <- function(
+  component,
+  params = list(),
+  check_coverage = TRUE,
+  teardown_env = parent.frame()
+) {
+  x <- get_rendered_component(component, params)
+
+  test_component <- mighty_component_test$new(
+    template = x$template,
+    id = x$id
+  )
+
+  if (check_coverage) {
+    withr::defer(
+      expr = test_component$check_coverage(),
+      envir = teardown_env
+    )
+  }
+
+  test_component
+}

R/mighty.component-options.R

@@ -0,0 +1,19 @@
+#' @title Options for mighty.component
+#' @name mighty.component-options
+#' @description
+#' `r zephyr::list_options(as = "markdown", .envir = "mighty.component")`
+NULL
+
+#' @title Internal parameters for reuse in functions
+#' @name mighty.component-options-params
+#' @eval zephyr::list_options(as = "params", .envir = "mighty.component")
+#' @details
+#' See [mighty.component-options] for more information.
+#' @keywords internal
+NULL
+
+zephyr::create_option(
+  name = "verbosity_level",
+  default = NA_character_,
+  desc = "Verbosity level for functions in mighty.component. See [zephyr::verbosity_level] for details." # nolint: line_length_linter
+)

R/mighty_component.R

@@ -1,10 +1,10 @@
-#' Mighty standard component
+#' Mighty component
 #' @description
-#' Class for a generic mighty standard component.
+#' Class for a generic mighty component.
 #'
 #' In the mighty framework, a "component" is a code template that processes
 #' input data and returns a modified version with new columns or rows.
-#' Standard components share a common structure and roxygen-like documentation pattern,
+#' Mighty components share a common structure and roxygen-like documentation pattern,
 #' facilitating their use inside mighty.
 #'
 #' @details
@@ -23,24 +23,24 @@
 #' | `@description` | Description of the component                         | `@description text text` |
 #' | `@param`       | Specifies input used to render the component         | `@param variable new var`|
 #' | `@type`        | Specifies type: `r mighty.component:::valid_types()` | `@type derivation`       |
-#' | `@depends`     | Required input variable (repeat if several)          | `@depends .self USUBJID` |
+#' | `@depends`     | Required input variable (repeat if several)          | `@depends {{ domain }} USUBJID` |
 #' | `@outputs`     | Variables created (repeat if several)                | `@outputs NEWVAR`        |
 #' | `@code`        | Everything under this tag defines the component code | `@code`                  |
 #'
 #' ### Conventions
 #'
 #' A template for a standard components follow these conventions:
 #'
-#' 1. The input data set is always called `.self`.
+#' 1. The input data set is always called `{{ domain }}`.
 #' 1. Additional parameters used to render the template into R code are documented with the `@param` tag.
-#' 1. The template ends with creating a modified version of `.self`.
+#' 1. The template ends with creating a modified version of `{{ domain }}`.
 #' 1. Template documented with the roxygen-like tags above
 #'
 #' ### Example
 #'
 #' Below is an example of a mighty component template that
 #' creates a new dynamic variable `variable` as twice the value
-#' of the dynamic input `x`, that should already by in the input data set `.self`.
+#' of the dynamic input `x`, that should already by in the input data set `{{ domain }}`.
 #'
 #' ```r
 #' #' @title Title for my component
@@ -50,10 +50,10 @@
 #' #' @param variable dynamic output if applicable
 #' #' @param x some other input to the component
 #' #' @type derivation
-#' #' @depends .self {{ x }}
+#' #' @depends {{ domain }} {{ x }}
 #' #' @outputs {{ variable }}
 #' #' @code
-#' .self <- .self |>
+#' {{ domain }} <- {{ domain }} |>
 #'   dplyr::mutate(
 #'     {{ variable }} = 2 * {{ x }}
 #'   )
@@ -63,13 +63,13 @@
 #' the rendered code used in mighty becomes:
 #'
 #' ```r
-#' .self <- .self |>
+#' {{ domain }} <- {{ domain }} |>
 #'   dplyr::mutate(
 #'     A = 2 * B
 #'   )
 #' ```
 #'
-#' @seealso [get_standard()], [mighty_component_rendered]
+#' @seealso [get_standard()], [get_component()], [mighty_component_rendered]
 #' @export
 mighty_component <- R6::R6Class(
   classname = "mighty_component",
@@ -104,7 +104,7 @@ mighty_component <- R6::R6Class(
     }
   ),
   active = list(
-    #' @field id Component ID
+    #' @field id Component ID.
     id = \() private$.id,
     #' @field title Title for the component.
     title = \() private$.title,

R/mighty_component_rendered.R

@@ -1,33 +1,24 @@
-#' Rendered mighty standard component
+#' Rendered mighty component
 #' @description
-#' Class for a rendered mighty standard component.
+#' Class for a rendered mighty component.
 #'
 #' Once rendered a component can be used to:
 #'
 #' * Stream into an R script
 #' * Evaluate the generated code in an environment
-#' * Test code against expected output
-#' * Calculate test coverage
 #'
-#' @seealso [get_rendered_standard()]
+#' @seealso [get_rendered_standard()], [get_rendered_component()]
 #' @export
 mighty_component_rendered <- R6::R6Class(
   classname = "mighty_component_rendered",
   inherit = mighty_component,
   public = list(
     #' @description
-    #' Create standard component from rendered template.
+    #' Create component from rendered template.
     #' @param template `character` Rendered template such as output from `mighty_component$render()`.
     #' @param id `character` ID of the component. Either name of standard or path to local.
     initialize = function(template, id) {
-      super$initialize(template, id)
-
-      validate_component_code(self$code)
-
-      private$.params <- data.frame(
-        name = character(),
-        description = character()
-      )
+      msr_initialize(template, id, self, private, super)
     },
     #' @description
     #' Print rendered component
@@ -46,29 +37,23 @@ mighty_component_rendered <- R6::R6Class(
     #' @param envir Environment to evaluate in. Parsed to `eval()`.
     #' Defaults to using the current environment with `parent.frame()`.
     eval = function(envir = parent.frame()) {
-      eval(
-        expr = parse(text = self$code),
-        envir = envir
-      )
-    },
-    #' @description
-    #' Test component against expected output.
-    #' @param expected The expected output in `value` after evaluation
-    #' @param value Name of the object used to compare against after evaluating
-    #' the component. Defaults to `"domain"`.
-    #' @param envir Parent environment to use for evaluation of test code.
-    #' Defaults to using the current environment with `parent.frame()`.
-    test = function(expected, value = "domain", envir = parent.frame()) {
-      msr_test(expected, value, envir, self, private)
-    },
-    #' @description
-    #' Calculate test coverage for already run tests
-    test_coverage = function() {
-      msr_test_coverage(self)
+      msr_eval(envir, self)
     }
   )
 )
 
+#' @noRd
+msr_initialize <- function(template, id, self, private, super) {
+  super$initialize(template, id)
+
+  validate_component_code(self$code)
+
+  private$.params <- data.frame(
+    name = character(),
+    description = character()
+  )
+}
+
 #' @noRd
 msr_print <- function(self, super) {
   cli::cli({
@@ -89,18 +74,18 @@ msr_stream <- function(path, self) {
 }
 
 #' @noRd
-msr_test <- function(expected, value, envir, self, private) {
-  env <- new.env(parent = envir)
-  self$eval(envir = env)
-  testthat::expect_equal(
-    object = env[[value]],
-    expected = expected,
-    ignore_attr = TRUE
+msr_eval <- function(envir, self) {
+  zephyr::msg_verbose(
+    message = c(
+      ">" = "Evaluating component {.field {self$title}}",
+      "i" = "{.emph Code:}",
+      "{.code {self$code}}"
+    ),
+    msg_fun = cli::cli_bullets
   )
-  return(invisible(self))
-}
 
-#' @noRd
-msr_test_coverage <- function(self) {
-  return(numeric(1))
+  eval(
+    expr = parse(text = self$code),
+    envir = envir
+  )
 }