build-cran-binaries/local/proposal-tracking-lib.R

# Pure, IO-free helpers for the proposal feedback loop (issue #115, step 4):
# a small ledger of what the classifier proposed, plus metrics derived from the
# live triage report and the registry (signature hit rate, proposed-vs-merged,
# retirement candidates).
#
# Kept free of DB/HTTP/clock so it can be sourced by the proposer, the tracker
# entrypoint, and the unit tests. Timestamps are passed in by callers.

# Stable identity of a ledger record: one proposal per (package, signature).
ledger_key <- function(record) {
  paste0(
    if (is.null(record$package)) "?" else record$package,
    "|",
    if (is.null(record$signature)) "?" else record$signature
  )
}

# Merge freshly-generated proposals into an existing ledger without clobbering
# history: a record whose (package, signature) already exists is left as-is
# (its status/PR/issue are preserved); genuinely new proposals are appended.
# Returns the combined list. Pure: callers stamp `proposed_at` before passing.
merge_ledger <- function(existing, new_records) {
  if (is.null(existing)) {
    existing <- list()
  }
  seen <- vapply(existing, ledger_key, character(1L))
  out <- existing
  for (rec in new_records) {
    if (!(ledger_key(rec) %in% seen)) {
      out[[length(out) + 1L]] <- rec
      seen <- c(seen, ledger_key(rec))
    }
  }
  out
}

# Per-signature hit rate from a triage report (list of group records from
# build_triage_report) crossed with the set of already-registered packages.
# For each *matched* signature: how many failing builds/packages it explains,
# and how many of those packages are already addressed by a registry entry.
signature_hit_rate <- function(report, registered_pkgs = character(0L)) {
  matched <- Filter(function(g) isTRUE(g$matched), report)
  by_sig <- split(
    matched,
    vapply(matched, function(g) g$signature, character(1L))
  )
  lapply(names(by_sig), function(sig) {
    grps <- by_sig[[sig]]
    pkgs <- unique(unlist(lapply(grps, function(g) g$packages)))
    addressed <- intersect(pkgs, registered_pkgs)
    list(
      signature = sig,
      builds = sum(vapply(grps, function(g) g$build_count, integer(1L))),
      packages = length(pkgs),
      addressed = length(addressed),
      open = length(setdiff(pkgs, registered_pkgs)),
      auto_proposable = any(vapply(
        grps,
        function(g) isTRUE(g$auto_proposable),
        logical(1L)
      ))
    )
  })
}

# Proposed-vs-merged: a ledger record counts as "merged" once its package
# appears in the registry. Returns per-record status plus a rollup.
proposed_vs_merged <- function(ledger, registered_pkgs = character(0L)) {
  if (is.null(ledger)) {
    ledger <- list()
  }
  rows <- lapply(ledger, function(rec) {
    merged <- !is.null(rec$package) && rec$package %in% registered_pkgs
    list(
      package = rec$package,
      signature = rec$signature,
      status = if (merged) "merged" else (rec$status %||% "proposed"),
      merged = merged
    )
  })
  list(
    records = rows,
    total = length(rows),
    merged = sum(vapply(rows, function(r) isTRUE(r$merged), logical(1L)))
  )
}

# Registry entries whose package no longer appears in any current failure are
# retirement candidates: the upstream cause was likely fixed, so the entry can
# be reviewed for removal. `failing_pkgs` is the set of currently-failing
# package names (from the live report).
retirement_candidates <- function(registry_entries, failing_pkgs) {
  if (is.null(registry_entries)) {
    registry_entries <- list()
  }
  keep <- Filter(
    function(e) !is.null(e$package) && !(e$package %in% failing_pkgs),
    registry_entries
  )
  vapply(keep, function(e) as.character(e$package), character(1L))
}

`%||%` <- function(a, b) if (is.null(a)) b else a