diff --git a/DESCRIPTION b/DESCRIPTION index 3c1f936a..b81eaf79 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -38,6 +38,7 @@ Suggests: pins, promises, readr, + roxygen2, shiny, shinychat, testthat (>= 3.0.0), @@ -46,4 +47,4 @@ Suggests: Config/testthat/edition: 3 Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.3 +Config/roxygen2/version: 8.0.0 diff --git a/R/measures.R b/R/measures.R index 6906fa32..f6bbf86b 100644 --- a/R/measures.R +++ b/R/measures.R @@ -3,10 +3,13 @@ #' A semantic layer is a collection of governed measures available to a #' [commons()] agent. #' -#' @param ... [measure()] objects. You can also supply a single list of measures. +#' @param ... [measure()] objects, lists of measures, or paths to R scripts or +#' directories. File and inline measures can be freely mixed. #' #' @return A `commons_semantic_layer` object. #' +#' @seealso [measure()] to define a measure. +#' #' @examples #' semantic_layer( #' measure( @@ -19,11 +22,7 @@ #' #' @export semantic_layer <- function(...) { - measures <- rlang::list2(...) - - if (length(measures) == 1 && is_measure_list(measures[[1]])) { - measures <- measures[[1]] - } + measures <- expand_measures(rlang::list2(...)) check_measures(measures) names(measures) <- vapply(measures, tool_name, character(1)) @@ -38,6 +37,21 @@ semantic_layer <- function(...) { new_semantic_layer(measures) } +# Expand each `...` element into measures: character vectors are read from disk, +# lists of measures are spliced in, and a lone measure is kept as is. +expand_measures <- function(args) { + expanded <- lapply(args, function(arg) { + if (is.character(arg)) { + read_measures(arg) + } else if (is_measure_list(arg)) { + arg + } else { + list(arg) + } + }) + unlist(expanded, recursive = FALSE) %||% list() +} + #' Create a measure #' #' A measure is a governed calculation inside a [semantic_layer()]. Its function @@ -55,6 +69,8 @@ semantic_layer <- function(...) { #' #' @return A measure object. #' +#' @seealso [semantic_layer()] to collect measures into a layer. +#' #' @export measure <- function(name, description, fn, arguments = list(), title = NULL) { title <- title %||% humanize_name(name) diff --git a/R/read-measures.R b/R/read-measures.R new file mode 100644 index 00000000..ed9af24a --- /dev/null +++ b/R/read-measures.R @@ -0,0 +1,169 @@ +read_measures <- function(paths) { + rlang::check_installed("roxygen2") + + registerS3method( + "roxy_tag_parse", + "roxy_tag_measure", + function(x) roxygen2::tag_toggle(x), + envir = asNamespace("roxygen2") + ) + + if (!is.character(paths)) { + cli::cli_abort("{.arg paths} must be a character vector of file or directory paths.") + } + + files <- resolve_measure_files(paths) + + # Source every file into one shared env (in order) so a measure can call a + # helper defined in a sibling file. The parsed block only reads tags. + env <- new.env(parent = globalenv()) + for (file in files) { + sys.source(file, envir = env) + } + + measures <- unlist( + lapply(files, function(file) read_measures_file(file, env)), + recursive = FALSE + ) + measures %||% list() +} + +resolve_measure_files <- function(paths, call = rlang::caller_env()) { + missing <- paths[!file.exists(paths)] + if (length(missing)) { + cli::cli_abort( + "{cli::qty(missing)}Path{?s} {?does/do} not exist: {.path {missing}}.", + call = call + ) + } + + files <- unlist(lapply(paths, function(path) { + if (dir.exists(path)) { + list.files(path, pattern = "[.][Rr]$", full.names = TRUE) + } else { + path + } + })) + unique(files) +} + +read_measures_file <- function(file, env) { + blocks <- roxygen2::parse_file(file) + measures <- lapply(blocks, function(block) block_to_measure(block, env)) + Filter(Negate(is.null), measures) +} + +block_to_measure <- function(block, env) { + if (is.null(roxygen2::block_get_tag(block, "measure"))) { + return(NULL) + } + + name <- block$object$topic + fn <- get(name, envir = env) + if (!is.function(fn)) { + return(NULL) + } + + description <- block_description(block) + arguments <- block_arguments(block, fn) + + measure(name, description, fn, arguments = arguments) +} + +block_description <- function(block) { + parts <- c( + roxygen2::block_get_tag_value(block, "title"), + roxygen2::block_get_tag_value(block, "description"), + { + ret <- roxygen2::block_get_tag_value(block, "return") + if (!is.null(ret)) paste0("Returns: ", ret) + } + ) + paste(parts, collapse = "\n\n") +} + +block_arguments <- function(block, fn) { + formals <- formals(fn) + param_text <- block_param_text(block) + + args <- list() + for (nm in names(formals)) { + required <- identical(formals[[nm]], quote(expr = )) + args[[nm]] <- param_type( + param_text[[nm]] %||% "", + default = formals[[nm]], + required = required + ) + } + args +} + +# The raw tag text is read instead of `val$description` so the type code span +# survives verbatim: the markdown roclet would otherwise turn the `[...]` inside +# it into a `\link{...}` once roxygen2's markdown state is active. +block_param_text <- function(block) { + tags <- roxygen2::block_get_tags(block, "param") + names <- vapply(tags, function(t) t$val$name, character(1)) + text <- lapply(tags, function(t) trimws(sub("^\\s*\\S+\\s*", "", t$raw))) + names(text) <- names + text +} + +# Parse a `@param` description into an ellmer type, using a leading type code +# span (e.g. `enum[a, b]`) when present and otherwise inferring from the +# formal's default. +param_type <- function(text, default, required) { + re <- "^\\s*`([a-zA-Z]+)(\\[[^]]*\\])?`\\s*(.*)$" + m <- regmatches(text, regexec(re, text, perl = TRUE))[[1]] + + if (length(m) == 0) { + return(infer_type(default, description = trimws(text), required = required)) + } + + kind <- tolower(m[2]) + bracket <- m[3] + description <- trimws(m[4]) + + if (nzchar(bracket)) { + inner <- trimws(substr(bracket, 2, nchar(bracket) - 1)) + if (kind == "enum") { + values <- trimws(strsplit(inner, ",")[[1]]) + return(ellmer::type_enum( + values = values, + description = description, + required = required + )) + } + return(ellmer::type_array( + items = scalar_type(kind, ""), + description = description, + required = required + )) + } + + scalar_type(kind, description, required = required) +} + +scalar_type <- function(kind, description, required = TRUE) { + switch( + kind, + integer = ellmer::type_integer(description, required = required), + number = ellmer::type_number(description, required = required), + boolean = ellmer::type_boolean(description, required = required), + ellmer::type_string(description, required = required) + ) +} + +infer_type <- function(default, description, required) { + value <- tryCatch(eval(default), error = function(e) NULL) + kind <- if (is.logical(value)) { + "boolean" + } else if (is.integer(value)) { + "integer" + } else if (is.numeric(value)) { + "number" + } else { + "string" + } + scalar_type(kind, description, required = required) +} diff --git a/man/commons-package.Rd b/man/commons-package.Rd index d7fd87c5..ff9147a4 100644 --- a/man/commons-package.Rd +++ b/man/commons-package.Rd @@ -19,6 +19,11 @@ Useful links: \author{ \strong{Maintainer}: Simon Couch \email{simon.couch@posit.co} (\href{https://orcid.org/0000-0001-5676-5107}{ORCID}) +Authors: +\itemize{ + \item Simon Couch \email{simon.couch@posit.co} (\href{https://orcid.org/0000-0001-5676-5107}{ORCID}) +} + Other contributors: \itemize{ \item Posit Software, PBC (\href{https://ror.org/03wc8by49}{ROR}) [copyright holder, funder] diff --git a/man/commons.Rd b/man/commons.Rd index 19a67778..4940fd69 100644 --- a/man/commons.Rd +++ b/man/commons.Rd @@ -108,145 +108,142 @@ sem <- semantic_layer( \code{\link[ellmer:Chat]{ellmer::Chat}} -> \code{Commons} } \section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{last_tag}}{How the most recent answer was produced: \code{"A"} for a + \if{html}{\out{
}} + \describe{ + \item{\code{last_tag}}{How the most recent answer was produced: \code{"A"} for a registered measure, \code{"B"} for SQL, or \code{NA}.} -} -\if{html}{\out{
}} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-Commons-new}{\code{Commons$new()}} -\item \href{#method-Commons-chat}{\code{Commons$chat()}} -\item \href{#method-Commons-stream_async}{\code{Commons$stream_async()}} -\item \href{#method-Commons-clone}{\code{Commons$clone()}} -} -} -\if{html}{\out{ -
Inherited methods + \itemize{ + \item \href{#method-Commons-initialize}{\code{Commons$new()}} + \item \href{#method-Commons-chat}{\code{Commons$chat()}} + \item \href{#method-Commons-stream_async}{\code{Commons$stream_async()}} + \item \href{#method-Commons-clone}{\code{Commons$clone()}} + } +} +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Commons-new}{}}} -\subsection{Method \code{new()}}{ -Create a Commons agent. Most users should call \code{\link[=commons]{commons()}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Commons-initialize}{}}} +\subsection{\code{Commons$new()}}{ + Create a Commons agent. Most users should call \code{\link[=commons]{commons()}} rather than this method directly. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Commons$new( + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Commons$new( client, data_source, context_layer = NULL, semantic_layer = NULL, log = FALSE -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{client}}{An \link[ellmer:Chat]{ellmer::Chat} supplying the provider.} + \item{\code{data_source}}{A \code{\link[=data_source]{data_source()}}.} + \item{\code{context_layer}}{An optional \code{\link[=context_layer]{context_layer()}}.} + \item{\code{semantic_layer}}{An optional \code{\link[=semantic_layer]{semantic_layer()}}.} + \item{\code{log}}{Whether to log conversation trajectories.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{client}}{An \link[ellmer:Chat]{ellmer::Chat} supplying the provider.} - -\item{\code{data_source}}{A \code{\link[=data_source]{data_source()}}.} - -\item{\code{context_layer}}{An optional \code{\link[=context_layer]{context_layer()}}.} - -\item{\code{semantic_layer}}{An optional \code{\link[=semantic_layer]{semantic_layer()}}.} - -\item{\code{log}}{Whether to log conversation trajectories.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Commons-chat}{}}} -\subsection{Method \code{chat()}}{ -Submit input and return the response. Also updates +\subsection{\code{Commons$chat()}}{ + Submit input and return the response. Also updates \verb{$last_tag} and writes a turn log. See \link[ellmer:Chat]{ellmer::Chat} for arguments. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Commons$chat(..., echo = NULL)}\if{html}{\out{
}} + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Commons$chat(..., echo = NULL)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{...}}{Input to send to the model.} + \item{\code{echo}}{Whether to echo output; see \link[ellmer:Chat]{ellmer::Chat}.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{...}}{Input to send to the model.} - -\item{\code{echo}}{Whether to echo output; see \link[ellmer:Chat]{ellmer::Chat}.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Commons-stream_async}{}}} -\subsection{Method \code{stream_async()}}{ -Stream input and return the response stream. Also updates +\subsection{\code{Commons$stream_async()}}{ + Stream input and return the response stream. Also updates \verb{$last_tag} as tools are requested. See \link[ellmer:Chat]{ellmer::Chat} for arguments. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Commons$stream_async( + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Commons$stream_async( ..., tool_mode = c("concurrent", "sequential"), stream = c("text", "content"), controller = NULL -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{...}}{Input to send to the model.} + \item{\code{tool_mode}}{Whether tool calls may run concurrently or sequentially.} + \item{\code{stream}}{Whether to stream plain text or \link[ellmer:Content]{ellmer::Content} objects.} + \item{\code{controller}}{Optional \code{\link[ellmer:stream_controller]{ellmer::stream_controller()}}.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{...}}{Input to send to the model.} - -\item{\code{tool_mode}}{Whether tool calls may run concurrently or sequentially.} - -\item{\code{stream}}{Whether to stream plain text or \link[ellmer:Content]{ellmer::Content} objects.} - -\item{\code{controller}}{Optional \code{\link[ellmer:stream_controller]{ellmer::stream_controller()}}.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Commons-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Commons$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{Commons$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Commons$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/commons_mod_ui.Rd b/man/commons_mod_ui.Rd index a2b6aa97..1a80f77b 100644 --- a/man/commons_mod_ui.Rd +++ b/man/commons_mod_ui.Rd @@ -17,11 +17,11 @@ commons_mod_server( \arguments{ \item{id}{Module ID.} -\item{...}{Arguments passed to \code{\link[shinychat:chat_app]{shinychat::chat_mod_ui()}} or -\code{\link[shinychat:chat_app]{shinychat::chat_mod_server()}}.} +\item{...}{Arguments passed to \code{\link[shinychat:chat_mod_ui]{shinychat::chat_mod_ui()}} or +\code{\link[shinychat:chat_mod_server]{shinychat::chat_mod_server()}}.} \item{messages}{Initial messages shown in the chat. Passed to -\code{\link[shinychat:chat_app]{shinychat::chat_mod_ui()}}.} +\code{\link[shinychat:chat_mod_ui]{shinychat::chat_mod_ui()}}.} \item{height}{Chat container height. Defaults to \code{"100\%"} so the chat input stays docked at the bottom of fill layouts.} @@ -36,8 +36,8 @@ bookmarking hooks for user inputs and assistant responses.} shinychat module server result. } \description{ -These functions wrap \code{\link[shinychat:chat_app]{shinychat::chat_mod_ui()}} and -\code{\link[shinychat:chat_app]{shinychat::chat_mod_server()}} with commons-specific answer provenance UI. +These functions wrap \code{\link[shinychat:chat_mod_ui]{shinychat::chat_mod_ui()}} and +\code{\link[shinychat:chat_mod_server]{shinychat::chat_mod_server()}} with commons-specific answer provenance UI. Answers produced from registered measures get a compact verified-answer pill. Answers produced from fallback SQL get a caution pill with a review request. } diff --git a/man/measure.Rd b/man/measure.Rd index d5e304e6..a447f898 100644 --- a/man/measure.Rd +++ b/man/measure.Rd @@ -14,7 +14,7 @@ measure(name, description, fn, arguments = list(), title = NULL) \item{fn}{Function that computes the measure. Its formals are the measure's arguments.} -\item{arguments}{A named list of \code{\link[ellmer:type_boolean]{ellmer::type_string()}} and friends, one per +\item{arguments}{A named list of \code{\link[ellmer:type_string]{ellmer::type_string()}} and friends, one per formal of \code{fn}.} \item{title}{Human-readable measure title to show in user interfaces. If @@ -28,3 +28,6 @@ A measure is a governed calculation inside a \code{\link[=semantic_layer]{semant body is ordinary R; its \code{arguments} schema tells the model what inputs it can supply. } +\seealso{ +\code{\link[=semantic_layer]{semantic_layer()}} to collect measures into a layer. +} diff --git a/man/semantic_layer.Rd b/man/semantic_layer.Rd index d6c9d86e..94f1f708 100644 --- a/man/semantic_layer.Rd +++ b/man/semantic_layer.Rd @@ -7,7 +7,8 @@ semantic_layer(...) } \arguments{ -\item{...}{\code{\link[=measure]{measure()}} objects. You can also supply a single list of measures.} +\item{...}{\code{\link[=measure]{measure()}} objects, lists of measures, or paths to R scripts or +directories. File and inline measures can be freely mixed.} } \value{ A \code{commons_semantic_layer} object. @@ -27,3 +28,6 @@ semantic_layer( ) } +\seealso{ +\code{\link[=measure]{measure()}} to define a measure. +} diff --git a/tests/testthat/_snaps/measures.md b/tests/testthat/_snaps/measures.md index 2fa8ea8e..ce878638 100644 --- a/tests/testthat/_snaps/measures.md +++ b/tests/testthat/_snaps/measures.md @@ -1,7 +1,7 @@ # semantic_layer validates its measures Code - semantic_layer("not a measure") + semantic_layer(2026) Condition Error in `semantic_layer()`: ! Every item in `semantic_layer` must be created by `measure()`. @@ -14,6 +14,14 @@ Error in `semantic_layer()`: ! Measure names must be unique; duplicated name: "order_count". +# semantic_layer surfaces read_measures errors for bad paths + + Code + semantic_layer("not a measure") + Condition + Error in `read_measures()`: + ! Path does not exist: 'not a measure'. + # validate_measure_args rejects out-of-vocabulary enum values Code diff --git a/tests/testthat/_snaps/read-measures.md b/tests/testthat/_snaps/read-measures.md new file mode 100644 index 00000000..e8536cb8 --- /dev/null +++ b/tests/testthat/_snaps/read-measures.md @@ -0,0 +1,16 @@ +# read_measures validates its inputs + + Code + read_measures(123) + Condition + Error in `read_measures()`: + ! `paths` must be a character vector of file or directory paths. + +--- + + Code + read_measures("does-not-exist.R") + Condition + Error in `read_measures()`: + ! Path does not exist: 'does-not-exist.R'. + diff --git a/tests/testthat/test-measures.R b/tests/testthat/test-measures.R index cd2ccf02..dba6a660 100644 --- a/tests/testthat/test-measures.R +++ b/tests/testthat/test-measures.R @@ -12,13 +12,31 @@ test_that("semantic_layer accepts a list of measures", { }) test_that("semantic_layer validates its measures", { - expect_snapshot(semantic_layer("not a measure"), error = TRUE) + expect_snapshot(semantic_layer(2026), error = TRUE) expect_snapshot( semantic_layer(count_measure_tool(), count_measure_tool()), error = TRUE ) }) +test_that("semantic_layer reads measures from path inputs", { + skip_if_not_installed("roxygen2") + + path <- withr::local_tempfile(fileext = ".R") + writeLines( + c("#' Counter", "#' @description Counts.", "#' @measure", "counter <- function() 1L"), + path + ) + + layer <- semantic_layer(path, count_measure_tool()) + + expect_named(layer$measures, c("counter", "order_count")) +}) + +test_that("semantic_layer surfaces read_measures errors for bad paths", { + expect_snapshot(semantic_layer("not a measure"), error = TRUE) +}) + test_that("validate_measure_args coerces valid arguments", { td <- count_measure_tool() args <- validate_measure_args( diff --git a/tests/testthat/test-read-measures.R b/tests/testthat/test-read-measures.R new file mode 100644 index 00000000..bfcb0f21 --- /dev/null +++ b/tests/testthat/test-read-measures.R @@ -0,0 +1,253 @@ +measures_script <- function(lines) { + path <- withr::local_tempfile(fileext = ".R", .local_envir = parent.frame()) + writeLines(lines, path) + path +} + +test_that("read_measures derives a measure from a documented function", { + skip_if_not_installed("roxygen2") + + path <- measures_script(c( + "#' Count orders", + "#'", + "#' @description Total orders, optionally by region.", + "#'", + "#' @param region `string` The sales region.", + "#'", + "#' @return An integer count.", + "#' @measure", + "order_count <- function(region = NULL) {", + " 2026L", + "}" + )) + + measures <- read_measures(path) + + expect_length(measures, 1) + td <- measures[[1]] + expect_equal(tool_name(td), "order_count") + expect_match(tool_description(td), "Count orders") + expect_match(tool_description(td), "Total orders") + expect_match(tool_description(td), "Returns: An integer count") + expect_equal(do.call(td, list()), 2026L) +}) + +test_that("read_measures maps param type code spans to ellmer types", { + skip_if_not_installed("roxygen2") + + path <- measures_script(c( + "#' Measure", + "#' @description A measure.", + "#' @param a `string` A string.", + "#' @param b `integer` An integer.", + "#' @param c `number` A number.", + "#' @param d `boolean` A boolean.", + "#' @param e `enum[x, y, z]` An enum.", + "#' @param f `string[]` An array.", + "#' @measure", + "m <- function(a, b, c, d, e, f) NULL" + )) + + props <- tool_properties(read_measures(path)[[1]]) + + expect_equal(type_kind(props$a), "string") + expect_equal(type_kind(props$b), "integer") + expect_equal(type_kind(props$c), "number") + expect_equal(type_kind(props$d), "boolean") + expect_equal(type_kind(props$e), "enum") + expect_equal(type_values(props$e), c("x", "y", "z")) + expect_equal(type_kind(props$f), "array") + expect_equal(type_kind(S7::prop(props$f, "items")), "string") +}) + +test_that("read_measures derives required from the signature, not the type", { + skip_if_not_installed("roxygen2") + + path <- measures_script(c( + "#' Measure", + "#' @description A measure.", + "#' @param required_arg `string` Required.", + "#' @param optional_arg `string` Optional.", + "#' @measure", + "m <- function(required_arg, optional_arg = NULL) NULL" + )) + + props <- tool_properties(read_measures(path)[[1]]) + + expect_true(S7::prop(props$required_arg, "required")) + expect_false(S7::prop(props$optional_arg, "required")) +}) + +test_that("read_measures uses the param text as the type description", { + skip_if_not_installed("roxygen2") + + path <- measures_script(c( + "#' Measure", + "#' @description A measure.", + "#' @param region `string` The sales region.", + "#' @measure", + "m <- function(region) NULL" + )) + + props <- tool_properties(read_measures(path)[[1]]) + expect_equal(S7::prop(props$region, "description"), "The sales region.") +}) + +test_that("read_measures infers untyped args from their defaults", { + skip_if_not_installed("roxygen2") + + path <- measures_script(c( + "#' Measure", + "#' @description A measure.", + "#' @param i An integer default.", + "#' @param n A number default.", + "#' @param b A boolean default.", + "#' @param s No default.", + "#' @measure", + "m <- function(i = 10L, n = 1.5, b = TRUE, s) NULL" + )) + + props <- tool_properties(read_measures(path)[[1]]) + + expect_equal(type_kind(props$i), "integer") + expect_equal(type_kind(props$n), "number") + expect_equal(type_kind(props$b), "boolean") + expect_equal(type_kind(props$s), "string") +}) + +test_that("read_measures ignores undocumented and untagged functions", { + skip_if_not_installed("roxygen2") + + path <- measures_script(c( + "#' Measure", + "#' @description A measure.", + "#' @param a `string` An arg.", + "#' @measure", + "m <- function(a) NULL", + "", + "#' Documented helper", + "#' @description Documented but not a measure.", + "documented_helper <- function(x) x", + "", + "helper <- function(x) x" + )) + + measures <- read_measures(path) + + expect_length(measures, 1) + expect_equal(tool_name(measures[[1]]), "m") +}) + +test_that("read_measures returns only @measure functions", { + skip_if_not_installed("roxygen2") + + path <- measures_script(c( + "#' Tagged", + "#' @description Tagged measure.", + "#' @measure", + "tagged <- function() 1L", + "", + "#' Untagged", + "#' @description Documented but not tagged.", + "untagged <- function() 2L" + )) + + measures <- read_measures(path) + + expect_length(measures, 1) + expect_equal(tool_name(measures[[1]]), "tagged") +}) + +test_that("read_measures shares an env across files in one call", { + skip_if_not_installed("roxygen2") + + dir <- withr::local_tempdir() + a <- file.path(dir, "a.R") + b <- file.path(dir, "b.R") + writeLines( + c("helper <- function(x) x * 2L"), + a + ) + writeLines( + c( + "#' Uses helper", + "#' @description Calls a helper from a sibling file.", + "#' @measure", + "uses_helper <- function() helper(1013L)" + ), + b + ) + + measures <- read_measures(c(a, b)) + + expect_length(measures, 1) + td <- measures[[1]] + expect_equal(tool_name(td), "uses_helper") + expect_equal(do.call(td, list()), 2026L) +}) + +test_that("semantic_layer isolates measures read from separate path args", { + skip_if_not_installed("roxygen2") + + dir <- withr::local_tempdir() + a <- file.path(dir, "a.R") + b <- file.path(dir, "b.R") + writeLines( + c("helper <- function(x) x * 2L"), + a + ) + writeLines( + c( + "#' Uses helper", + "#' @description Calls a helper from another file.", + "#' @measure", + "uses_helper <- function() helper(1013L)" + ), + b + ) + + layer <- semantic_layer(a, b) + + expect_named(layer$measures, "uses_helper") + expect_error(do.call(layer$measures$uses_helper, list())) +}) + +test_that("read_measures reads multiple files and directories", { + skip_if_not_installed("roxygen2") + + dir <- withr::local_tempdir() + writeLines( + c("#' One", "#' @description First.", "#' @measure", "one <- function() 1L"), + file.path(dir, "one.R") + ) + writeLines( + c("#' Two", "#' @description Second.", "#' @measure", "two <- function() 2L"), + file.path(dir, "two.R") + ) + + measures <- read_measures(dir) + + expect_setequal(vapply(measures, tool_name, character(1)), c("one", "two")) +}) + +test_that("read_measures produces measures usable in a semantic_layer", { + skip_if_not_installed("roxygen2") + + path <- measures_script(c( + "#' Count orders", + "#' @description Counts orders.", + "#' @param region `enum[EMEA, APAC]` The region.", + "#' @measure", + "order_count <- function(region) 7L" + )) + + layer <- semantic_layer(read_measures(path)) + + expect_s3_class(layer, "commons_semantic_layer") + expect_named(layer$measures, "order_count") +}) + +test_that("read_measures validates its inputs", { + expect_snapshot(read_measures(123), error = TRUE) + expect_snapshot(read_measures("does-not-exist.R"), error = TRUE) +})