ontoref/adrs/adr-constraints.ncl

let _adr_id_format = std.contract.custom (
  fun label =>
    fun value =>
      if std.string.is_match "^adr-[0-9]{3}$" value then
        'Ok value
      else
        'Error {
          message = "ADR id must match 'adr-NNN' format (e.g. 'adr-001'), got: '%{value}'"
        }
) in

let _non_empty_constraints = std.contract.custom (
  fun label =>
    fun value =>
      if std.array.length value == 0 then
        'Error {
          message = "constraints must not be empty — an ADR with no constraints is passive documentation, not an active constraint"
        }
      else
        'Ok value
) in

let _non_empty_negative = std.contract.custom (
  fun label =>
    fun value =>
      if std.array.length value.negative == 0 then
        'Error {
          message = "consequences.negative must not be empty on id='%{value.id}' — an ADR with no negative consequences is incomplete"
        }
      else
        'Ok value
) in

let _requires_justification = std.contract.custom (
  fun label =>
    fun value =>
      if value.ontology_check.verdict == 'RequiresJustification
         && !(std.record.has_field "invariant_justification" value) then
        'Error {
          message = "ADR '%{value.id}': ontology_check.verdict = 'RequiresJustification but invariant_justification field is missing"
        }
      else
        'Ok value
) in

let _comma = ", " in

let _each_constraint_has_check = std.contract.custom (
  fun label =>
  fun value =>
    let violations = std.array.filter (fun c =>
      !(std.record.has_field "check" c) && !(std.record.has_field "check_hint" c)
    ) value in
    if std.array.length violations == 0 then
      'Ok value
    else
      let ids = std.array.map (fun c => c.id) violations in
      'Error {
        message = "Constraints missing both 'check' and 'check_hint': %{std.string.join _comma ids}"
      }
) in

# Validates that each constraint's typed 'check' record has the required
# fields for its declared tag. Returns the first validation error found.
let _each_check_well_formed = std.contract.custom (
  fun label =>
  fun constraints =>
    # Returns "" on valid, error message on invalid.
    let validate_check = fun c =>
      if !(std.record.has_field "check" c) then
        ""
      else
        let chk = c.check in
        let tag = chk.tag in
        let needs = fun field => !(std.record.has_field field chk) in
        if tag == 'Cargo then
          if needs "crate" || needs "forbidden_deps" then
            "Constraint '%{c.id}': Cargo check requires 'crate' and 'forbidden_deps'"
          else ""
        else if tag == 'Grep then
          if needs "pattern" || needs "paths" || needs "must_be_empty" then
            "Constraint '%{c.id}': Grep check requires 'pattern', 'paths', 'must_be_empty'"
          else ""
        else if tag == 'NuCmd then
          if needs "cmd" || needs "expect_exit" then
            "Constraint '%{c.id}': NuCmd check requires 'cmd' and 'expect_exit'"
          else ""
        else if tag == 'ApiCall then
          if needs "endpoint" || needs "json_path" || needs "expected" then
            "Constraint '%{c.id}': ApiCall check requires 'endpoint', 'json_path', 'expected'"
          else ""
        else if tag == 'FileExists then
          if needs "path" || needs "present" then
            "Constraint '%{c.id}': FileExists check requires 'path' and 'present'"
          else ""
        else
          "Constraint '%{c.id}': unknown check tag '%{std.to_str tag}'"
    in
    let first_err = std.array.fold_left (fun acc c =>
      if acc != "" then acc else validate_check c
    ) "" constraints
    in
    if first_err == "" then 'Ok constraints
    else 'Error { message = first_err }
) in

{
  AdrIdFormat                    = _adr_id_format,
  NonEmptyConstraints            = _non_empty_constraints,
  NonEmptyNegativeConsequences   = _non_empty_negative,
  RequiresJustificationWhenRisky = _requires_justification,
  EachConstraintHasCheck         = _each_constraint_has_check,
  EachCheckWellFormed            = _each_check_well_formed,
}