Add schema-driven content validation: database registry, column enums, cross-file keys

Extends check_worksheet() with three declarative rules, setting the stage
for progressively richer schema validation (full column schema deferred
to the v4 refactor, where this merges into the recodeflow schema layer):

- Database-token registry (inst/metadata/schemas/core/database_registry.yaml,
  32 valid identifiers): every databaseStart token is validated against
  the registry, so typo identifiers fail at PR time instead of becoming
  silent dead rows. Adding a new cycle now requires a deliberate,
  reviewable registry entry.
- Controlled vocabularies (column_enums in the worksheet schemas):
  typeStart (cat/cont/N/A) and typeEnd (cat/cont) in variable_details,
  variableType (Categorical/Continuous) in variables.
- Cross-file key integrity (check_cross_file_keys()): every
  variable_details entry must have a variables.csv row.

Registry naming follows the recodeflow database-metadata draft for a
clean v4 merge. Fixes one pre-existing worksheet cell surfaced by the
enum rule (HWTGCOR_der Func:: row had an empty typeStart; now N/A per
convention) and updates test fixtures that used never-valid values
(variableType 'cont', bare 'cchs' and invented 'cchs2013_p' tokens).

Full checker green on the worksheets (all five rule groups); suite at
836 passing, 0 failures. Relates to CEP-017 Track 2 and CEP-018.

Author: DougManuel

NAMESPACE

@@ -75,6 +75,7 @@ export(categorize_diet_score)
 export(categorize_energy_exp)
 export(categorize_immigration)
 export(categorize_pct_time)
+export(check_cross_file_keys)
 export(check_recode_blocks)
 export(check_worksheet)
 export(clean_variables)
@@ -109,6 +110,7 @@ export(has_cached_pattern)
 export(if_else2)
 export(is_equal)
 export(list_subjects)
+export(load_database_registry)
 export(load_schema)
 export(load_worksheet_metadata)
 export(load_worksheet_schemas)

R/check-worksheet.R

@@ -124,18 +124,144 @@ check_worksheet <- function(
   excessive_quote_errors <- .check_excessive_quoting(
     raw_lines, list(file_path = file_path, file_type = file_type))
 
+  # Content checks driven by the schema: controlled vocabularies and the
+  # database-token registry (see inst/metadata/schemas/core/)
+  enum_errors <- if (!is.null(schema$column_enums)) {
+    .check_column_enums(
+      csv_result$data, schema$column_enums,
+      list(file_path = file_path, file_type = file_type)
+    )
+  } else {
+    list()
+  }
+
+  database_token_errors <- if (!is.null(schema$database_registry_file)) {
+    .check_database_tokens(
+      csv_result$data,
+      load_database_registry(schema$database_registry_file),
+      list(file_path = file_path, file_type = file_type)
+    )
+  } else {
+    list()
+  }
+
   all_errors <- purrr::flatten(list(
     line_ending_errors,
     excessive_quote_errors,
     column_order_errors,
     row_sorting_errors,
     empty_column_errors,
-    extra_column_errors
+    extra_column_errors,
+    enum_errors,
+    database_token_errors
   ))
 
   return(all_errors)
 }
 
+#' Check controlled-vocabulary columns against schema enums
+#'
+#' For every column declared under `column_enums` in the worksheet schema,
+#' flags cell values outside the declared vocabulary. Empty cells are
+#' violations too: fields that do not apply must carry the explicit "N/A"
+#' marker where the vocabulary includes it.
+#'
+#' @param csv_data Data frame of the worksheet
+#' @param column_enums Named list: column name -> character vector of
+#'   allowed values (from the schema YAML)
+#' @param error_ctx Named list with file_type and file_path
+#'
+#' @return List of enum violation errors (one per distinct offending value
+#'   per column, with the affected row numbers)
+.check_column_enums <- function(csv_data, column_enums, error_ctx) {
+  errors <- list()
+
+  for (column_name in names(column_enums)) {
+    if (!column_name %in% colnames(csv_data)) next
+    allowed <- as.character(column_enums[[column_name]])
+    values <- trimws(as.character(csv_data[[column_name]]))
+    values[is.na(values)] <- ""
+
+    bad <- !(values %in% allowed)
+    if (!any(bad)) next
+
+    for (offending in unique(values[bad])) {
+      rows <- which(bad & values == offending) + 1  # +1 for the header line
+      shown <- paste(utils::head(rows, 5), collapse = ", ")
+      if (length(rows) > 5) shown <- paste0(shown, ", ...")
+      errors[[length(errors) + 1]] <- list(
+        error_type = "invalid_enum_value",
+        file_type = error_ctx$file_type,
+        file_path = error_ctx$file_path,
+        column_name = column_name,
+        value = offending,
+        row_nums = rows,
+        message = glue::glue(
+          "Error in {.pretty_print_file_type(error_ctx$file_type)} at ",
+          "{error_ctx$file_path}. Column \"{column_name}\" has value ",
+          "\"{offending}\" outside its vocabulary ",
+          "({paste(allowed, collapse = ', ')}) on line(s) {shown}."
+        )
+      )
+    }
+  }
+
+  errors
+}
+
+#' Check databaseStart tokens against the database registry
+#'
+#' Splits every databaseStart cell on commas and flags tokens that are not
+#' in the registry of valid CCHS database identifiers. This catches typo
+#' identifiers (e.g. a missing underscore) that would otherwise become
+#' silent dead rows, because the engine matches databases by string.
+#'
+#' @param csv_data Data frame of the worksheet
+#' @param valid_databases Character vector from load_database_registry()
+#' @param error_ctx Named list with file_type and file_path
+#'
+#' @return List of invalid-token errors (one per distinct bad token, with
+#'   the affected row numbers)
+.check_database_tokens <- function(csv_data, valid_databases, error_ctx) {
+  if (!"databaseStart" %in% colnames(csv_data)) return(list())
+
+  cells <- as.character(csv_data$databaseStart)
+  errors <- list()
+  bad_rows <- list()
+
+  for (i in seq_along(cells)) {
+    cell <- cells[i]
+    if (is.na(cell) || trimws(cell) %in% c("", "N/A")) next
+    tokens <- trimws(unlist(strsplit(cell, ",", fixed = TRUE)))
+    tokens <- tokens[nzchar(tokens)]
+    for (token in tokens[!(tokens %in% valid_databases)]) {
+      bad_rows[[token]] <- c(bad_rows[[token]], i + 1)  # +1 for header line
+    }
+  }
+
+  for (token in names(bad_rows)) {
+    rows <- unique(bad_rows[[token]])
+    shown <- paste(utils::head(rows, 5), collapse = ", ")
+    if (length(rows) > 5) shown <- paste0(shown, ", ...")
+    errors[[length(errors) + 1]] <- list(
+      error_type = "invalid_database_token",
+      file_type = error_ctx$file_type,
+      file_path = error_ctx$file_path,
+      token = token,
+      row_nums = rows,
+      message = glue::glue(
+        "Error in {.pretty_print_file_type(error_ctx$file_type)} at ",
+        "{error_ctx$file_path}. databaseStart token \"{token}\" is not in ",
+        "the database registry ",
+        "(inst/metadata/schemas/core/database_registry.yaml) on line(s) ",
+        "{shown}. Fix the token, or add the new database to the registry."
+      )
+    )
+  }
+
+  errors
+}
+
 #' Check whether a worksheet has the correct line endings
 #'
 #' Uses vectorised grep on raw lines for performance. The raw file is read
@@ -664,3 +790,78 @@ check_recode_blocks <- function(file_path) {
     return("Variable details sheet")
   }
 }
+
+#' Check cross-file key integrity between the two worksheets
+#'
+#' Verifies that every variable in variable_details.csv has a corresponding
+#' row in variables.csv (the foreign-key relationship between the two
+#' worksheets). A variable_details entry without a variables.csv row has no
+#' harmonized-variable metadata (labels, subject, type) and indicates either
+#' a missing variables.csv row or a typo in the variable name.
+#'
+#' @param variables_path Path to variables.csv
+#' @param variable_details_path Path to variable_details.csv
+#'
+#' @return A list of errors found. Each error is a named list with
+#'   error_type "orphaned_variable_details" and the affected variable name.
+#'
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' check_cross_file_keys(
+#'   "inst/extdata/variables.csv",
+#'   "inst/extdata/variable_details.csv"
+#' )
+#' }
+check_cross_file_keys <- function(variables_path, variable_details_path) {
+  for (p in c(variables_path, variable_details_path)) {
+    if (!file.exists(p)) {
+      file_type <- if (identical(p, variables_path)) "variables" else "variable_details"
+      return(list(.create_file_not_found_error(file_type, p)))
+    }
+  }
+
+  vs <- tryCatch(
+    read.csv(variables_path, stringsAsFactors = FALSE, check.names = FALSE),
+    error = function(e) NULL
+  )
+  vd <- tryCatch(
+    read.csv(variable_details_path, stringsAsFactors = FALSE,
+             check.names = FALSE),
+    error = function(e) NULL
+  )
+  if (is.null(vs)) {
+    return(list(.create_invalid_csv_error("variables", variables_path,
+                                          "Unable to parse CSV")))
+  }
+  if (is.null(vd)) {
+    return(list(.create_invalid_csv_error(
+      "variable_details", variable_details_path, "Unable to parse CSV")))
+  }
+  if (!"variable" %in% names(vs) || !"variable" %in% names(vd)) {
+    return(list())  # column-order checks report the structural problem
+  }
+
+  known <- unique(trimws(vs$variable))
+  vd_vars <- trimws(vd$variable)
+  orphaned <- sort(unique(vd_vars[!(vd_vars %in% known) & nzchar(vd_vars)]))
+
+  purrr::map(orphaned, function(v) {
+    rows <- which(vd_vars == v) + 1
+    shown <- paste(utils::head(rows, 5), collapse = ", ")
+    if (length(rows) > 5) shown <- paste0(shown, ", ...")
+    list(
+      error_type = "orphaned_variable_details",
+      file_type = "variable_details",
+      file_path = variable_details_path,
+      variable = v,
+      row_nums = rows,
+      message = glue::glue(
+        "Variable \"{v}\" has rows in variable_details.csv (line(s) ",
+        "{shown}) but no row in variables.csv. Add the variables.csv row ",
+        "or fix the variable name."
+      )
+    )
+  })
+}

R/load-schema.R

@@ -41,3 +41,45 @@ load_schema <- function(file_type) {
     }
   )
 }
+
+#' Load the database-token registry
+#'
+#' @description Loads the registry of valid CCHS database identifiers used to
+#'   validate databaseStart tokens in the worksheets. The registry file name
+#'   comes from the worksheet schema's `database_registry_file` key.
+#'
+#' @param registry_file File name of the registry YAML (default
+#'   "database_registry.yaml"), resolved inside the package's
+#'   metadata/schemas/core directory.
+#'
+#' @return Character vector of valid database identifiers.
+#'
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' load_database_registry()
+#' }
+load_database_registry <- function(registry_file = "database_registry.yaml") {
+  registry_path <- system.file(
+    "metadata", "schemas", "core", registry_file,
+    package = "cchsflow",
+    mustWork = TRUE
+  )
+
+  registry <- tryCatch(
+    yaml::read_yaml(registry_path),
+    error = function(e) {
+      stop("Failed to load database registry. The file at ", registry_path,
+           " may be corrupted: ", e$message)
+    }
+  )
+
+  if (is.null(registry$valid_databases) ||
+      length(registry$valid_databases) == 0) {
+    stop("Database registry at ", registry_path,
+         " has no 'valid_databases' entries.")
+  }
+
+  as.character(registry$valid_databases)
+}

exec/check-worksheets.R

@@ -72,8 +72,20 @@ if (n_recode_block_errors > 0) {
 }
 cli_text("")
 
+cli_alert_info("Checking cross-file key integrity...")
+cross_file_errors <- check_cross_file_keys(
+  scope$variables_path, scope$variable_details_path)
+n_cross_file_errors <- length(cross_file_errors)
+if (n_cross_file_errors > 0) {
+  cli_alert_danger("Found {cli::no(n_cross_file_errors)} error{?s}")
+} else {
+  cli_alert_success("Found {cli::no(n_cross_file_errors)} error{?s}")
+}
+cli_text("")
+
 all_errors <- purrr::flatten(
-  list(variables_sheet_errors, variable_details_errors, recode_block_errors))
+  list(variables_sheet_errors, variable_details_errors, recode_block_errors,
+       cross_file_errors))
 
 # Report results
 n_all_errors <- length(all_errors)

inst/extdata/variable_details.csv

@@ -1637,7 +1637,7 @@ HWTGCOR,N/A,cont,"cchs2015_2016_p, cchs2017_2018_p, cchs2019_2020_p",[HWTDGCOR],
 HWTGCOR,N/A,cont,"cchs2015_2016_p, cchs2017_2018_p, cchs2019_2020_p",[HWTDGCOR],N/A,NA::a,N/A,not applicable,not applicable,kg/m2,999.96,Not applicable,Adjusted BMI,Adjusted BMI,
 HWTGCOR,N/A,cont,"cchs2015_2016_p, cchs2017_2018_p, cchs2019_2020_p",[HWTDGCOR],N/A,NA::b,N/A,missing,missing,kg/m2,"[999.97,999.99]",don't know (999.97); refusal (999.98); not stated (999.99),Adjusted BMI,Adjusted BMI,
 HWTGCOR,N/A,cont,"cchs2015_2016_p, cchs2017_2018_p, cchs2019_2020_p",[HWTDGCOR],N/A,NA::b,N/A,missing,missing,kg/m2,else,else,Adjusted BMI,Adjusted BMI,
-HWTGCOR_der,N/A,cont,"cchs2001_p, cchs2003_p, cchs2005_p, cchs2007_2008_p, cchs2009_2010_p, cchs2010_p, cchs2011_2012_p, cchs2012_p, cchs2013_2014_p, cchs2014_p, cchs2015_2016_p, cchs2017_2018_p, cchs2019_2020_p","DerivedVar::[DHH_SEX, HWTGHTM, HWTGWTK]",,Func::adjust_bmi,N/A,N/A,N/A,kg/m2,"[15,50]",Adjusted BMI valid range,Derived adjusted BMI,Derived adjusted BMI,
+HWTGCOR_der,N/A,cont,"cchs2001_p, cchs2003_p, cchs2005_p, cchs2007_2008_p, cchs2009_2010_p, cchs2010_p, cchs2011_2012_p, cchs2012_p, cchs2013_2014_p, cchs2014_p, cchs2015_2016_p, cchs2017_2018_p, cchs2019_2020_p","DerivedVar::[DHH_SEX, HWTGHTM, HWTGWTK]",N/A,Func::adjust_bmi,N/A,N/A,N/A,kg/m2,"[15,50]",Adjusted BMI valid range,Derived adjusted BMI,Derived adjusted BMI,
 HWTGCOR_der,N/A,cont,"cchs2001_p, cchs2003_p, cchs2005_p, cchs2007_2008_p, cchs2009_2010_p, cchs2010_p, cchs2011_2012_p, cchs2012_p, cchs2013_2014_p, cchs2014_p, cchs2015_2016_p, cchs2017_2018_p, cchs2019_2020_p","DerivedVar::[DHH_SEX, HWTGHTM, HWTGWTK]",N/A,NA::a,N/A,not applicable,not applicable,kg/m2,N/A,not applicable,Derived adjusted BMI,Derived adjusted BMI,
 HWTGCOR_der,N/A,cont,"cchs2001_p, cchs2003_p, cchs2005_p, cchs2007_2008_p, cchs2009_2010_p, cchs2010_p, cchs2011_2012_p, cchs2012_p, cchs2013_2014_p, cchs2014_p, cchs2015_2016_p, cchs2017_2018_p, cchs2019_2020_p","DerivedVar::[DHH_SEX, HWTGHTM, HWTGWTK]",N/A,NA::b,N/A,missing,missing,kg/m2,N/A,missing,Derived adjusted BMI,Derived adjusted BMI,
 HWTGHTM,N/A,cont,"cchs2001_p, cchs2003_p","cchs2001_p::HWTAGHT, cchs2003_p::HWTCGHT",cat,1.118,N/A,Height,converted height (3'8 IN - 44 inches),meters,1,3'8 IN - 44 inches,Height,"Height (metres)/self-reported - (D,G)",

inst/metadata/schemas/core/database_registry.yaml

@@ -0,0 +1,48 @@
+schema_version: "1.0.0"
+schema_date: "2026-07-15"
+description: >
+  Registry of valid CCHS database identifiers for databaseStart tokens in
+  variables.csv and variable_details.csv. check_worksheet() validates every
+  databaseStart token against this list, so typos (e.g. a missing underscore)
+  fail at PR time instead of becoming silent dead rows. Adding support for a
+  new cycle requires adding its identifier here - a deliberate, reviewable act.
+  Naming follows the recodeflow database-metadata draft
+  (scope-docs/metadata-schema/database_metadata.yaml) so this registry can
+  merge into the recodeflow schema layer at the v4 refactor.
+
+# Canonical token pattern: cchs<YYYY>[_<YYYY>]_<p|m>
+#   _p = Public Use Microdata File (PUMF)
+#   _m = Master file (includes converted share/_s and ICES/_i identifiers)
+valid_databases:
+  - "cchs2001_p"
+  - "cchs2001_m"
+  - "cchs2003_p"
+  - "cchs2003_m"
+  - "cchs2005_p"
+  - "cchs2005_m"
+  - "cchs2007_2008_p"
+  - "cchs2007_2008_m"
+  - "cchs2009_2010_p"
+  - "cchs2009_2010_m"
+  - "cchs2009_m"
+  - "cchs2010_p"
+  - "cchs2010_m"
+  - "cchs2011_2012_p"
+  - "cchs2011_2012_m"
+  - "cchs2012_p"
+  - "cchs2012_m"
+  - "cchs2013_2014_p"
+  - "cchs2013_2014_m"
+  - "cchs2014_p"
+  - "cchs2014_m"
+  - "cchs2015_2016_p"
+  - "cchs2015_2016_m"
+  - "cchs2017_2018_p"
+  - "cchs2017_2018_m"
+  - "cchs2019_2020_p"
+  - "cchs2019_2020_m"
+  - "cchs2021_m"
+  - "cchs2022_p"
+  - "cchs2022_m"
+  - "cchs2023_p"
+  - "cchs2023_m"

inst/metadata/schemas/core/variable_details.yaml

@@ -17,3 +17,18 @@ expected_column_order:
   - "notes"
 
 id_column_name: "variable"
+
+# Controlled vocabularies - check_worksheet() flags any value outside these
+# lists. "N/A" marks rows where the field does not apply (DerivedVar and
+# Func:: rows). Extend deliberately.
+column_enums:
+  typeStart:
+    - "cat"
+    - "cont"
+    - "N/A"
+  typeEnd:
+    - "cat"
+    - "cont"
+
+# Registry of valid databaseStart tokens (shared with variables)
+database_registry_file: "database_registry.yaml"

inst/metadata/schemas/core/variables.yaml

@@ -11,3 +11,13 @@ expected_column_order:
   - "description"
 
 id_column_name: "variable"
+
+# Controlled vocabularies - check_worksheet() flags any value outside these
+# lists. Extend deliberately; keep in sync with worksheet conventions.
+column_enums:
+  variableType:
+    - "Categorical"
+    - "Continuous"
+
+# Registry of valid databaseStart tokens (shared with variable_details)
+database_registry_file: "database_registry.yaml"