diff --git a/.Rbuildignore b/.Rbuildignore
index e8923d3..5599b17 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -14,3 +14,4 @@ CLAUDE.md
^pkgdown$
^\.github$
inst/hex/
+^commons-review\.jsonl$
diff --git a/.gitignore b/.gitignore
index 80e4911..900a359 100644
--- a/.gitignore
+++ b/.gitignore
@@ -14,3 +14,4 @@ CLAUDE.local.md
AGENTS.override.md
inst/hex/output
.shinychat/
+commons-review.jsonl
diff --git a/DESCRIPTION b/DESCRIPTION
index 8b67c35..8223b6f 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -38,16 +38,18 @@ Imports:
utils
Suggests:
bsicons,
+ bslib (>= 0.11.0),
dbplyr,
dplyr,
htmltools,
otel (>= 0.2.0),
otelsdk (>= 0.2.0),
pins,
+ plotly,
ragg,
readr,
rmarkdown,
- shiny,
+ shiny (>= 1.11.1),
shinychat (> 0.4.0),
testthat (>= 3.0.0),
vitals,
diff --git a/NAMESPACE b/NAMESPACE
index 518f8e9..4a9dda2 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -9,6 +9,7 @@ export(list_tables)
export(measure)
export(read_trajectories)
export(semantic_layer)
+export(trajectory_review)
importFrom(R6,R6Class)
importFrom(coro,async_generator)
importFrom(coro,await_each)
diff --git a/R/tagging.R b/R/tagging.R
index da3edf4..8aaf58f 100644
--- a/R/tagging.R
+++ b/R/tagging.R
@@ -28,25 +28,31 @@ commons_last_provenance <- function(client) {
# reinstate provenance pills when an existing conversation seeds a new
# session, since pills are otherwise only injected as live turns complete.
commons_exchange_provenance <- function(turns, corpus = list()) {
+ lapply(split_exchanges(turns), function(exchange) {
+ derive_provenance(
+ unlist(lapply(exchange, turn_tags)) %||% character(),
+ unlist(lapply(exchange, turn_text)) %||% character(),
+ corpus
+ )
+ })
+}
+
+# Tool-result UserTurns stay with the exchange that initiated them.
+split_exchanges <- function(turns) {
out <- list()
- tags <- character()
- text <- character()
- started <- FALSE
+ current <- NULL
for (turn in turns) {
if (identical(turn@role, "user") && !turn_has_tool_result(turn)) {
- if (started) {
- out[[length(out) + 1]] <- derive_provenance(tags, text, corpus)
+ if (!is.null(current)) {
+ out[[length(out) + 1]] <- current
}
- tags <- character()
- text <- character()
- started <- TRUE
- } else if (started) {
- tags <- c(tags, turn_tags(turn))
- text <- c(text, turn_text(turn))
+ current <- list(turn)
+ } else if (!is.null(current)) {
+ current[[length(current) + 1]] <- turn
}
}
- if (started) {
- out[[length(out) + 1]] <- derive_provenance(tags, text, corpus)
+ if (!is.null(current)) {
+ out[[length(out) + 1]] <- current
}
out
}
diff --git a/R/trajectories.R b/R/trajectories.R
index 8452671..b02f865 100644
--- a/R/trajectories.R
+++ b/R/trajectories.R
@@ -51,7 +51,11 @@
#' ```
#'
#' @return A list of conversations, named by conversation id and ordered
-#' oldest-first. Each conversation is a list of [ellmer::Turn]s.
+#' oldest-first. Each conversation is a list of [ellmer::Turn]s and carries
+#' a `last_active` attribute: a `POSIXct` giving the time of the
+#' conversation's most recent chat activity. The list carries a `source`
+#' attribute identifying the local trace directory or Connect content from
+#' which it was read.
#' @export
read_trajectories <- function(
source = NULL,
@@ -75,9 +79,24 @@ read_trajectories <- function(
if (!is.null(n)) {
trajectories <- utils::tail(trajectories, n)
}
+ attr(trajectories, "source") <- trajectory_source_record(resolved)
trajectories
}
+trajectory_source_record <- function(resolved) {
+ if (identical(resolved$kind, "connect")) {
+ return(list(
+ kind = "connect",
+ server = resolved$client$server,
+ content_guid = resolved$guid
+ ))
+ }
+ list(
+ kind = "local",
+ path = normalizePath(resolved$path, mustWork = FALSE)
+ )
+}
+
# Dates and date strings both resolve to local midnight; as.POSIXct() alone
# would silently read a Date as UTC midnight.
check_window_bound <- function(
@@ -528,7 +547,17 @@ posixct_nanos <- function(time) {
# span in a conversation carries the whole trajectory: group chat spans by
# conversation, keep the last one, and parse its GenAI-semconv messages.
build_trajectories <- function(spans) {
- lapply(latest_chat_spans(spans), trajectory_turns)
+ lapply(latest_chat_spans(spans), function(span) {
+ turns <- trajectory_turns(span)
+ # Keep conversations directly usable with ellmer's chat$set_turns().
+ attr(turns, "last_active") <- nano_posixct(span_time(span))
+ turns
+ })
+}
+
+# Second precision is sufficient; the origin supports R < 4.3.
+nano_posixct <- function(time) {
+ as.POSIXct(as.numeric(time) / 1e9, origin = "1970-01-01")
}
# The latest chat span per conversation, named by conversation id and
diff --git a/R/trajectory-review-log.R b/R/trajectory-review-log.R
new file mode 100644
index 0000000..141c2dd
--- /dev/null
+++ b/R/trajectory-review-log.R
@@ -0,0 +1,166 @@
+new_review_event <- function(
+ trajectories,
+ key,
+ action,
+ user,
+ source = trajectory_source(trajectories),
+ note = NULL
+) {
+ exchange <- key$exchange
+ record <- list(
+ schema_version = 1L,
+ event_id = new_review_event_id(),
+ time = review_timestamp(),
+ user = user,
+ source = source,
+ conversation = names(trajectories)[[key$conversation]],
+ exchange = exchange,
+ action = action,
+ note = note
+ )
+
+ if (!is.null(exchange)) {
+ turns <- split_exchanges(trajectories[[key$conversation]])[[exchange]]
+ provenance <- exchange_provenance(turns)
+ record$question <- turns[[1]]@text
+ record$tag <- if (is.na(provenance$tag)) "none" else provenance$tag
+ }
+
+ record
+}
+
+new_review_event_id <- function() {
+ suffix <- paste(sample(c(letters, 0:9), 12, replace = TRUE), collapse = "")
+ paste0(format(Sys.time(), "%Y%m%dt%H%M%OS6", tz = "UTC"), "-", suffix)
+}
+
+review_timestamp <- function() {
+ format(Sys.time(), "%Y-%m-%dT%H:%M:%SZ", tz = "UTC")
+}
+
+review_user <- function(session) {
+ user <- session$user
+ if (!rlang::is_string(user) || !nzchar(user)) {
+ return("unknown")
+ }
+ user
+}
+
+trajectory_source <- function(trajectories) {
+ attr(trajectories, "source") %||% list(kind = "unknown")
+}
+
+append_review_record <- function(file, record) {
+ line <- jsonlite::toJSON(drop_nulls(record), auto_unbox = TRUE)
+ cat(line, "\n", file = file, sep = "", append = TRUE)
+}
+
+read_review_records <- function(file) {
+ if (!file.exists(file)) {
+ return(list())
+ }
+
+ records <- list()
+ invalid <- integer()
+ lines <- readLines(file, warn = FALSE)
+ for (i in seq_along(lines)) {
+ record <- tryCatch(
+ jsonlite::fromJSON(lines[[i]], simplifyVector = FALSE),
+ error = function(err) NULL
+ )
+ if (!is_review_record(record)) {
+ invalid <- c(invalid, i)
+ next
+ }
+ records[[length(records) + 1]] <- record
+ }
+
+ if (length(invalid) > 0) {
+ cli::cli_warn(
+ "Ignoring {cli::qty(invalid)}invalid review record{?s} on line{?s}
+ {invalid} of {.file {file}}."
+ )
+ }
+ records
+}
+
+is_review_record <- function(record) {
+ if (
+ !is.list(record) ||
+ !rlang::is_string(record$conversation) ||
+ !rlang::is_string(record$action) ||
+ !record$action %in% c("flag", "unflag", "note")
+ ) {
+ return(FALSE)
+ }
+ exchange <- record$exchange
+ if (
+ !is.null(exchange) &&
+ (!is.numeric(exchange) ||
+ length(exchange) != 1 ||
+ !is.finite(exchange) ||
+ exchange < 1 ||
+ exchange != trunc(exchange))
+ ) {
+ return(FALSE)
+ }
+ !identical(record$action, "note") || rlang::is_string(record$note)
+}
+
+actionable_review_records <- function(records) {
+ note_indices <- integer()
+ latest_flag_indices <- integer()
+
+ for (i in seq_along(records)) {
+ record <- records[[i]]
+ if (identical(record$action, "note")) {
+ note_indices <- c(note_indices, i)
+ } else {
+ key <- review_key(record$conversation, record$exchange)
+ latest_flag_indices[[key]] <- i
+ }
+ }
+
+ active_flag_indices <- unname(latest_flag_indices)
+ active_flag_indices <- active_flag_indices[vapply(
+ records[active_flag_indices],
+ function(record) identical(record$action, "flag"),
+ logical(1)
+ )]
+ records[sort(c(note_indices, active_flag_indices))]
+}
+
+review_flags <- function(records) {
+ active <- Filter(
+ function(record) identical(record$action, "flag"),
+ actionable_review_records(records)
+ )
+ vapply(
+ active,
+ function(record) review_key(record$conversation, record$exchange),
+ character(1)
+ )
+}
+
+review_notes <- function(records) {
+ Filter(
+ function(record) identical(record$action, "note"),
+ records
+ )
+}
+
+review_key <- function(id, exchange = NULL) {
+ paste(c(id, exchange), collapse = "#")
+}
+
+parse_review_time <- function(x) {
+ time <- as.POSIXct(
+ x,
+ format = "%Y-%m-%dT%H:%M:%SZ",
+ tz = "UTC"
+ )
+ if (!is.na(time)) {
+ return(time)
+ }
+ as.POSIXct(x, format = "%Y-%m-%dT%H:%M:%S%z")
+}
diff --git a/R/trajectory-review.R b/R/trajectory-review.R
new file mode 100644
index 0000000..1467a7a
--- /dev/null
+++ b/R/trajectory-review.R
@@ -0,0 +1,981 @@
+#' Review commons trajectories
+#'
+#' @description
+#' `trajectory_review()` launches a Shiny app for browsing conversation
+#' trajectories read with [read_trajectories()]. The app charts each trust
+#' level's share of answers over time—binned by day, week, or month, using
+#' the finest unit the volume of answers supports—alongside a list of
+#' conversations or of individual questions, filterable by date and trust
+#' level, and a transcript of each with the provenance pills the commons
+#' chat UI would show.
+#'
+#' Transcripts are reviewable rather than live: conversations and questions
+#' can be flagged for review and annotated with notes. Notes apply to the
+#' whole conversation, or to a single question-and-answer exchange selected
+#' in the transcript. Flags and notes land in `review_file`, one JSON record
+#' per line, and are restored when the viewer reopens.
+#'
+#' New review records use schema version 1 and include a unique event id, UTC
+#' timestamp, reviewer username, trajectory source, conversation id, optional
+#' exchange number, action, and optional note. Exchange-level records also
+#' snapshot the question and trust tag.
+#'
+#' Trajectories carry no record of how each answer was tagged when it was
+#' produced, so the viewer derives trust levels from the tool calls in the
+#' trajectory: answers backed only by governed tools (`call_measure`,
+#' `call_metrics`) are verified, and answers that used fallback tools
+#' (`run_sql`, `run_r`) count as cited when they contain citation markup and
+#' untrusted when they don't. A cited answer's quotes render as footnotes so
+#' they can be reviewed, but they are not re-verified against the agent's
+#' context: footnotes name no source and are attributed "unverified".
+#'
+#' Logged calls that aren't part of the agent's question-and-answer record—
+#' shinychat's conversation-title generation, and completions with no user
+#' turn—are excluded from the viewer.
+#'
+#' @param trajectories A named list of conversations, as returned by
+#' [read_trajectories()].
+#' @param review_file Path of the JSONL file that review actions append to:
+#' flags, unflags, and feedback notes, each with a timestamp, the
+#' conversation id, and (for questions) the exchange number. Created on
+#' first use; flags and notes recorded here are restored when the viewer
+#' reopens. Defaults to `COMMONS_REVIEW_FILE` when set.
+#'
+#' @details
+#' A single reviewer app writes all of its review events to `review_file`. For a
+#' deployed app, point `COMMONS_REVIEW_FILE` at persistent storage: files in a
+#' Posit Connect app's working directory are replaced on redeployment.
+#' File-backed review apps should use one Connect process because separate
+#' processes do not coordinate file writes or in-memory review state.
+#'
+#' @return A [shiny::shinyApp()] object. Calling `trajectory_review()` at the
+#' console launches the reviewer; the result can also be served as the last
+#' expression of an `app.R`.
+#'
+#' @examples
+#' \dontrun{
+#' trajectory_review()
+#'
+#' trajectory_review(read_trajectories(from = "2026-07-01"))
+#' }
+#' @export
+trajectory_review <- function(
+ trajectories = read_trajectories(),
+ review_file = Sys.getenv(
+ "COMMONS_REVIEW_FILE",
+ unset = "commons-review.jsonl"
+ )
+) {
+ check_viewer_packages()
+ check_trajectories(trajectories)
+ rlang::check_string(review_file)
+ source <- trajectory_source(trajectories)
+ trajectories <- drop_side_conversations(trajectories)
+ summary <- summarize_trajectories(trajectories)
+ questions <- summarize_questions(trajectories)
+ shiny::shinyApp(
+ viewer_ui(summary),
+ viewer_server(trajectories, summary, questions, review_file, source)
+ )
+}
+
+check_viewer_packages <- function(call = rlang::caller_env()) {
+ pkgs <- c(
+ "bslib",
+ "htmltools",
+ "plotly",
+ "shiny",
+ "shinychat"
+ )
+ missing <- pkgs[!vapply(pkgs, requireNamespace, logical(1), quietly = TRUE)]
+
+ if (length(missing)) {
+ cli::cli_abort(
+ c(
+ "{.fn trajectory_review} requires missing package{?s}: {.pkg {missing}}.",
+ i = "Install {.pkg {missing}} to use the trajectory reviewer."
+ ),
+ call = call
+ )
+ }
+}
+
+check_trajectories <- function(trajectories, call = rlang::caller_env()) {
+ ok <- is.list(trajectories) &&
+ (length(trajectories) == 0 || !is.null(names(trajectories))) &&
+ all(vapply(trajectories, is.list, logical(1)))
+
+ if (!ok) {
+ cli::cli_abort(
+ "{.arg trajectories} must be a named list of conversations as returned
+ by {.fn read_trajectories}: each a list of {.cls ellmer::Turn}s.",
+ call = call
+ )
+ }
+}
+
+drop_side_conversations <- function(trajectories) {
+ side <- vapply(trajectories, is_side_conversation, logical(1))
+ if (any(side)) {
+ cli::cli_inform(
+ "Excluding {sum(side)} logged call{?s} that {?isn't/aren't} part of the
+ agent's Q&A record (e.g. conversation-title generation)."
+ )
+ }
+ trajectories[!side]
+}
+
+# Title generation shares the agent's client, so its calls enter the trace
+# store.
+shinychat_title_prompt <- "You title chat conversations."
+
+is_side_conversation <- function(turns) {
+ if (length(split_exchanges(turns)) == 0) {
+ return(TRUE)
+ }
+ system <- turns[[1]]
+ identical(system@role, "system") &&
+ startsWith(system@text, shinychat_title_prompt)
+}
+
+summarize_trajectories <- function(trajectories) {
+ unname(Map(conversation_record, names(trajectories), trajectories))
+}
+
+conversation_record <- function(id, turns) {
+ exchanges <- split_exchanges(turns)
+ provenance <- lapply(exchanges, exchange_provenance)
+ list(
+ id = id,
+ snippet = first_user_snippet(exchanges),
+ n_user_turns = length(exchanges),
+ tags = vapply(provenance, function(p) p$tag, character(1)),
+ last_active = attr(turns, "last_active") %||% as.POSIXct(NA)
+ )
+}
+
+summarize_questions <- function(trajectories) {
+ records <- list()
+ for (i in rlang::seq2(1, length(trajectories))) {
+ turns <- trajectories[[i]]
+ exchanges <- split_exchanges(turns)
+ provenance <- lapply(exchanges, exchange_provenance)
+ for (j in rlang::seq2(1, length(exchanges))) {
+ records[[length(records) + 1]] <- list(
+ conversation = i,
+ conversation_id = names(trajectories)[[i]],
+ exchange = j,
+ snippet = question_snippet(exchanges[[j]]),
+ tag = provenance[[j]]$tag,
+ last_active = attr(turns, "last_active") %||% as.POSIXct(NA)
+ )
+ }
+ }
+ records
+}
+
+# The OTLP round trip drops commons_tag but preserves tool names and
+# citations.
+exchange_provenance <- function(exchange) {
+ tags <- exchange_tool_tags(exchange)
+ text <- unlist(lapply(exchange, turn_text)) %||% character()
+ citations <- extract_citations(text)
+ tag <- if ("B" %in% tags) {
+ if (length(citations) > 0) "B" else "C"
+ } else if ("A" %in% tags) {
+ "A"
+ } else {
+ NA_character_
+ }
+ list(tag = tag, citations = citations)
+}
+
+viewer_tool_tags <- c(
+ call_measure = "A",
+ call_metrics = "A",
+ run_sql = "B",
+ run_r = "B"
+)
+
+exchange_tool_tags <- function(turns) {
+ calls <- unlist(lapply(turns, function(turn) {
+ lapply(turn@contents, function(content) {
+ if (S7::S7_inherits(content, ellmer::ContentToolRequest)) {
+ content@name
+ }
+ })
+ }))
+ tags <- viewer_tool_tags[calls]
+ unname(tags[!is.na(tags)])
+}
+
+first_user_snippet <- function(exchanges, max_chars = 80) {
+ if (length(exchanges) == 0) {
+ return("")
+ }
+ question_snippet(exchanges[[1]], max_chars)
+}
+
+question_snippet <- function(exchange, max_chars = 80) {
+ text <- trimws(gsub("\\s+", " ", exchange[[1]]@text))
+ if (nchar(text) <= max_chars) {
+ return(text)
+ }
+ paste0(substr(text, 1, max_chars - 1), "\u2026")
+}
+
+trajectory_transcript <- function(turns) {
+ exchanges <- split_exchanges(turns)
+ messages <- list()
+ pills <- list()
+ n_assistant <- 0L
+
+ for (i in seq_along(exchanges)) {
+ exchange <- exchanges[[i]]
+ messages[[length(messages) + 1]] <- list(
+ role = "user",
+ content = exchange[[1]]@text,
+ exchange = i
+ )
+ chunks <- exchange_answer_chunks(exchange[-1])
+ if (length(chunks) == 0) {
+ next
+ }
+ n_assistant <- n_assistant + 1L
+ messages[[length(messages) + 1]] <- list(
+ role = "assistant",
+ content = chunks,
+ exchange = i
+ )
+ pill <- viewer_pill(exchange_provenance(exchange), n_assistant)
+ if (!is.null(pill)) {
+ pills[[length(pills) + 1]] <- pill
+ }
+ }
+
+ for (i in seq_along(pills)) {
+ pills[[i]]$indexFromEnd <- n_assistant - pills[[i]]$indexFromEnd
+ }
+ list(messages = messages, count = n_assistant, pills = pills)
+}
+
+# Cited answers keep their quotes visible, but the viewer cannot re-verify
+# them.
+viewer_pill <- function(provenance, assistant_index) {
+ if (is.na(provenance$tag) && length(provenance$citations) == 0) {
+ return(NULL)
+ }
+ citations <- if (identical(provenance$tag, "B")) {
+ lapply(provenance$citations, viewer_citation)
+ } else {
+ lapply(provenance$citations, function(x) list(verified = FALSE))
+ }
+ list(
+ html = htmltools::renderTags(commons_answer_pill(provenance$tag))$html,
+ citations = citations,
+ indexFromEnd = assistant_index
+ )
+}
+
+viewer_citation <- function(citation) {
+ list(
+ verified = TRUE,
+ reason = if (!is.na(citation$reason)) citation$reason,
+ quote = normalize_citation(citation$quote),
+ label = "unverified"
+ )
+}
+
+exchange_answer_chunks <- function(turns) {
+ chunks <- list()
+ for (turn in turns) {
+ for (content in turn@contents) {
+ if (S7::S7_inherits(content, ellmer::ContentToolRequest)) {
+ next
+ }
+ if (S7::S7_inherits(content, ellmer::ContentToolResult)) {
+ content@extra$display <- content@extra$display %||%
+ viewer_tool_display(content@request, content@value)
+ }
+ chunks[[length(chunks) + 1]] <- shinychat::contents_shinychat(content)
+ }
+ }
+ drop_nulls(chunks)
+}
+
+# Rebuild display metadata that is not retained by the OTLP round trip.
+viewer_tool_display <- function(request, value = NULL) {
+ if (is.null(request)) {
+ return(NULL)
+ }
+ arguments <- request@arguments
+ info <- switch(
+ request@name,
+ search_pool = list(title = "Searched the semantic layer", icon = "search"),
+ call_metrics = list(
+ title = sprintf(
+ "Metrics: %s",
+ html_escape(paste(unlist(arguments$metrics), collapse = ", "))
+ ),
+ icon = "shield-check"
+ ),
+ call_measure = list(
+ title = sprintf(
+ "Measure: %s",
+ html_escape(humanize_name(arguments$name %||% ""))
+ ),
+ icon = "shield-check"
+ ),
+ search_context = list(title = "Searched context", icon = "book"),
+ describe_table = list(
+ title = sprintf("Described %s", html_escape(arguments$table %||% "")),
+ icon = "table"
+ ),
+ run_sql = list(title = "Ran SQL", icon = "code-square"),
+ run_r = list(title = "Ran R code", icon = "terminal"),
+ return(NULL)
+ )
+ display <- list(title = info$title, open = FALSE, show_request = FALSE)
+ display$icon <- maybe_icon(info$icon)
+ if (identical(request@name, "run_sql") && is.character(arguments$sql)) {
+ display$markdown <- paste(
+ c(sprintf("```sql\n%s\n```", arguments$sql), value),
+ collapse = "\n\n"
+ )
+ }
+ display
+}
+
+seed_transcript_decorations <- function(
+ session,
+ id,
+ transcript,
+ selected_exchange = NULL
+) {
+ if (length(transcript$pills) > 0) {
+ session$sendCustomMessage(
+ "commonsProvenancePillSeed",
+ list(id = id, count = transcript$count, pills = transcript$pills)
+ )
+ }
+ if (length(transcript$messages) > 0) {
+ session$sendCustomMessage(
+ "commonsViewerExchangeSeed",
+ list(
+ id = id,
+ count = length(transcript$messages),
+ exchanges = vapply(
+ transcript$messages,
+ function(message) message$exchange,
+ integer(1)
+ ),
+ selected = selected_exchange
+ )
+ )
+ }
+}
+
+viewer_ui <- function(summary) {
+ dates <- viewer_date_range(summary)
+ htmltools::attachDependencies(
+ bslib::page_sidebar(
+ title = "Trajectory reviewer",
+ sidebar = bslib::sidebar(
+ width = 380,
+ class = "commons-viewer-sidebar",
+ bslib::navset_underline(
+ id = "group_by",
+ bslib::nav_panel("Conversations", value = "conversation"),
+ bslib::nav_panel("Questions", value = "question")
+ ),
+ shiny::dateRangeInput(
+ "window",
+ "Dates",
+ start = dates$min,
+ end = dates$max,
+ min = dates$min,
+ max = dates$max
+ ),
+ shiny::selectInput(
+ "trust",
+ "Trust Level",
+ trust_choices("conversation")
+ ),
+ shiny::uiOutput("entries")
+ ),
+ trust_timeline_card(),
+ bslib::card(
+ fill = TRUE,
+ class = "commons-viewer-transcript",
+ bslib::layout_sidebar(
+ shiny::uiOutput("transcript", fill = TRUE),
+ sidebar = bslib::sidebar(
+ htmltools::div(
+ class = "commons-viewer-review-pane",
+ shiny::uiOutput("review_bar"),
+ shiny::conditionalPanel(
+ "output.review_ready === 'ready'",
+ bslib::input_submit_textarea(
+ "review_note",
+ placeholder = "Add a note",
+ width = "100%",
+ button = htmltools::tags$button(
+ type = "button",
+ class = "btn commons-viewer-note-submit",
+ title = "Add note",
+ `aria-label` = "Add note",
+ maybe_icon("arrow-up") %||% "\u2191"
+ ),
+ submit_key = "enter"
+ ),
+ class = "commons-viewer-note-compose"
+ )
+ ),
+ position = "right",
+ width = 320,
+ padding = 0,
+ resizable = TRUE
+ ),
+ border = FALSE,
+ border_radius = FALSE,
+ padding = 0,
+ gap = 0
+ )
+ )
+ ),
+ c(
+ # Match the dependency order used by a live commons chat.
+ htmltools::findDependencies(shinychat::chat_ui("commons_viewer_probe")),
+ list(commons_chat_dependency(), commons_viewer_dependency())
+ )
+ )
+}
+
+trust_choices <- function(group_by) {
+ if (identical(group_by, "question")) {
+ c(
+ "All answers" = "all",
+ "Verified" = "A",
+ "Cited" = "B",
+ "Untrusted" = "C",
+ "No data tool" = "none"
+ )
+ } else {
+ c(
+ "All conversations" = "all",
+ "Has a verified answer" = "A",
+ "Has a cited answer" = "B",
+ "Has an untrusted answer" = "C",
+ "Has an answer with no data tool" = "none"
+ )
+ }
+}
+
+viewer_server <- function(
+ trajectories,
+ summary,
+ questions,
+ review_file,
+ source = trajectory_source(trajectories)
+) {
+ # Share review state across sessions in the documented single process.
+ review_records <- read_review_records(review_file)
+ app_flags <- shiny::reactiveVal(review_flags(review_records))
+ app_notes <- shiny::reactiveVal(review_notes(review_records))
+
+ function(input, output, session) {
+ flags <- app_flags
+ notes <- app_notes
+ selected <- shiny::reactiveVal(NULL)
+ selected_transcript <- shiny::reactive({
+ key <- selected()
+ if (is.null(key)) {
+ return(NULL)
+ }
+ trajectory_transcript(trajectories[[key$conversation]])
+ })
+ review_target <- shiny::reactiveVal(NULL)
+ review_selection <- shiny::reactive({
+ review_target() %||% selected()["conversation"]
+ })
+ user <- review_user(session)
+
+ output$review_ready <- shiny::renderText({
+ if (is.null(review_selection())) "" else "ready"
+ })
+ shiny::outputOptions(output, "review_ready", suspendWhenHidden = FALSE)
+
+ shiny::observeEvent(
+ review_selection(),
+ ignoreNULL = FALSE,
+ {
+ key <- review_selection()
+ placeholder <- if (is.null(key)) {
+ "Add a note"
+ } else if (is.null(key$exchange)) {
+ "Add a note about this conversation"
+ } else {
+ "Add a note about this exchange"
+ }
+ bslib::update_submit_textarea(
+ "review_note",
+ value = "",
+ placeholder = placeholder,
+ session = session
+ )
+ }
+ )
+
+ shiny::observeEvent(input$group_by, {
+ shiny::updateSelectInput(
+ session,
+ "trust",
+ choices = trust_choices(input$group_by),
+ selected = input$trust
+ )
+ })
+
+ visible_conversations <- shiny::reactive({
+ Filter(
+ function(i) {
+ conversation_visible(summary[[i]], input$window, input$trust)
+ },
+ seq_along(summary)
+ )
+ })
+
+ visible_questions <- shiny::reactive({
+ Filter(
+ function(k) question_visible(questions[[k]], input$window, input$trust),
+ seq_along(questions)
+ )
+ })
+
+ output$timeline_legend <- shiny::renderUI({
+ in_dates <- Filter(
+ function(i) in_window(summary[[i]], input$window),
+ seq_along(summary)
+ )
+ timeline_legend(hit_rate(lapply(in_dates, function(i) summary[[i]]$tags)))
+ })
+
+ output$timeline <- shiny::renderUI({
+ trust_timeline(trust_timeline_bins(questions, input$window))
+ })
+
+ output$entries <- shiny::renderUI({
+ entries <- if (identical(input$group_by, "question")) {
+ lapply(
+ visible_questions(),
+ function(k) question_entry(questions[[k]], selected(), flags())
+ )
+ } else {
+ lapply(
+ visible_conversations(),
+ function(i) conversation_entry(i, summary[[i]], selected(), flags())
+ )
+ }
+ if (length(entries) == 0) {
+ return(viewer_empty_note(
+ if (length(summary) == 0) {
+ "No conversations to view."
+ } else {
+ "Nothing matches these filters."
+ }
+ ))
+ }
+ entries
+ })
+
+ # Register once because filtering does not change trajectory indices.
+ all_keys <- c(
+ lapply(seq_along(trajectories), function(i) list(conversation = i)),
+ lapply(questions, function(record) record[c("conversation", "exchange")])
+ )
+ for (key in all_keys) {
+ local({
+ k <- key
+ shiny::observeEvent(input[[entry_link_id(k)]], {
+ selected(k)
+ review_target(if (is.null(k$exchange)) NULL else k)
+ })
+ })
+ }
+
+ output$review_bar <- shiny::renderUI({
+ key <- review_selection()
+ if (is.null(key)) {
+ return(NULL)
+ }
+ flagged <- selection_review_key(key, summary) %in% flags()
+ review_bar_notes(
+ key,
+ flagged,
+ notes_for_selection(notes(), key, summary)
+ )
+ })
+
+ shiny::observeEvent(input$flag_toggle, {
+ key <- review_selection()
+ if (is.null(key)) {
+ return()
+ }
+ review <- selection_review_key(key, summary)
+ flagged <- review %in% flags()
+ record <- new_review_event(
+ trajectories,
+ key,
+ action = if (flagged) "unflag" else "flag",
+ user = user,
+ source = source
+ )
+ append_review_record(review_file, record)
+ flags(if (flagged) setdiff(flags(), review) else union(flags(), review))
+ })
+
+ shiny::observeEvent(input$exchange_select, {
+ navigation <- selected()
+ if (is.null(navigation)) {
+ return()
+ }
+ exchange <- as.integer(input$exchange_select$exchange)
+ if (length(exchange) != 1 || is.na(exchange)) {
+ review_target(NULL)
+ return()
+ }
+ if (
+ !exchange %in%
+ seq_along(split_exchanges(trajectories[[navigation$conversation]]))
+ ) {
+ return()
+ }
+ review_target(list(
+ conversation = navigation$conversation,
+ exchange = exchange
+ ))
+ })
+
+ shiny::observeEvent(
+ review_target(),
+ ignoreNULL = FALSE,
+ ignoreInit = TRUE,
+ {
+ key <- selected()
+ if (is.null(key)) {
+ return()
+ }
+ target <- review_target()
+ session$sendCustomMessage(
+ "commonsViewerExchangeSelect",
+ list(
+ id = transcript_id(key),
+ exchange = if (!is.null(target)) target$exchange
+ )
+ )
+ }
+ )
+
+ shiny::observeEvent(input$review_note, {
+ key <- review_selection()
+ note <- trimws(input$review_note %||% "")
+ if (is.null(key) || !nzchar(note)) {
+ return()
+ }
+ record <- new_review_event(
+ trajectories,
+ key,
+ action = "note",
+ user = user,
+ source = source,
+ note = note
+ )
+ append_review_record(review_file, record)
+ notes(c(notes(), list(record)))
+ bslib::update_submit_textarea(
+ "review_note",
+ value = "",
+ focus = TRUE,
+ session = session
+ )
+ })
+
+ # A fresh id prevents stale pill timers from targeting a new transcript.
+ output$transcript <- shiny::renderUI({
+ key <- selected()
+ if (is.null(key)) {
+ return(viewer_empty_note(
+ "Select a conversation to view its transcript."
+ ))
+ }
+ commons_ui(
+ transcript_id(key),
+ messages = selected_transcript()$messages,
+ height = "100%"
+ )
+ })
+
+ # Seed decorations only after the new chat element is bound in the browser.
+ shiny::observeEvent(selected(), {
+ key <- selected()
+ transcript <- selected_transcript()
+ session$onFlushed(
+ function() {
+ seed_transcript_decorations(
+ session,
+ transcript_id(key),
+ transcript,
+ selected_exchange = key$exchange
+ )
+ },
+ once = TRUE
+ )
+ })
+ }
+}
+
+conversation_visible <- function(record, window, trust) {
+ in_window(record, window) &&
+ (identical(trust, "all") || any(tag_matches(record$tags, trust)))
+}
+
+question_visible <- function(record, window, trust) {
+ in_window(record, window) && tag_matches(record$tag, trust)
+}
+
+tag_matches <- function(tags, trust) {
+ switch(
+ trust,
+ all = rep(TRUE, length(tags)),
+ none = is.na(tags),
+ tags %in% trust
+ )
+}
+
+entry_link_id <- function(key) {
+ paste(c("entry", key$conversation, key$exchange), collapse = "_")
+}
+
+transcript_id <- function(key) {
+ paste(c("transcript", key$conversation, key$exchange), collapse = "_")
+}
+
+review_bar_notes <- function(key, flagged, notes) {
+ whole_conversation <- is.null(key$exchange)
+ htmltools::div(
+ class = "commons-viewer-review",
+ htmltools::div(
+ class = "commons-viewer-review-bar",
+ htmltools::tags$strong(
+ if (whole_conversation) {
+ "Notes"
+ } else {
+ sprintf("Notes for Question %d", key$exchange)
+ }
+ ),
+ flag_button(flagged, whole_conversation)
+ ),
+ if (whole_conversation) {
+ htmltools::div(
+ class = "commons-viewer-review-prompt",
+ "Notes here apply to the entire conversation. Select a question or
+ answer in the transcript to add a note specific to that exchange."
+ )
+ },
+ review_note_list(notes)
+ )
+}
+
+review_note_list <- function(notes) {
+ if (length(notes) == 0) {
+ return(NULL)
+ }
+ htmltools::div(
+ class = "commons-viewer-notes",
+ lapply(notes, function(note) {
+ htmltools::div(
+ class = "commons-viewer-note",
+ htmltools::div(class = "commons-viewer-note-text", note$note),
+ note_date(note)
+ )
+ })
+ )
+}
+
+note_date <- function(note) {
+ time <- parse_review_time(note$time %||% "")
+ if (is.na(time)) {
+ return(NULL)
+ }
+ attr(time, "tzone") <- ""
+ htmltools::div(class = "commons-viewer-note-meta", day_label(time))
+}
+
+notes_for_selection <- function(notes, key, summary) {
+ selection <- selection_review_key(key, summary)
+ Filter(
+ function(note) review_key(note$conversation, note$exchange) == selection,
+ notes
+ )
+}
+
+selection_review_key <- function(key, summary) {
+ review_key(summary[[key$conversation]]$id, key$exchange)
+}
+
+flag_button <- function(flagged, whole_conversation) {
+ what <- if (whole_conversation) "conversation" else "question"
+ title <- if (flagged) {
+ "Flagged for review \u2014 click to unflag"
+ } else {
+ sprintf("Flag this %s for review", what)
+ }
+ bslib::tooltip(
+ shiny::actionButton(
+ "flag_toggle",
+ label = "\u2691",
+ class = if (flagged) {
+ "commons-viewer-flag-button commons-viewer-flag-button-on"
+ } else {
+ "commons-viewer-flag-button"
+ },
+ `aria-label` = title,
+ `aria-pressed` = if (flagged) "true" else "false"
+ ),
+ title
+ )
+}
+
+flag_marker <- function(flagged) {
+ if (!flagged) {
+ return(NULL)
+ }
+ htmltools::tags$span(
+ class = "commons-viewer-flag",
+ title = "Flagged for review",
+ "\u2691"
+ )
+}
+
+conversation_entry <- function(
+ index,
+ record,
+ selected = NULL,
+ flags = character()
+) {
+ key <- list(conversation = index)
+ shiny::actionLink(
+ entry_link_id(key),
+ class = entry_class(identical(selected, key)),
+ label = htmltools::tagList(
+ htmltools::div(class = "commons-viewer-entry-snippet", record$snippet),
+ htmltools::div(
+ class = "commons-viewer-entry-meta",
+ flag_marker(review_key(record$id) %in% flags),
+ htmltools::tags$span(conversation_meta(record))
+ )
+ )
+ )
+}
+
+question_entry <- function(record, selected = NULL, flags = character()) {
+ key <- record[c("conversation", "exchange")]
+ flagged <- review_key(record$conversation_id, record$exchange) %in% flags
+ shiny::actionLink(
+ entry_link_id(key),
+ class = entry_class(identical(selected, key)),
+ label = htmltools::tagList(
+ htmltools::div(class = "commons-viewer-entry-snippet", record$snippet),
+ htmltools::div(
+ class = "commons-viewer-entry-meta",
+ flag_marker(flagged),
+ htmltools::tags$span(entry_date(record)),
+ commons_answer_pill(record$tag)
+ )
+ )
+ )
+}
+
+entry_class <- function(selected) {
+ if (selected) {
+ "commons-viewer-entry commons-viewer-entry-selected"
+ } else {
+ "commons-viewer-entry"
+ }
+}
+
+conversation_meta <- function(record) {
+ turns <- sprintf(
+ "%d %s",
+ record$n_user_turns,
+ if (record$n_user_turns == 1) "turn" else "turns"
+ )
+ date <- entry_date(record)
+ if (is.null(date)) {
+ return(turns)
+ }
+ sprintf("%s \u00b7 %s", turns, date)
+}
+
+entry_date <- function(record) {
+ time <- record$last_active
+ if (is.na(time)) {
+ return(NULL)
+ }
+ sprintf(
+ "%s %s",
+ day_label(time),
+ sub("^0", "", format(time, "%I:%M %p"))
+ )
+}
+
+viewer_empty_note <- function(text) {
+ htmltools::div(class = "commons-viewer-empty", text)
+}
+
+in_window <- function(record, window) {
+ if (length(window) < 2) {
+ return(TRUE)
+ }
+ date <- local_date(record$last_active)
+ is.na(date) || (date >= window[[1]] && date <= window[[2]])
+}
+
+viewer_date_range <- function(summary) {
+ dates <- record_dates(summary)
+ dates <- dates[!is.na(dates)]
+ if (length(dates) == 0) {
+ return(list(min = Sys.Date(), max = Sys.Date()))
+ }
+ list(min = min(dates), max = max(dates))
+}
+
+record_dates <- function(records) {
+ as.Date(vapply(
+ records,
+ function(record) as.character(local_date(record$last_active)),
+ character(1)
+ ))
+}
+
+# as.Date.POSIXct() defaults to UTC rather than the reviewer's local day.
+local_date <- function(time) {
+ as.Date(format(time, "%Y-%m-%d"))
+}
+
+day_label <- function(date) {
+ gsub("\\s+", " ", format(date, "%b %e, %Y"))
+}
+
+# Asset mtimes invalidate browser caches during package development.
+commons_viewer_dependency <- function() {
+ src <- system.file("www", "commons-viewer", package = "commons")
+ stamp <- max(file.mtime(list.files(src, full.names = TRUE)))
+
+ htmltools::htmlDependency(
+ name = "commons-viewer",
+ version = paste0("0.0.0.9000.", as.integer(stamp)),
+ src = c(file = src),
+ stylesheet = "commons-viewer.css",
+ script = "commons-viewer.js"
+ )
+}
diff --git a/R/trajectory-timeline.R b/R/trajectory-timeline.R
new file mode 100644
index 0000000..15e2485
--- /dev/null
+++ b/R/trajectory-timeline.R
@@ -0,0 +1,370 @@
+viewer_levels <- c(
+ A = "Verified",
+ B = "Cited",
+ C = "Untrusted",
+ none = "No data tool"
+)
+
+viewer_level_colors <- c(
+ A = "#2a9d64",
+ B = "#2a78d6",
+ C = "#b8860b",
+ none = "#8a72c8"
+)
+
+trust_timeline_card <- function() {
+ bslib::card(
+ fill = FALSE,
+ class = "commons-viewer-timeline-card",
+ bslib::card_header(
+ class = "commons-viewer-timeline-header",
+ htmltools::tags$strong("Trust levels over time"),
+ shiny::uiOutput("timeline_legend", inline = TRUE)
+ ),
+ shiny::uiOutput("timeline")
+ )
+}
+
+timeline_legend <- function(rate) {
+ htmltools::div(
+ class = "commons-viewer-timeline-legend",
+ lapply(names(viewer_levels), function(key) {
+ htmltools::tags$span(
+ class = "commons-viewer-timeline-legend-item",
+ title = sprintf(
+ "%d of %d answers (%s)",
+ rate$counts[[key]],
+ rate$n,
+ rate_percent(rate$counts[[key]], rate$n)
+ ),
+ htmltools::tags$span(
+ class = "commons-viewer-timeline-swatch",
+ style = paste0("background:", viewer_level_colors[[key]])
+ ),
+ viewer_levels[[key]]
+ )
+ })
+ )
+}
+
+hit_rate <- function(tag_sets) {
+ tags <- unlist(tag_sets) %||% character()
+ list(n = length(tags), counts = tag_counts(tags))
+}
+
+tag_counts <- function(tags) {
+ c(
+ A = sum(tags %in% "A"),
+ B = sum(tags %in% "B"),
+ C = sum(tags %in% "C"),
+ none = sum(is.na(tags))
+ )
+}
+
+rate_percent <- function(count, n) {
+ if (n == 0) {
+ return("\u2014")
+ }
+ sprintf("%.0f%%", 100 * count / n)
+}
+
+trust_timeline_bins <- function(questions, window = NULL, target = 5) {
+ dates <- record_dates(questions)
+ keep <- !is.na(dates)
+ if (length(window) >= 2) {
+ keep <- keep & dates >= window[[1]] & dates <= window[[2]]
+ }
+ questions <- questions[keep]
+ dates <- dates[keep]
+
+ bounds <- timeline_bounds(window, dates)
+ unit <- timeline_bin_unit(dates, bounds, target)
+ starts <- timeline_bin_start(dates, unit)
+ bins <- lapply(sort(unique(starts)), function(start) {
+ tags <- vapply(
+ questions[starts == start],
+ function(record) record$tag,
+ character(1)
+ )
+ list(
+ date = format(max(start, bounds[[1]]), "%Y-%m-%d"),
+ label = timeline_bin_label(start, unit, bounds),
+ n = length(tags),
+ counts = tag_counts(tags)
+ )
+ })
+ sparse <- length(bins) > 0 && length(dates) < target * length(bins)
+ list(unit = unit, bins = bins, sparse = sparse)
+}
+
+timeline_bounds <- function(window, dates) {
+ if (length(window) >= 2) {
+ return(as.Date(c(window[[1]], window[[2]])))
+ }
+ if (length(dates) == 0) {
+ return(NULL)
+ }
+ c(min(dates), max(dates))
+}
+
+# Do not choose a unit the selected window cannot span at least twice.
+timeline_bin_unit <- function(dates, bounds, target) {
+ if (is.null(bounds)) {
+ return("day")
+ }
+ span <- as.integer(bounds[[2]] - bounds[[1]]) + 1L
+ units <- c("day", if (span >= 14) "week", if (span >= 60) "month")
+ for (unit in units) {
+ bins <- unique(timeline_bin_start(dates, unit))
+ if (length(dates) >= target * length(bins)) {
+ return(unit)
+ }
+ }
+ units[[length(units)]]
+}
+
+timeline_bin_start <- function(dates, unit) {
+ switch(
+ unit,
+ day = dates,
+ week = dates - (as.integer(format(dates, "%u")) - 1L),
+ month = as.Date(format(dates, "%Y-%m-01"))
+ )
+}
+
+timeline_bin_label <- function(start, unit, bounds) {
+ if (identical(unit, "day")) {
+ return(day_label(start))
+ }
+ end <- if (identical(unit, "week")) {
+ start + 6
+ } else {
+ seq(start, by = "1 month", length.out = 2)[[2]] - 1
+ }
+ from <- max(start, bounds[[1]])
+ to <- min(end, bounds[[2]])
+ if (identical(unit, "month") && from == start && to == end) {
+ return(format(start, "%B %Y"))
+ }
+ timeline_range_label(from, to)
+}
+
+timeline_range_label <- function(from, to) {
+ day <- function(date) sub("^\\s+", "", format(date, "%e"))
+ if (from == to) {
+ day_label(from)
+ } else if (identical(format(from, "%Y-%m"), format(to, "%Y-%m"))) {
+ sprintf(
+ "%s %s\u2013%s, %s",
+ format(from, "%b"),
+ day(from),
+ day(to),
+ format(from, "%Y")
+ )
+ } else if (identical(format(from, "%Y"), format(to, "%Y"))) {
+ sprintf(
+ "%s %s \u2013 %s %s, %s",
+ format(from, "%b"),
+ day(from),
+ format(to, "%b"),
+ day(to),
+ format(from, "%Y")
+ )
+ } else {
+ sprintf(
+ "%s %s, %s \u2013 %s %s, %s",
+ format(from, "%b"),
+ day(from),
+ format(from, "%Y"),
+ format(to, "%b"),
+ day(to),
+ format(to, "%Y")
+ )
+ }
+}
+
+# The hidden table exposes values without Plotly's drawing internals.
+trust_timeline <- function(binned) {
+ if (length(binned$bins) == 0) {
+ return(viewer_empty_note("No dated questions in this date range."))
+ }
+ htmltools::div(
+ class = "commons-viewer-timeline",
+ htmltools::div(
+ class = "commons-viewer-timeline-plot",
+ role = "img",
+ `aria-label` = sprintf(
+ "Chart of the share of answers at each trust level by %s.
+ The values appear in the table that follows.",
+ binned$unit
+ ),
+ timeline_plot(binned$bins, binned$unit, binned$sparse)
+ ),
+ timeline_table(binned$bins)
+ )
+}
+
+timeline_plot <- function(bins, unit, sparse = FALSE) {
+ dates <- as.Date(vapply(bins, function(bin) bin$date, character(1)))
+ n <- vapply(bins, function(bin) bin$n, numeric(1))
+ # Plotly does not expand a length-one %{text} value serialized as a scalar.
+ tooltips <- paste0(
+ vapply(bins, timeline_tooltip, character(1)),
+ ""
+ )
+ plot <- plotly::plot_ly(height = 176)
+ use_bars <- length(bins) == 1 ||
+ sparse ||
+ !identical(unit, "day")
+
+ for (k in seq_along(viewer_levels)) {
+ key <- names(viewer_levels)[[k]]
+ counts <- vapply(bins, function(bin) bin$counts[[key]], numeric(1))
+ shares <- 100 * counts / n
+ plot <- if (use_bars) {
+ plotly::add_bars(
+ plot,
+ x = dates,
+ y = shares,
+ name = unname(viewer_levels[[key]]),
+ hovertemplate = tooltips,
+ marker = list(color = viewer_level_colors[[key]]),
+ width = timeline_bar_width(dates, unit)
+ )
+ } else {
+ plotly::add_trace(
+ plot,
+ x = dates,
+ y = shares,
+ name = unname(viewer_levels[[key]]),
+ hovertemplate = tooltips,
+ hoveron = "points",
+ type = "scatter",
+ mode = "lines",
+ stackgroup = "levels",
+ fillcolor = viewer_level_colors[[key]],
+ line = list(
+ color = "#ffffff",
+ width = if (k == length(viewer_levels)) 0 else 2
+ )
+ )
+ }
+ }
+
+ # Auto ticks can land between sparse bins; label actual bins instead.
+ max_ticks <- if (identical(unit, "day")) 7 else 5
+ ticks <- unique(round(seq(
+ 1,
+ length(dates),
+ length.out = min(length(dates), max_ticks)
+ )))
+ ticktext <- timeline_ticktext(bins, ticks, unit)
+
+ plot <- plotly::layout(
+ plot,
+ barmode = "stack",
+ hovermode = "closest",
+ hoverdistance = -1,
+ hoverlabel = list(
+ align = "left",
+ bgcolor = "#ffffff",
+ bordercolor = "#dee2e6",
+ font = list(size = 12, color = "#212529")
+ ),
+ showlegend = FALSE,
+ margin = list(
+ t = 8,
+ r = 12,
+ b = if (identical(unit, "day")) 22 else 34,
+ l = 40
+ ),
+ paper_bgcolor = "transparent",
+ plot_bgcolor = "transparent",
+ font = list(size = 11, color = "#6c757d"),
+ xaxis = list(
+ title = FALSE,
+ type = "date",
+ showgrid = FALSE,
+ fixedrange = TRUE,
+ showspikes = FALSE,
+ ticklabelposition = "outside right",
+ tickvals = as.list(format(dates[ticks])),
+ ticktext = as.list(ticktext),
+ # Prevent one bar from filling the full plot width.
+ range = if (length(bins) == 1) as.list(format(dates + c(-1, 1)))
+ ),
+ yaxis = list(
+ title = FALSE,
+ range = c(0, 100),
+ tickvals = c(0, 50, 100),
+ ticksuffix = "%",
+ gridcolor = "#dee2e6",
+ zeroline = FALSE,
+ fixedrange = TRUE
+ )
+ )
+ plotly::config(plot, displayModeBar = FALSE, responsive = TRUE)
+}
+
+timeline_ticktext <- function(bins, ticks, unit) {
+ if (identical(unit, "day")) {
+ dates <- as.Date(vapply(bins[ticks], function(bin) bin$date, character(1)))
+ return(format(dates, "%b %e"))
+ }
+ vapply(bins[ticks], `[[`, character(1), "label")
+}
+
+timeline_bar_width <- function(dates, unit) {
+ if (length(dates) == 1) {
+ return(7200000)
+ }
+ unit_days <- switch(unit, day = 1, week = 7, month = 28)
+ spacing <- min(diff(as.numeric(dates)))
+ 0.8 * min(unit_days, spacing) * 24 * 60 * 60 * 1000
+}
+
+# Plotly hover text supports colored text but not HTML swatches.
+timeline_tooltip <- function(bin) {
+ rows <- vapply(
+ names(viewer_levels),
+ function(key) {
+ sprintf(
+ "\u25a0 %s %s",
+ viewer_level_colors[[key]],
+ rate_percent(bin$counts[[key]], bin$n),
+ viewer_levels[[key]]
+ )
+ },
+ character(1)
+ )
+ paste(
+ c(sprintf("%s (n = %d)", bin$label, bin$n), rows),
+ collapse = "
"
+ )
+}
+
+timeline_table <- function(bins) {
+ rows <- lapply(bins, function(bin) {
+ htmltools::tags$tr(
+ htmltools::tags$td(bin$label),
+ lapply(names(viewer_levels), function(key) {
+ htmltools::tags$td(sprintf(
+ "%s (%d)",
+ rate_percent(bin$counts[[key]], bin$n),
+ bin$counts[[key]]
+ ))
+ }),
+ htmltools::tags$td(bin$n)
+ )
+ })
+ htmltools::tags$table(
+ class = "commons-viewer-sr-only",
+ htmltools::tags$caption("Trust levels over time"),
+ htmltools::tags$thead(htmltools::tags$tr(
+ htmltools::tags$th("Date"),
+ lapply(unname(viewer_levels), htmltools::tags$th),
+ htmltools::tags$th("Answers")
+ )),
+ htmltools::tags$tbody(rows)
+ )
+}
diff --git a/inst/www/commons-viewer/commons-viewer.css b/inst/www/commons-viewer/commons-viewer.css
new file mode 100644
index 0000000..d445957
--- /dev/null
+++ b/inst/www/commons-viewer/commons-viewer.css
@@ -0,0 +1,299 @@
+.commons-viewer-transcript .shiny-chat-message .message-icon {
+ display: none;
+}
+
+.commons-viewer-transcript .shiny-chat-input {
+ display: none;
+}
+
+.commons-viewer-timeline-card {
+ flex: 0 0 auto;
+}
+
+.commons-viewer-timeline-card .card-body {
+ padding: 0.5rem 0.75rem 0.625rem;
+}
+
+.commons-viewer-timeline-header {
+ align-items: center;
+ background: transparent;
+ border-bottom: 0;
+ display: flex;
+ flex-wrap: wrap;
+ gap: 0.5rem 1rem;
+ justify-content: space-between;
+ padding: 0.75rem 0.75rem 0;
+}
+
+.commons-viewer-timeline-header strong {
+ color: var(--bs-secondary-color, #6c757d);
+ font-size: 0.8125rem;
+ font-weight: 600;
+}
+
+.commons-viewer-timeline-legend {
+ display: flex;
+ flex-wrap: wrap;
+ gap: 0.25rem 0.875rem;
+}
+
+.commons-viewer-timeline-legend-item {
+ align-items: center;
+ color: var(--bs-secondary-color, #6c757d);
+ display: inline-flex;
+ font-size: 0.75rem;
+ gap: 0.35rem;
+}
+
+.commons-viewer-timeline-swatch {
+ border-radius: 2px;
+ display: inline-block;
+ flex: 0 0 auto;
+ height: 0.625rem;
+ width: 0.625rem;
+}
+
+.commons-viewer-timeline-plot {
+ height: 11rem;
+ width: 100%;
+}
+
+.commons-viewer-sr-only {
+ border: 0;
+ clip: rect(0, 0, 0, 0);
+ height: 1px;
+ margin: -1px;
+ overflow: hidden;
+ padding: 0;
+ position: absolute;
+ white-space: nowrap;
+ width: 1px;
+}
+
+.commons-viewer-review {
+ padding: 0.75rem 1rem;
+}
+
+.commons-viewer-review-bar {
+ align-items: center;
+ display: flex;
+ justify-content: space-between;
+}
+
+.commons-viewer-review-bar strong {
+ color: var(--bs-secondary-color, #6c757d);
+ font-size: 0.8125rem;
+ font-weight: 600;
+}
+
+.commons-viewer-review-prompt {
+ color: var(--bs-secondary-color, #6c757d);
+ font-size: 0.875rem;
+ margin-top: 0.5rem;
+}
+
+.commons-viewer-notes {
+ display: grid;
+ gap: 0.625rem;
+ margin-top: 0.75rem;
+}
+
+.commons-viewer-note {
+ border-left: 2px solid var(--bs-border-color, #dee2e6);
+ font-size: 0.875rem;
+ padding: 0.05rem 0 0.05rem 0.625rem;
+}
+
+.commons-viewer-note-text {
+ white-space: pre-wrap;
+}
+
+.commons-viewer-note-meta {
+ color: var(--bs-secondary-color, #6c757d);
+ font-size: 0.75rem;
+ margin-top: 0.125rem;
+}
+
+.commons-viewer-note-compose {
+ box-sizing: border-box;
+}
+
+.commons-viewer-note-compose .bslib-input-submit-textarea {
+ margin: 0 1rem 0.75rem;
+ max-width: 18rem;
+ width: calc(100% - 2rem) !important;
+}
+
+.commons-viewer-note-compose .bslib-submit-textarea-container {
+ border-radius: 0.75rem;
+ overflow: hidden;
+}
+
+.commons-viewer-note-compose textarea {
+ font-size: 0.875rem;
+}
+
+.commons-viewer-note-compose .commons-viewer-note-submit,
+.commons-viewer-note-compose .commons-viewer-note-submit:focus {
+ align-items: center;
+ background-color: var(--bs-body-color, #212529);
+ border: 0;
+ border-radius: 50%;
+ color: var(--bs-body-bg, #fff);
+ display: inline-flex;
+ flex: 0 0 1.5rem;
+ font-size: 0.6875rem;
+ height: 1.5rem;
+ justify-content: center;
+ line-height: 1;
+ padding: 0;
+ width: 1.5rem;
+}
+
+.commons-viewer-note-compose .commons-viewer-note-submit:hover,
+.commons-viewer-note-compose .commons-viewer-note-submit:active {
+ background-color: var(--bs-primary, #007bc2);
+ color: #fff;
+}
+
+.commons-viewer-note-compose .commons-viewer-note-submit:focus-visible {
+ box-shadow: 0 0 0 0.2rem var(--bs-focus-ring-color, rgba(0, 123, 194, 0.25));
+ outline: 0;
+}
+
+.commons-viewer-flag-button,
+.commons-viewer-flag-button:hover,
+.commons-viewer-flag-button:focus,
+.commons-viewer-flag-button:active {
+ background: transparent;
+ border: none;
+ color: var(--bs-secondary-color, #6c757d);
+ font-size: 1.25rem;
+ line-height: 1;
+ padding: 0.25rem 0.5rem;
+}
+
+.commons-viewer-flag-button:hover,
+.commons-viewer-flag-button-on,
+.commons-viewer-flag-button-on:hover,
+.commons-viewer-flag-button-on:focus,
+.commons-viewer-flag-button-on:active {
+ color: #b54708;
+}
+
+.commons-viewer-flag {
+ color: #b54708;
+}
+
+.shiny-chat-messages-content {
+ position: relative;
+}
+
+.commons-viewer-exchange-message {
+ border-radius: 1rem;
+ cursor: pointer;
+ position: relative;
+ transition: background-color 0.15s ease;
+ z-index: 1;
+}
+
+.commons-viewer-exchange-message:not(.commons-viewer-exchange-selected):hover {
+ background-color: color-mix(in srgb, #007bc2 5%, transparent);
+}
+
+.commons-viewer-transcript
+ .shiny-chat-user-message.commons-viewer-exchange-message:not(
+ .commons-viewer-exchange-selected
+ ):hover {
+ background-color: color-mix(
+ in srgb,
+ #007bc2 7%,
+ var(--shiny-chat-user-message-bg, #f4f5f7)
+ );
+}
+
+.commons-viewer-exchange-message:focus-visible {
+ outline: 2px solid #007bc2;
+ outline-offset: 2px;
+}
+
+.commons-viewer-exchange-highlight {
+ background: color-mix(in srgb, #007bc2 9%, transparent);
+ border-radius: 1rem;
+ display: none;
+ left: 0;
+ pointer-events: none;
+ position: absolute;
+ right: 0;
+ z-index: 0;
+}
+
+.commons-viewer-transcript
+ .shiny-chat-user-message.commons-viewer-exchange-selected {
+ background-color: transparent;
+}
+
+.commons-viewer-sidebar .control-label {
+ color: var(--bs-secondary-color, #6c757d);
+ font-size: 0.8125rem;
+ font-weight: 600;
+ margin-bottom: 0.25rem;
+}
+
+.commons-viewer-sidebar .tab-content:empty {
+ display: none;
+}
+
+.commons-viewer-entry {
+ border-radius: 0.5rem;
+ color: inherit;
+ display: block;
+ padding: 0.5rem 0.75rem;
+ text-decoration: none;
+}
+
+.commons-viewer-entry:hover,
+.commons-viewer-entry:focus {
+ background: var(--bs-secondary-bg, #f1f3f5);
+ color: inherit;
+ text-decoration: none;
+}
+
+.commons-viewer-entry-selected,
+.commons-viewer-entry-selected:hover,
+.commons-viewer-entry-selected:focus {
+ background: color-mix(in srgb, #007bc2 8%, var(--bs-body-bg, #fff));
+}
+
+.commons-viewer-entry-snippet {
+ font-weight: 500;
+ overflow: hidden;
+ text-overflow: ellipsis;
+ white-space: nowrap;
+}
+
+.commons-viewer-entry-meta {
+ align-items: center;
+ color: var(--bs-secondary-color, #6c757d);
+ display: flex;
+ flex-wrap: wrap;
+ font-size: 0.8125rem;
+ gap: 0.4rem;
+ margin-top: 0.125rem;
+}
+
+.commons-viewer-entry-meta .commons-answer-pill {
+ font-size: 0.68rem;
+ padding: 0.12rem 0.4rem;
+}
+
+.commons-viewer-entry-meta .commons-answer-pill-icon {
+ height: 0.75rem;
+ width: 0.75rem;
+}
+
+.commons-viewer-empty {
+ color: var(--bs-secondary-color, #6c757d);
+ padding: 1rem 0;
+ text-align: center;
+}
diff --git a/inst/www/commons-viewer/commons-viewer.js b/inst/www/commons-viewer/commons-viewer.js
new file mode 100644
index 0000000..214b786
--- /dev/null
+++ b/inst/www/commons-viewer/commons-viewer.js
@@ -0,0 +1,160 @@
+(function() {
+ var register = function() {
+ if (!window.Shiny || !Shiny.addCustomMessageHandler) {
+ window.setTimeout(register, 25);
+ return;
+ }
+ if (window.commonsViewerExchangeInitialized) return;
+ window.commonsViewerExchangeInitialized = true;
+
+ var exchangeMessages = function(chat) {
+ return chat.querySelectorAll(
+ ".shiny-chat-user-message, .shiny-chat-message"
+ );
+ };
+
+ var positionHighlight = function(chat) {
+ var selected = chat.querySelectorAll(
+ ".commons-viewer-exchange-selected"
+ );
+ var content = chat.querySelector(".shiny-chat-messages-content");
+ var highlight = content &&
+ content.querySelector(".commons-viewer-exchange-highlight");
+ if (!highlight || !selected.length) {
+ if (highlight) highlight.style.display = "none";
+ return;
+ }
+
+ var first = selected[0].getBoundingClientRect();
+ var last = selected[selected.length - 1].getBoundingClientRect();
+ var parent = content.getBoundingClientRect();
+ var padding = 8;
+ highlight.style.display = "block";
+ highlight.style.top = first.top - parent.top - padding + "px";
+ highlight.style.height = last.bottom - first.top + 2 * padding + "px";
+ };
+
+ var ensureHighlight = function(chat) {
+ var content = chat.querySelector(".shiny-chat-messages-content");
+ if (!content) return;
+ var highlight = content.querySelector(
+ ".commons-viewer-exchange-highlight"
+ );
+ if (!highlight) {
+ highlight = document.createElement("div");
+ highlight.className = "commons-viewer-exchange-highlight";
+ content.prepend(highlight);
+ }
+ if (!chat.commonsViewerResizeObserver) {
+ chat.commonsViewerResizeObserver = new ResizeObserver(function() {
+ positionHighlight(chat);
+ });
+ chat.commonsViewerResizeObserver.observe(content);
+ }
+ };
+
+ var selectExchange = function(chat, exchange) {
+ exchangeMessages(chat).forEach(function(node) {
+ var selected = node.dataset.exchange === String(exchange);
+ node.classList.toggle("commons-viewer-exchange-selected", selected);
+ if (node.dataset.exchange) {
+ node.setAttribute("aria-pressed", selected ? "true" : "false");
+ }
+ });
+ ensureHighlight(chat);
+ window.requestAnimationFrame(function() {
+ positionHighlight(chat);
+ });
+ };
+
+ var activateExchange = function(node) {
+ var chat = node.closest("shiny-chat-container");
+ var exchange = Number(node.dataset.exchange);
+ if (!chat || !Number.isInteger(exchange)) return;
+ var deselect = node.classList.contains(
+ "commons-viewer-exchange-selected"
+ );
+ selectExchange(chat, deselect ? null : exchange);
+ Shiny.setInputValue(
+ "exchange_select",
+ { exchange: deselect ? null : exchange, nonce: Math.random() },
+ { priority: "event" }
+ );
+ };
+
+ document.addEventListener("click", function(event) {
+ if (!event.target || !event.target.closest) return;
+ var node = event.target.closest(".commons-viewer-exchange-message");
+ if (!node) return;
+ var control = event.target.closest(
+ "a, button, input, textarea, select, [tabindex]"
+ );
+ if (control && control !== node) return;
+ activateExchange(node);
+ });
+
+ document.addEventListener("keydown", function(event) {
+ if (event.key !== "Enter" && event.key !== " ") return;
+ var node = event.target.closest(".commons-viewer-exchange-message");
+ if (!node || event.target !== node) return;
+ event.preventDefault();
+ activateExchange(node);
+ });
+
+ Shiny.addCustomMessageHandler("commonsViewerExchangeSelect", function(message) {
+ var chat = document.getElementById(message.id);
+ if (!chat) return;
+ selectExchange(chat, message.exchange == null ? null : message.exchange);
+ });
+
+ Shiny.addCustomMessageHandler("commonsViewerExchangeSeed", function(message) {
+ var chat = document.getElementById(message.id);
+ if (!chat) return;
+
+ var attempts = 0;
+ var stable = 0;
+ var lastSize = -1;
+ var seed = function() {
+ var nodes = exchangeMessages(chat);
+ var size = chat.textContent.length;
+ if (nodes.length < message.count || size !== lastSize) {
+ stable = 0;
+ } else {
+ stable += 1;
+ }
+ lastSize = size;
+ if (stable < 3) {
+ if (attempts++ < 200) window.setTimeout(seed, 25);
+ return;
+ }
+
+ message.exchanges.forEach(function(exchange, i) {
+ var node = nodes[i];
+ if (!node) return;
+ node.classList.add("commons-viewer-exchange-message");
+ node.dataset.exchange = exchange;
+ node.setAttribute("role", "button");
+ node.setAttribute("tabindex", "0");
+ node.setAttribute(
+ "aria-label",
+ "Select question " + exchange + " for review notes"
+ );
+ });
+ selectExchange(chat, message.selected);
+ if (message.selected != null) {
+ var target = chat.querySelector(
+ '.commons-viewer-exchange-message[data-exchange="' +
+ message.selected + '"]'
+ );
+ if (target) {
+ target.scrollIntoView({ behavior: "smooth", block: "start" });
+ }
+ }
+ };
+
+ seed();
+ });
+ };
+
+ register();
+})();
diff --git a/man/commons-package.Rd b/man/commons-package.Rd
index 0341636..402f380 100644
--- a/man/commons-package.Rd
+++ b/man/commons-package.Rd
@@ -5,6 +5,8 @@
\alias{commons-package}
\title{commons: Build Self-Service Data Science Agents}
\description{
+\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}}
+
Build correct and easy-to-use self-service data science agents for your organization. Connect raw data sources and a searchable context layer that demonstrates how to interpret them, then deploy agents that answer data questions, log interactions, and can be evaluated and improved over time.
}
\seealso{
diff --git a/man/read_trajectories.Rd b/man/read_trajectories.Rd
index a96b069..67596c6 100644
--- a/man/read_trajectories.Rd
+++ b/man/read_trajectories.Rd
@@ -32,7 +32,11 @@ history as of \code{to}.}
}
\value{
A list of conversations, named by conversation id and ordered
-oldest-first. Each conversation is a list of \link[ellmer:Turn]{ellmer::Turn}s.
+oldest-first. Each conversation is a list of \link[ellmer:Turn]{ellmer::Turn}s and carries
+a \code{last_active} attribute: a \code{POSIXct} giving the time of the
+conversation's most recent chat activity. The list carries a \code{source}
+attribute identifying the local trace directory or Connect content from
+which it was read.
}
\description{
\code{read_trajectories()} reads conversation trajectories captured by
diff --git a/man/trajectory_review.Rd b/man/trajectory_review.Rd
new file mode 100644
index 0000000..8fdcf4e
--- /dev/null
+++ b/man/trajectory_review.Rd
@@ -0,0 +1,73 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/trajectory-review.R
+\name{trajectory_review}
+\alias{trajectory_review}
+\title{Review commons trajectories}
+\usage{
+trajectory_review(
+ trajectories = read_trajectories(),
+ review_file = Sys.getenv("COMMONS_REVIEW_FILE", unset = "commons-review.jsonl")
+)
+}
+\arguments{
+\item{trajectories}{A named list of conversations, as returned by
+\code{\link[=read_trajectories]{read_trajectories()}}.}
+
+\item{review_file}{Path of the JSONL file that review actions append to:
+flags, unflags, and feedback notes, each with a timestamp, the
+conversation id, and (for questions) the exchange number. Created on
+first use; flags and notes recorded here are restored when the viewer
+reopens. Defaults to \code{COMMONS_REVIEW_FILE} when set.}
+}
+\value{
+A \code{\link[shiny:shinyApp]{shiny::shinyApp()}} object. Calling \code{trajectory_review()} at the
+console launches the reviewer; the result can also be served as the last
+expression of an \code{app.R}.
+}
+\description{
+\code{trajectory_review()} launches a Shiny app for browsing conversation
+trajectories read with \code{\link[=read_trajectories]{read_trajectories()}}. The app charts each trust
+level's share of answers over time—binned by day, week, or month, using
+the finest unit the volume of answers supports—alongside a list of
+conversations or of individual questions, filterable by date and trust
+level, and a transcript of each with the provenance pills the commons
+chat UI would show.
+
+Transcripts are reviewable rather than live: conversations and questions
+can be flagged for review and annotated with notes. Notes apply to the
+whole conversation, or to a single question-and-answer exchange selected
+in the transcript. Flags and notes land in \code{review_file}, one JSON record
+per line, and are restored when the viewer reopens.
+
+New review records use schema version 1 and include a unique event id, UTC
+timestamp, reviewer username, trajectory source, conversation id, optional
+exchange number, action, and optional note. Exchange-level records also
+snapshot the question and trust tag.
+
+Trajectories carry no record of how each answer was tagged when it was
+produced, so the viewer derives trust levels from the tool calls in the
+trajectory: answers backed only by governed tools (\code{call_measure},
+\code{call_metrics}) are verified, and answers that used fallback tools
+(\code{run_sql}, \code{run_r}) count as cited when they contain citation markup and
+untrusted when they don't. A cited answer's quotes render as footnotes so
+they can be reviewed, but they are not re-verified against the agent's
+context: footnotes name no source and are attributed "unverified".
+
+Logged calls that aren't part of the agent's question-and-answer record—
+shinychat's conversation-title generation, and completions with no user
+turn—are excluded from the viewer.
+}
+\details{
+A single reviewer app writes all of its review events to \code{review_file}. For a
+deployed app, point \code{COMMONS_REVIEW_FILE} at persistent storage: files in a
+Posit Connect app's working directory are replaced on redeployment.
+File-backed review apps should use one Connect process because separate
+processes do not coordinate file writes or in-memory review state.
+}
+\examples{
+\dontrun{
+trajectory_review()
+
+trajectory_review(read_trajectories(from = "2026-07-01"))
+}
+}
diff --git a/tests/testthat/_snaps/trajectory-review-log.md b/tests/testthat/_snaps/trajectory-review-log.md
new file mode 100644
index 0000000..dccadc2
--- /dev/null
+++ b/tests/testthat/_snaps/trajectory-review-log.md
@@ -0,0 +1,8 @@
+# read_review_records ignores malformed records
+
+ Code
+ records <- read_review_records(review_file)
+ Condition
+ Warning:
+ Ignoring invalid review record on line 1 of ''.
+
diff --git a/tests/testthat/_snaps/trajectory-review.md b/tests/testthat/_snaps/trajectory-review.md
new file mode 100644
index 0000000..2f76ec1
--- /dev/null
+++ b/tests/testthat/_snaps/trajectory-review.md
@@ -0,0 +1,8 @@
+# trajectory reviewer accepts empty trajectories and rejects other shapes
+
+ Code
+ check_trajectories("nope")
+ Condition
+ Error:
+ ! `trajectories` must be a named list of conversations as returned by `read_trajectories()`: each a list of s.
+
diff --git a/tests/testthat/fixtures/review-v1.jsonl b/tests/testthat/fixtures/review-v1.jsonl
new file mode 100644
index 0000000..ceb7c76
--- /dev/null
+++ b/tests/testthat/fixtures/review-v1.jsonl
@@ -0,0 +1,5 @@
+{"schema_version":1,"event_id":"event-1","time":"2026-08-01T16:00:00Z","user":"sara","source":{"kind":"connect","server":"https://connect.example.com","content_guid":"00000000-0000-0000-0000-000000000001"},"conversation":"conv1","action":"flag"}
+{"schema_version":1,"event_id":"event-2","time":"2026-08-01T16:01:00Z","user":"sara","source":{"kind":"connect","server":"https://connect.example.com","content_guid":"00000000-0000-0000-0000-000000000001"},"conversation":"conv1","exchange":1,"action":"note","note":"Use the governed orders measure.","question":"How many orders?","tag":"A"}
+{"schema_version":1,"event_id":"event-3","time":"2026-08-01T16:02:00Z","user":"sara","source":{"kind":"connect","server":"https://connect.example.com","content_guid":"00000000-0000-0000-0000-000000000001"},"conversation":"conv1","action":"unflag"}
+{"schema_version":1,"event_id":"event-4","time":"2026-08-01T16:03:00Z","user":"lee","source":{"kind":"connect","server":"https://connect.example.com","content_guid":"00000000-0000-0000-0000-000000000001"},"conversation":"conv1","exchange":1,"action":"flag","question":"How many orders?","tag":"A"}
+{"schema_version":1,"event_id":"event-5","time":"2026-08-01T16:04:00Z","user":"lee","source":{"kind":"connect","server":"https://connect.example.com","content_guid":"00000000-0000-0000-0000-000000000001"},"conversation":"conv1","action":"note","note":"Review the complete conversation."}
diff --git a/tests/testthat/test-trajectories.R b/tests/testthat/test-trajectories.R
index 8412891..ed44592 100644
--- a/tests/testthat/test-trajectories.R
+++ b/tests/testthat/test-trajectories.R
@@ -62,6 +62,14 @@ test_that("trajectories rebuild ellmer turns from semconv messages", {
expect_equal(turns[[5]]@text, "You rolled a 4.")
})
+test_that("conversations carry their last chat activity time", {
+ trajectories <- build_trajectories(parse_otlp_lines(staggered_test_line()))
+
+ last_active <- attr(trajectories[[1]], "last_active")
+ expect_s3_class(last_active, "POSIXct")
+ expect_equal(as.numeric(last_active), 101)
+})
+
test_that("rebuilt turns can be set on an ellmer chat", {
json <- test_turn_json()
spans <- parse_otlp_lines(otlp_test_line(list(
@@ -150,6 +158,10 @@ test_that("read_trajectories reads OTLP files from a directory", {
expect_length(trajectories, 1)
expect_length(read_local_spans(path), 1)
expect_s7_class(trajectories[[1]][[1]], ellmer::UserTurn)
+ expect_equal(
+ attr(trajectories, "source"),
+ list(kind = "local", path = normalizePath(path))
+ )
})
test_that("local trace files can follow a custom exporter template", {
@@ -487,10 +499,18 @@ test_that("read_trajectories stops Connect paging after n conversations", {
expect_equal(state$served, 1)
expect_named(trajectories, "t300")
+ expect_equal(
+ attr(trajectories, "source"),
+ list(
+ kind = "connect",
+ server = "https://connect.example.com",
+ content_guid = "ea3c1445-cb71-42df-a2f2-bdb18874ef41"
+ )
+ )
})
test_that("read_trajectories returns an empty list for a missing directory", {
- expect_equal(read_trajectories(file.path(tempdir(), "nope")), list())
+ expect_length(read_trajectories(file.path(tempdir(), "nope")), 0)
})
test_that("read_trajectories validates source", {
diff --git a/tests/testthat/test-trajectory-review-log.R b/tests/testthat/test-trajectory-review-log.R
new file mode 100644
index 0000000..c5e7b10
--- /dev/null
+++ b/tests/testthat/test-trajectory-review-log.R
@@ -0,0 +1,38 @@
+test_that("actionable_review_records returns notes and active flags", {
+ reviews <- actionable_review_records(
+ read_review_records(test_path("fixtures", "review-v1.jsonl"))
+ )
+
+ expect_equal(
+ vapply(reviews, function(record) record$event_id, character(1)),
+ c("event-2", "event-4", "event-5")
+ )
+ expect_equal(
+ reviews[[1]][c("user", "question", "tag", "source")],
+ list(
+ user = "sara",
+ question = "How many orders?",
+ tag = "A",
+ source = list(
+ kind = "connect",
+ server = "https://connect.example.com",
+ content_guid = "00000000-0000-0000-0000-000000000001"
+ )
+ )
+ )
+})
+
+test_that("read_review_records ignores malformed records", {
+ review_file <- withr::local_tempfile(
+ lines = c(
+ '{"conversation":"conv1","exchange":1.9,"action":"flag"}',
+ '{"conversation":"conv1","exchange":1,"action":"flag"}'
+ )
+ )
+
+ expect_snapshot(
+ records <- read_review_records(review_file),
+ transform = \(x) gsub(review_file, "", x, fixed = TRUE)
+ )
+ expect_length(records, 1)
+})
diff --git a/tests/testthat/test-trajectory-review.R b/tests/testthat/test-trajectory-review.R
new file mode 100644
index 0000000..7bed3e3
--- /dev/null
+++ b/tests/testthat/test-trajectory-review.R
@@ -0,0 +1,663 @@
+test_tool_turns <- function(name, id = "c1") {
+ request <- ellmer::ContentToolRequest(
+ id = id,
+ name = name,
+ arguments = list()
+ )
+ list(
+ ellmer::AssistantTurn(list(request)),
+ ellmer::UserTurn(list(ellmer::ContentToolResult(
+ value = "ok",
+ request = request
+ )))
+ )
+}
+
+test_that("exchange_provenance derives tags from tool calls and citations", {
+ measure <- c(
+ list(ellmer::UserTurn("How many orders?")),
+ test_tool_turns("call_measure"),
+ list(ellmer::AssistantTurn("6 orders."))
+ )
+ expect_equal(exchange_provenance(measure)$tag, "A")
+
+ uncited <- c(
+ list(ellmer::UserTurn("Total revenue?")),
+ test_tool_turns("run_sql"),
+ list(ellmer::AssistantTurn("5650."))
+ )
+ expect_equal(exchange_provenance(uncited)$tag, "C")
+
+ cited <- c(
+ list(ellmer::UserTurn("Total revenue?")),
+ test_tool_turns("run_sql"),
+ list(ellmer::AssistantTurn(
+ "5650.\n\nRevenue excludes tax."
+ ))
+ )
+ expect_equal(exchange_provenance(cited)$tag, "B")
+
+ mixed <- c(
+ list(ellmer::UserTurn("Total revenue?")),
+ test_tool_turns("call_measure", id = "c1"),
+ test_tool_turns("run_sql", id = "c2"),
+ list(ellmer::AssistantTurn(
+ "5650. Revenue excludes tax."
+ ))
+ )
+ expect_equal(exchange_provenance(mixed)$tag, "B")
+
+ untagged <- c(
+ list(ellmer::UserTurn("What does revenue mean?")),
+ test_tool_turns("search_context"),
+ list(ellmer::AssistantTurn("Revenue excludes tax."))
+ )
+ expect_true(is.na(exchange_provenance(untagged)$tag))
+})
+
+test_that("tool names survive the OTLP round trip and drive derivation", {
+ input <- paste0(
+ '[{"role":"user","parts":[{"type":"text","content":"Total revenue?"}]},',
+ '{"role":"assistant","parts":[{"type":"tool_call","id":"c1",',
+ '"name":"run_sql","arguments":{"sql":"select 1"}}]},',
+ '{"role":"tool","parts":[{"type":"tool_call_response","id":"c1",',
+ '"response":"5650"}]}]'
+ )
+ output <- paste0(
+ '[{"role":"assistant","parts":[{"type":"text",',
+ '"content":"5650.\\n\\nRevenue excludes tax."}]}]'
+ )
+ spans <- parse_otlp_lines(otlp_test_line(list(
+ chat_test_span("t1", "s1", input_messages = input, output_messages = output)
+ )))
+
+ turns <- build_trajectories(spans)[[1]]
+ provenance <- lapply(split_exchanges(turns), exchange_provenance)
+
+ expect_length(provenance, 1)
+ expect_equal(provenance[[1]]$tag, "B")
+})
+
+test_that("split_exchanges opens at plain user turns only", {
+ turns <- c(
+ list(
+ ellmer::SystemTurn("Be helpful."),
+ ellmer::UserTurn("How many orders?")
+ ),
+ test_tool_turns("call_measure"),
+ list(
+ ellmer::AssistantTurn("6 orders."),
+ ellmer::UserTurn("Thanks!")
+ )
+ )
+
+ exchanges <- split_exchanges(turns)
+
+ expect_length(exchanges, 2)
+ expect_length(exchanges[[1]], 4)
+ expect_equal(exchanges[[1]][[1]]@text, "How many orders?")
+ expect_length(exchanges[[2]], 1)
+})
+
+test_that("summarize_trajectories describes each conversation", {
+ active <- c(
+ list(ellmer::UserTurn("How many\norders came in last week?")),
+ test_tool_turns("call_measure"),
+ list(
+ ellmer::AssistantTurn("6 orders."),
+ ellmer::UserTurn("Total revenue?")
+ ),
+ test_tool_turns("run_sql", id = "c2"),
+ list(ellmer::AssistantTurn("5650."))
+ )
+ attr(active, "last_active") <- as.POSIXct("2026-07-22 14:30:00")
+ trajectories <- list(
+ conv1 = active,
+ conv2 = list(
+ ellmer::UserTurn("What does revenue mean?"),
+ ellmer::AssistantTurn("Revenue excludes tax.")
+ )
+ )
+
+ summary <- summarize_trajectories(trajectories)
+
+ expect_length(summary, 2)
+ expect_equal(summary[[1]]$id, "conv1")
+ expect_equal(summary[[1]]$snippet, "How many orders came in last week?")
+ expect_equal(summary[[1]]$n_user_turns, 2)
+ expect_equal(summary[[1]]$tags, c("A", "C"))
+ expect_equal(summary[[1]]$last_active, as.POSIXct("2026-07-22 14:30:00"))
+ expect_equal(summary[[2]]$tags, NA_character_)
+ expect_true(is.na(summary[[2]]$last_active))
+})
+
+test_that("hit_rate counts exchange tags across conversations", {
+ rate <- hit_rate(list(c("A", "C"), "B", NA_character_))
+
+ expect_equal(rate$n, 4)
+ expect_equal(rate$counts, c(A = 1, B = 1, C = 1, none = 1))
+})
+
+test_that("trajectory_transcript merges each exchange into chat messages", {
+ skip_if_not_installed("shiny")
+ skip_if_not_installed("shinychat")
+ skip_if_not_installed("htmltools")
+
+ turns <- c(
+ list(ellmer::UserTurn("How many orders?")),
+ test_tool_turns("call_measure"),
+ list(
+ ellmer::AssistantTurn("6 orders."),
+ ellmer::UserTurn("Total revenue?")
+ ),
+ test_tool_turns("run_sql", id = "c2"),
+ list(ellmer::AssistantTurn(
+ "5650.\n\nRevenue excludes tax."
+ ))
+ )
+
+ transcript <- trajectory_transcript(turns)
+
+ expect_equal(
+ vapply(transcript$messages, function(m) m$role, character(1)),
+ c("user", "assistant", "user", "assistant")
+ )
+ expect_equal(
+ vapply(transcript$messages, function(m) m$exchange, integer(1)),
+ c(1L, 1L, 2L, 2L)
+ )
+ expect_equal(transcript$count, 2)
+
+ answer <- transcript$messages[[2]]$content
+ expect_length(answer, 2)
+ expect_s3_class(answer[[1]], "shinychat_tool_card")
+ expect_equal(answer[[2]], "6 orders.")
+
+ expect_length(transcript$pills, 2)
+ expect_match(transcript$pills[[1]]$html, "commons-answer-pill-trusted")
+ expect_equal(transcript$pills[[1]]$indexFromEnd, 1)
+ expect_equal(as.character(transcript$pills[[2]]$html), "")
+ expect_equal(
+ transcript$pills[[2]]$citations,
+ list(list(
+ verified = TRUE,
+ reason = NULL,
+ quote = "Revenue excludes tax.",
+ label = "unverified"
+ ))
+ )
+ expect_equal(transcript$pills[[2]]$indexFromEnd, 0)
+
+ html <- as.character(commons_ui("transcript", messages = transcript$messages))
+ expect_match(
+ html,
+ 'data-role="user" content="How many orders?"',
+ fixed = TRUE
+ )
+ expect_match(html, 'data-role="assistant"', fixed = TRUE)
+})
+
+test_that("reconstructed tool results wear the commons display again", {
+ skip_if_not_installed("shinychat")
+ skip_if_not_installed("htmltools")
+
+ display <- viewer_tool_display(
+ ellmer::ContentToolRequest(
+ id = "c1",
+ name = "run_sql",
+ arguments = list(sql = "select 1")
+ ),
+ value = "| 1 |"
+ )
+ expect_equal(display$title, "Ran SQL")
+ expect_false(display$show_request)
+ expect_equal(display$markdown, "```sql\nselect 1\n```\n\n| 1 |")
+
+ measure <- viewer_tool_display(ellmer::ContentToolRequest(
+ id = "c2",
+ name = "call_measure",
+ arguments = list(name = "biodiversity_by_site", arguments = "{}")
+ ))
+ expect_equal(measure$title, "Measure: biodiversity by site")
+
+ described <- viewer_tool_display(ellmer::ContentToolRequest(
+ id = "c3",
+ name = "describe_table",
+ arguments = list(table = "