feat: cog_gov_search + cog_mirror + scope-aware verb behavior

Three pieces: 1. cog_gov_search: name/state/type search over canonical_fips_xwalk for resolving human-readable place names into canonical_govids. Accepts USPS abbrev ('FL') or FIPS int (12) for state; integer 0-3 or name ('state','county','city','township') for type. Types 4/5 emit an explanatory cli message and return an empty tibble (v0.1 corpus excludes them). USPS<->FIPS table hardcoded with 50 states + DC + territories; FIPS 66 = GU (not GA). 2. cog_mirror: downloads manifest-listed files to a local directory with SHA-256 idempotency (files with matching hash return status 'cached'). Supports HTTP and local-path fixture URLs. Round-trip test: mirror + re-open against the mirror + query Broward 2020 returns identical results. 3. Scope-aware verbs: .check_govids_in_scope() helper in session.R queries canonical_fips_xwalk for the requested govids, emits a cli_inform listing any missing ones, and records the found/missing sets under provenance$scope. Wired into cog_spending (and transitively into cog_revenue, cog_geographic_rollup, cog_peer_compare via their cog_spending calls). Also: dropped dbplyr from Imports (unused). Tests: +29 (22 search + 12 mirror - 5 refactored) / 159 total pass. devtools::check() now clean: 0E / 0W / 0N.
2026-04-24 11:38:32 -04:00
parent cc4d21ec82
commit 377eed1240
11 changed files with 522 additions and 6 deletions
@@ -0,0 +1,140 @@
+# R/mirror.R
+
+#' Mirror the published corpus to a local directory
+#'
+#' Downloads (or copies, for local-path fixture URLs) every file listed in
+#' the session's `manifest.json` into `dest`, preserving the relative path
+#' structure. Files already present with a matching SHA-256 hash are
+#' skipped unless `overwrite = TRUE`. The resulting directory can be
+#' pointed at via `options(uscogdata.url = paste0(dest, "/"))` for offline
+#' analysis.
+#'
+#' @param dest Destination directory. Created if missing.
+#' @param include Subset of `c("long", "metadata", "docs")` controlling
+#'   which manifest sections to mirror.
+#' @param overwrite If `TRUE`, re-copy even when the local SHA matches.
+#' @param progress If `TRUE`, show a cli progress bar.
+#' @return Invisibly, a tibble of `(path, sha256, size_bytes, status)`
+#'   rows where `status` is `"downloaded"` or `"cached"`.
+#' @export
+cog_mirror <- function(dest,
+                       include = c("long", "metadata", "docs"),
+                       overwrite = FALSE,
+                       progress = interactive()) {
+  if (!is.character(dest) || length(dest) != 1L) {
+    cli::cli_abort("`dest` must be a length-1 character path.")
+  }
+  include <- match.arg(include, several.ok = TRUE)
+  if (!dir.exists(dest)) dir.create(dest, recursive = TRUE)
+
+  .ensure_session()
+  url      <- .uscogdata_env$url
+  manifest <- .uscogdata_env$manifest
+  is_local <- .is_local_path(url)
+
+  .write_manifest_local(manifest, file.path(dest, "manifest.json"))
+
+  entries <- .collect_mirror_entries(manifest, include)
+  results <- vector("list", length(entries))
+  pb <- if (isTRUE(progress)) {
+    cli::cli_progress_bar("Mirroring", total = length(entries))
+  } else NULL
+
+  for (i in seq_along(entries)) {
+    e <- entries[[i]]
+    dest_path <- file.path(dest, e$path)
+    .ensure_parent_dir(dest_path)
+    status <- .mirror_one_file(
+      src_url   = paste0(url, e$path),
+      dest_path = dest_path,
+      expected_sha = e$sha256,
+      is_local  = is_local,
+      overwrite = overwrite
+    )
+    results[[i]] <- tibble::tibble(
+      path       = e$path,
+      sha256     = e$sha256 %||% NA_character_,
+      size_bytes = as.integer(file.info(dest_path)$size),
+      status     = status
+    )
+    if (!is.null(pb)) cli::cli_progress_update()
+  }
+  if ("docs" %in% include) {
+    .mirror_docs(url, dest, is_local, overwrite)
+  }
+  if (!is.null(pb)) cli::cli_progress_done()
+  invisible(dplyr::bind_rows(results))
+}
+
+#' @noRd
+.write_manifest_local <- function(manifest, path) {
+  writeLines(
+    jsonlite::toJSON(manifest, auto_unbox = TRUE, pretty = TRUE),
+    path
+  )
+}
+
+#' @noRd
+.collect_mirror_entries <- function(manifest, include) {
+  entries <- list()
+  if ("long" %in% include && length(manifest$files$long_partitions) > 0L) {
+    entries <- c(entries, manifest$files$long_partitions)
+  }
+  if ("metadata" %in% include && length(manifest$files$metadata) > 0L) {
+    entries <- c(entries, manifest$files$metadata)
+  }
+  entries
+}
+
+#' @noRd
+.ensure_parent_dir <- function(path) {
+  d <- dirname(path)
+  if (!dir.exists(d)) dir.create(d, recursive = TRUE)
+}
+
+#' @noRd
+.mirror_one_file <- function(src_url, dest_path, expected_sha,
+                             is_local, overwrite) {
+  if (!isTRUE(overwrite) && file.exists(dest_path) &&
+      !is.null(expected_sha) &&
+      digest::digest(dest_path, algo = "sha256", file = TRUE) == expected_sha) {
+    return("cached")
+  }
+  if (isTRUE(is_local)) {
+    # src_url was built as paste0(url, e$path); url ends in "/"
+    src <- src_url
+    if (!file.exists(src)) {
+      cli::cli_abort("Source file missing: {src}")
+    }
+    ok <- file.copy(src, dest_path, overwrite = TRUE)
+    if (!isTRUE(ok)) cli::cli_abort("file.copy failed: {src} -> {dest_path}")
+  } else {
+    resp <- httr2::request(src_url) |>
+      httr2::req_error(is_error = function(r) httr2::resp_status(r) >= 400) |>
+      httr2::req_perform()
+    writeBin(httr2::resp_body_raw(resp), dest_path)
+  }
+  "downloaded"
+}
+
+#' @noRd
+.mirror_docs <- function(url, dest, is_local, overwrite) {
+  docs <- c("README.md", "data_dictionary.md",
+            "series_breaks.md", "reader-specification.md")
+  for (doc in docs) {
+    src  <- paste0(url, "docs/", doc)
+    dst  <- file.path(dest, "docs", doc)
+    .ensure_parent_dir(dst)
+    if (isTRUE(is_local)) {
+      if (file.exists(src)) file.copy(src, dst, overwrite = TRUE)
+      # silently skip missing optional docs in local fixtures
+      next
+    }
+    try({
+      resp <- httr2::request(src) |>
+        httr2::req_error(is_error = function(r) httr2::resp_status(r) >= 400) |>
+        httr2::req_perform()
+      writeBin(httr2::resp_body_raw(resp), dst)
+    }, silent = TRUE)
+  }
+}
@@ -0,0 +1,122 @@
+# R/search.R
+
+#' Search for governments by name, state, and/or type
+#'
+#' Returns rows from `canonical_fips_xwalk` matching the supplied filters.
+#' Intended as the entry point users call to resolve a human-readable place
+#' name into one or more `canonical_govid` values before calling
+#' [cog_spending()] / [cog_revenue()] / etc.
+#'
+#' @param pattern Character regex matched case-insensitively against
+#'   `gov_name`. `NULL` (default) means no name filter.
+#' @param state Either a 2-letter USPS abbreviation (e.g. `"FL"`), a FIPS
+#'   integer (e.g. `12`), or `NULL`.
+#' @param type Government type: an integer in `0:3` or one of `"state"`,
+#'   `"county"`, `"city"`, `"township"`. Passing `4`, `5`,
+#'   `"special_district"`, or `"school_district"` emits an explanatory
+#'   message and returns an empty tibble (v0.1 corpus excludes those types).
+#' @return Tibble from `canonical_fips_xwalk` sorted by `population_acs`
+#'   descending (`NULL`s last).
+#' @export
+cog_gov_search <- function(pattern = NULL, state = NULL, type = NULL) {
+  if (!is.null(type) && .is_excluded_type(type)) {
+    cli::cli_inform(c(
+      i = "v0.1 covers gov_types 0-3 (state/county/city/township) only.",
+      i = "Types 4 (special districts) and 5 (school districts) are excluded; see vignette('coverage-scope')."
+    ))
+    return(.empty_xwalk_tibble())
+  }
+  con <- .ensure_session()
+
+  preds <- character(0)
+  if (!is.null(pattern)) {
+    if (!is.character(pattern) || length(pattern) != 1L) {
+      cli::cli_abort("`pattern` must be a length-1 character string.")
+    }
+    preds <- c(preds,
+               sprintf("regexp_matches(gov_name, %s, 'i')",
+                       .sql_lit_chr(pattern)))
+  }
+  if (!is.null(state)) {
+    st_fips <- .coerce_state_to_fips(state)
+    preds <- c(preds, sprintf("fips_state = %s", .sql_lit_chr(st_fips)))
+  }
+  if (!is.null(type)) {
+    int_type <- .coerce_type(type)
+    preds <- c(preds, sprintf("govs_type = %d", int_type))
+  }
+
+  where <- if (length(preds) == 0L) "" else paste("WHERE", paste(preds, collapse = " AND "))
+  sql <- paste(
+    "SELECT * FROM canonical_fips_xwalk",
+    where,
+    "ORDER BY population_acs DESC NULLS LAST"
+  )
+  tibble::as_tibble(DBI::dbGetQuery(con, sql))
+}
+
+#' @noRd
+.empty_xwalk_tibble <- function() {
+  tibble::tibble(
+    canonical_govid = character(0), gov_name = character(0),
+    govs_type = integer(0), type_label = character(0),
+    fips_state = character(0), fips_county = character(0),
+    fips_place = character(0), first_year = integer(0),
+    last_year = integer(0), population_acs = integer(0),
+    confidence = character(0)
+  )
+}
+
+#' @noRd
+.is_excluded_type <- function(type) {
+  excluded <- c("4", "5", "special_district", "school_district")
+  as.character(type) %in% excluded
+}
+
+#' @noRd
+.coerce_type <- function(type) {
+  if (is.numeric(type) ||
+      (is.character(type) && length(type) == 1L && grepl("^[0-9]+$", type))) {
+    n <- as.integer(type)
+    if (!n %in% 0:3) {
+      cli::cli_abort("type must be 0, 1, 2, or 3 (v0.1 scope).")
+    }
+    return(n)
+  }
+  map <- c(state = 0L, county = 1L, city = 2L, township = 3L)
+  key <- as.character(type)
+  if (!key %in% names(map)) cli::cli_abort("Unknown type: {type}.")
+  map[[key]]
+}
+
+#' @noRd
+.coerce_state_to_fips <- function(state) {
+  if (is.numeric(state) ||
+      (is.character(state) && length(state) == 1L && grepl("^[0-9]+$", state))) {
+    return(sprintf("%02d", as.integer(state)))
+  }
+  if (!is.character(state) || length(state) != 1L) {
+    cli::cli_abort("`state` must be a 2-letter USPS abbrev or a FIPS integer.")
+  }
+  fips <- .state_abbrev_to_fips[[toupper(state)]]
+  if (is.null(fips)) {
+    cli::cli_abort("Unknown state abbreviation: {state}.")
+  }
+  fips
+}
+
+# USPS state / territory abbreviation -> 2-digit FIPS code.
+# Includes 50 states + DC + territories. Note FIPS 66 = GU (not GA).
+#' @noRd
+.state_abbrev_to_fips <- c(
+  AL = "01", AK = "02", AZ = "04", AR = "05", CA = "06", CO = "08",
+  CT = "09", DE = "10", DC = "11", FL = "12", GA = "13", HI = "15",
+  ID = "16", IL = "17", IN = "18", IA = "19", KS = "20", KY = "21",
+  LA = "22", ME = "23", MD = "24", MA = "25", MI = "26", MN = "27",
+  MS = "28", MO = "29", MT = "30", NE = "31", NV = "32", NH = "33",
+  NJ = "34", NM = "35", NY = "36", NC = "37", ND = "38", OH = "39",
+  OK = "40", OR = "41", PA = "42", RI = "44", SC = "45", SD = "46",
+  TN = "47", TX = "48", UT = "49", VT = "50", VA = "51", WA = "53",
+  WV = "54", WI = "55", WY = "56",
+  AS = "60", GU = "66", MP = "69", PR = "72", VI = "78"
+)
@@ -33,6 +33,34 @@ cog_open <- function(url = .resolve_url(),
  .uscogdata_env$con
 }

+#' @noRd
+#' Check which of the supplied govids exist in canonical_fips_xwalk.
+#' Emits a cli message listing any missing ones alongside a pointer to the
+#' v0.1 scope explanation; returns both sets so callers can attach them to
+#' provenance.
+.check_govids_in_scope <- function(govids) {
+  govids <- unique(as.character(govids))
+  if (length(govids) == 0L) return(list(found = character(0), missing = character(0)))
+  con <- .ensure_session()
+  sql <- sprintf(
+    "SELECT canonical_govid FROM canonical_fips_xwalk WHERE canonical_govid IN (%s)",
+    .sql_lit_chr(govids)
+  )
+  found <- DBI::dbGetQuery(con, sql)$canonical_govid
+  missing <- setdiff(govids, found)
+  if (length(missing) > 0L) {
+    n <- length(missing)
+    shown <- paste(utils::head(missing, 5L), collapse = ", ")
+    more <- if (n > 5L) sprintf(" (+%d more)", n - 5L) else ""
+    cli::cli_inform(c(
+      i = sprintf("%d govid%s not found in v0.1 corpus: %s%s",
+                  n, if (n == 1L) "" else "s", shown, more),
+      i = "v0.1 covers gov_types 0-3 (state/county/city/township). Types 4/5 excluded; see vignette('coverage-scope')."
+    ))
+  }
+  list(found = found, missing = missing)
+}
+
 #' @noRd
 cog_close <- function() {
  if (!is.null(.uscogdata_env$con) && DBI::dbIsValid(.uscogdata_env$con)) {
@@ -49,6 +49,7 @@ cog_spending <- function(govid, years, category = NULL,
  if (!is.null(adjust_to_year)) adjust_to_year <- as.integer(adjust_to_year)

  con <- .ensure_session()
+  scope <- .check_govids_in_scope(govid)

  sql <- .build_verb_sql(view, subtype_col, govid, years, category)
  result <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
@@ -60,7 +61,7 @@ cog_spending <- function(govid, years, category = NULL,

  result$notes <- .notes_column(result)

-  attr(result, "provenance") <- .build_provenance(
+  prov <- .build_provenance(
    verb           = verb,
    call           = call,
    govid          = govid,
@@ -72,6 +73,9 @@ cog_spending <- function(govid, years, category = NULL,
    sql            = sql,
    subtype_col    = subtype_col
  )
+  prov$scope$govids_found   <- scope$found
+  prov$scope$govids_missing <- scope$missing
+  attr(result, "provenance") <- prov
  result
 }