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, }