build-cran-binaries/local/failing-builds-report.R

#!/usr/bin/env Rscript

# Read-only failure triage over the `single_builds` metadata table (issue #115,
# steps 1 + 2): query every recorded build failure, group by a normalised error
# fingerprint, classify each bucket against the known signature set, and print a
# triaged report with a pre-filled `registry.json` suggestion where a *known,
# safe* fix lever applies. Novel source diffs and unknown signatures are routed
# to human triage; this script never writes to the DB or the registry.
#
# Usage:
#   PGPASS=... Rscript local/failing-builds-report.R [--platform P] [--arch A]
#                                                     [--json out.json] [--min N]
#
#   --platform / --arch   restrict to one platform/arch (default: all)
#   --min N               only show fingerprint groups with >= N failing builds
#   --json PATH           also write the machine-readable report to PATH
#
# Env fallbacks: PLATFORM, ARCH (same effect as the flags).

options(error = function() {
  cat("ERROR:", geterrmessage(), "\n", file = stdout())
  q(status = 1)
})

suppressPackageStartupMessages({
  library(DBI, quietly = TRUE)
  library(RPostgres, quietly = TRUE)
  library(jsonlite, quietly = TRUE)
})

# Locate helpers relative to this script so it runs from any CWD.
script_path <- local({
  a <- commandArgs(trailingOnly = FALSE)
  f <- sub("^--file=", "", a[grepl("^--file=", a)])
  if (length(f) == 1L && nzchar(f)) normalizePath(f) else NA_character_
})
script_dir <- if (is.na(script_path)) "local" else dirname(script_path)
source(file.path(script_dir, "failing-builds-classify.R"))

# ---------------------------------------------------------------------------
# Arguments
# ---------------------------------------------------------------------------
args <- commandArgs(trailingOnly = TRUE)
opt_val <- function(flag, default = NA_character_) {
  i <- match(flag, args)
  if (!is.na(i) && i < length(args)) args[[i + 1L]] else default
}
platform <- opt_val("--platform", Sys.getenv("PLATFORM", ""))
arch <- opt_val("--arch", Sys.getenv("ARCH", ""))
json_out <- opt_val("--json")
min_count <- suppressWarnings(as.integer(opt_val("--min", "1")))
if (is.na(min_count)) {
  min_count <- 1L
}

if (nchar(Sys.getenv("PGPASS")) == 0L) {
  stop(
    "PGPASS env var is not set; a DB password is required (no read-only role exists)."
  )
}

# ---------------------------------------------------------------------------
# Query failing builds
# ---------------------------------------------------------------------------
con <- DBI::dbConnect(
  RPostgres::Postgres(),
  dbname = "build_metadata",
  host = "r-binaries.devxy.io",
  port = 15432,
  user = "rpkgs",
  password = Sys.getenv("PGPASS"),
  sslmode = "require"
)
on.exit(DBI::dbDisconnect(con), add = TRUE)

where <- "error_occurred = TRUE AND removed = FALSE"
params <- list()
if (nzchar(platform)) {
  where <- paste0(where, " AND platform = $", length(params) + 1L)
  params <- c(params, platform)
}
if (nzchar(arch)) {
  where <- paste0(where, " AND arch = $", length(params) + 1L)
  params <- c(params, arch)
}
failures <- DBI::dbGetQuery(
  con,
  paste0(
    "SELECT name, tag, platform, arch, r_version, timestamp, error_text ",
    "FROM single_builds WHERE ",
    where
  ),
  params = if (length(params) > 0L) params else NULL
)

cat(sprintf(
  "Queried single_builds: %d failing builds%s\n",
  nrow(failures),
  if (nzchar(platform) || nzchar(arch)) {
    sprintf(
      " (filter: platform=%s arch=%s)",
      if (nzchar(platform)) platform else "*",
      if (nzchar(arch)) arch else "*"
    )
  } else {
    ""
  }
))
if (nrow(failures) == 0L) {
  cat("No failing builds to triage.\n")
  q(status = 0)
}

# ---------------------------------------------------------------------------
# Packages that already carry a registry entry (so we don't re-propose)
# ---------------------------------------------------------------------------
`%||%` <- function(a, b) if (is.null(a)) b else a
registry_file <- file.path(script_dir, "patches", "registry.json")
registered_pkgs <- character(0L)
if (file.exists(registry_file)) {
  reg <- jsonlite::fromJSON(registry_file, simplifyVector = FALSE)
  registered_pkgs <- unique(vapply(
    reg,
    function(e) as.character(e$package %||% ""),
    character(1L)
  ))
}

# ---------------------------------------------------------------------------
# Classify + group (shared logic), then render
# ---------------------------------------------------------------------------
report <- build_triage_report(failures, registered_pkgs)
report <- Filter(function(r) r$build_count >= min_count, report)

cat(sprintf(
  "\n%d distinct failure group(s); showing groups with >= %d build(s).\n",
  length(report),
  min_count
))
cat(strrep("=", 78L), "\n", sep = "")

for (r in report) {
  status <- if (!r$matched) {
    "HUMAN TRIAGE (unknown signature)"
  } else if (!r$auto_proposable) {
    sprintf("HUMAN TRIAGE (classified: %s; novel source diff)", r$signature)
  } else {
    sprintf("AUTO-PROPOSABLE (%s, %s confidence)", r$signature, r$confidence)
  }

  cat(sprintf(
    "\n[%d builds | %d pkgs | %s] %s\n",
    r$build_count,
    length(r$packages),
    toString(r$platforms),
    status
  ))
  cat(sprintf(
    "  fingerprint: %s%s\n",
    r$fingerprint,
    if (r$fingerprint_variants > 1L) {
      sprintf(" (+%d fingerprint variant(s))", r$fingerprint_variants - 1L)
    } else {
      ""
    }
  ))
  if (r$matched) {
    cat(sprintf("  signature  : %s\n", r$label))
    cat(sprintf("  suggested  : [%s] %s\n", r$tier, r$suggested_fix))
  }
  cat(sprintf("  arch       : %s\n", toString(r$arches)))
  cat(sprintf(
    "  packages   : %s\n",
    paste(
      vapply(
        r$packages,
        function(p) {
          if (p %in% registered_pkgs) paste0(p, " (has entry)") else p
        },
        character(1L)
      ),
      collapse = ", "
    )
  ))

  if (!is.null(r$proposed_entries)) {
    cat("  proposed registry entries (validate + trial-build before merge):\n")
    for (entry in r$proposed_entries) {
      j <- jsonlite::toJSON(
        entry,
        auto_unbox = TRUE,
        pretty = TRUE,
        null = "null"
      )
      cat(paste0("    ", gsub("\n", "\n    ", j)), "\n", sep = "")
    }
  } else if (r$auto_proposable && length(r$blocked_packages) == 0L) {
    cat("  (all affected packages already have a registry entry)\n")
  }
  # Blocked packages are shown even when the group also has proposals.
  if (length(r$blocked_packages) > 0L) {
    cat(sprintf(
      "  (blocked on %s -- %d package(s) fail because that dependency does not build; fix %s, do not patch each dependent)\n",
      toString(r$blocked_on),
      length(r$blocked_packages),
      toString(r$blocked_on)
    ))
  }
}

# ---------------------------------------------------------------------------
# Summary
# ---------------------------------------------------------------------------
matched <- Filter(function(r) r$matched, report)
auto <- Filter(function(r) r$auto_proposable, report)
cat("\n", strrep("=", 78L), "\n", sep = "")
cat(sprintf(
  "Summary: %d groups | %d classified | %d auto-proposable | %d for human triage\n",
  length(report),
  length(matched),
  length(auto),
  length(report) - length(matched)
))

if (!is.na(json_out)) {
  jsonlite::write_json(
    report,
    json_out,
    auto_unbox = TRUE,
    pretty = TRUE,
    null = "null"
  )
  cat(sprintf("Wrote machine-readable report to %s\n", json_out))
}