okf-core 0.2.0.0 → 0.3.0.0

raw patch · 73 files changed

+6602/−1393 lines, 73 filesdep +network-uriPVP ok

version bump matches the API change (PVP)

Dependencies added: network-uri

API changes (from Hackage documentation)

Files

• CHANGELOG.md +125/−0
• dhall/Cardinality.dhall +5/−0
• dhall/FieldCondition.dhall +5/−0
• dhall/FieldFormat.dhall +7/−0
• dhall/FieldRule.dhall +29/−0
• dhall/FrontmatterRules.dhall +7/−3
• dhall/HandleReferenceRule.dhall +7/−0
• dhall/NestedFieldRule.dhall +17/−0
• dhall/NestedRules.dhall +6/−0
• dhall/Profile.dhall +7/−0
• dhall/TypeRule.dhall +8/−0
• dhall/defaults/FieldRule.dhall +24/−0
• dhall/defaults/FrontmatterRules.dhall +4/−1
• dhall/defaults/HandleReferenceRule.dhall +9/−0
• dhall/defaults/NestedFieldRule.dhall +18/−0
• dhall/defaults/NestedRules.dhall +11/−0
• dhall/defaults/Profile.dhall +3/−1
• dhall/defaults/TypeRule.dhall +5/−1
• dhall/mk/FieldRule.dhall +82/−0
• dhall/mk/NestedFieldRule.dhall +41/−0
• dhall/package.dhall +20/−0
• okf-core.cabal +16/−14
• src/Okf/Document.hs +22/−2
• src/Okf/Profile.hs +2203/−283
• src/Okf/Profile/Registry.hs +174/−0
• test/Main.hs +2561/−1084
• test/fixtures/profile-cardinality/bad.md +9/−0
• test/fixtures/profile-cardinality/good.md +9/−0
• test/fixtures/profile-cardinality/log.md +4/−0
• test/fixtures/profile-closed-fields/log.md +4/−0
• test/fixtures/profile-closed-fields/requests/typo.md +13/−0
• test/fixtures/profile-conditions/decisions/active.md +6/−0
• test/fixtures/profile-conditions/decisions/missing-status.md +5/−0
• test/fixtures/profile-conditions/decisions/superseded.md +6/−0
• test/fixtures/profile-conditions/log.md +5/−0
• test/fixtures/profile-conditions/postgresql/operational.md +6/−0
• test/fixtures/profile-conditions/postgresql/projection.md +6/−0
• test/fixtures/profile-conditions/reviews/mixed.md +10/−0
• test/fixtures/profile-document-references/decisions/duplicate-a.md +7/−0
• test/fixtures/profile-document-references/decisions/duplicate-b.md +7/−0
• test/fixtures/profile-document-references/decisions/source.md +18/−0
• test/fixtures/profile-document-references/decisions/target.md +7/−0
• test/fixtures/profile-formats/bad.md +13/−0
• test/fixtures/profile-formats/good.md +13/−0
• test/fixtures/profile-formats/log.md +4/−0
• test/fixtures/profile-nested-reviews-valid/good.md +20/−0
• test/fixtures/profile-nested-reviews-valid/log.md +5/−0
• test/fixtures/profile-nested-reviews/bad.md +25/−0
• test/fixtures/profile-nested-reviews/good.md +20/−0
• test/fixtures/profile-nested-reviews/log.md +5/−0
• test/fixtures/profile-type-frontmatter/log.md +4/−0
• test/fixtures/profile-type-frontmatter/open.md +8/−0
• test/fixtures/profile-type-frontmatter/owned.md +9/−0
• test/fixtures/profiles/cardinality-ep3.dhall +47/−0
• test/fixtures/profiles/cardinality.dhall +34/−0
• test/fixtures/profiles/closed-fields.dhall +42/−0
• test/fixtures/profiles/conditional-fields-ep2.dhall +117/−0
• test/fixtures/profiles/conditional-fields-invalid.dhall +25/−0
• test/fixtures/profiles/conditional-fields.dhall +110/−0
• test/fixtures/profiles/decisions.dhall +19/−2
• test/fixtures/profiles/described.dhall +24/−0
• test/fixtures/profiles/document-references-invalid.dhall +57/−0
• test/fixtures/profiles/document-references.dhall +45/−0
• test/fixtures/profiles/formats-ep4.dhall +52/−0
• test/fixtures/profiles/formats.dhall +44/−0
• test/fixtures/profiles/legacy-0.2.dhall +20/−0
• test/fixtures/profiles/nested-reviews-ep1.dhall +82/−0
• test/fixtures/profiles/nested-reviews.dhall +64/−0
• test/fixtures/profiles/postgresql.dhall +45/−2
• test/fixtures/profiles/type-aware-ep1.dhall +27/−0
• test/fixtures/profiles/type-frontmatter.dhall +35/−0
• test/fixtures/profiles/vocabulary-ep2.dhall +39/−0
• test/fixtures/registry/package.dhall +10/−0

@@ -7,6 +7,131 @@  ## [Unreleased] +## [0.3.0.0] - 2026-07-29++### Added++- Top-level document-reference policies through `HandleReferenceRule`, with a+  required local handle prefix, explicit external URI schemes, and configurable+  self-reference. Compilation validates and merges policies; bundle validation+  builds one valid-owner index and reports dangling, wrong-prefix, malformed,+  disallowed-external, and self references with indexed `FieldPath` values.+  Duplicate owners count as present and retain the existing duplicate-ID+  diagnostic. The complete condition-aware descriptor generation is frozen and+  upgrades with `reference = Nothing`.+- Same-scope conditional presence through `FieldCondition` and the defaulted+  `when` field on top-level and nested field rules. Compilation rejects empty,+  undeclared, non-scalar, open-vocabulary, self-referential, and unreachable+  predicates; validation evaluates required and strict-recommended clauses+  without cascading from invalid sources. The complete bounded-nested descriptor+  shape is frozen as a compatibility decoder and upgrades with no condition.+- Bounded one-level nested record rules through `FieldRule.elementFields`,+  non-recursive `NestedRules`/`NestedFieldRule` Dhall and Haskell types,+  profile/type compilation, indexed `FieldPath` diagnostics, JSON, constructors,+  and validation of nested presence, vocabulary, cardinality, and named formats.+  The complete EP-4 descriptor shape is frozen as a compatibility decoder and+  upgrades with no nested rule.+- Named `FieldFormat` constraints (`Rfc3339Utc`, `Date`, `Uri`,+  `UriWithScheme`, and `DocumentHandle`) on `FieldRule`, including parser-backed+  scalar/list validation, parameter checks, profile/type refinement, JSON and+  Dhall representations, and `ValueFormatMismatch` diagnostics. The complete+  EP-3 schema is frozen as a compatibility decoder whose fields upgrade to no+  format constraint.+- `Cardinality` (`Any`, `Scalar`, or `List`) on every `FieldRule`, compiled+  profile/type merge checks, shape-aware presence, and+  `CardinalityMismatch`. Frozen older descriptors upgrade to `Any`.+- `FieldRule.allowedValues`, `ProfileSpec.allowUnknownFields`, structural+  `FieldPath` diagnostics, and compiled validation for textual vocabularies and+  closed top-level field names. Older descriptors upgrade to unconstrained,+  open defaults.+- `coreFrontmatterFields` and deterministic `frontmatterKeys` in+  `Okf.Document`, shared by closed-profile validation.+- Type-aware frontmatter rules: each `TypeRule` now carries its own+  `FrontmatterRules`, merged with profile-wide rules for matching concepts.+- `CompiledProfile`, `ProfileDefinitionError`, `compileProfile`,+  `compiledProfileSpec`, and `profileFieldDescriptionForType`. Compilation+  rejects duplicate type rules and ambiguous field declarations before bundle+  validation begins.+- `MissingRecommendedProfileField`, emitted for profile recommendations under+  `StrictAuthoring`.+- `Okf.Profile.Registry`, which evaluates a registry reference — a Dhall file, a+  directory holding `package.dhall`, or a Dhall expression — and enumerates+  every profile it publishes under a dotted export path. Discovery is+  structural: each field of the normalized record is tested by decoding it, so+  no manifest is needed. Schema records exported as `{ Type, default }` are+  skipped, and a reference that is itself a profile reports one root entry.+- `ToJSON` instances for `ProfileSpec`, `FrontmatterRules`, and `TypeRule`. A+  type rule's name is emitted under the key `type`, matching the Dhall field+  rather than the Haskell field `type_`.+- `FieldRule` — `{ field :: Text, description :: Maybe Text, allowedValues :: [Text], cardinality :: Cardinality }`+  — one documented and optionally constrained frontmatter key.+- `profileFieldDescription :: ProfileSpec -> Text -> Maybe Text`, the prose a+  profile attaches to a frontmatter key, searching `required` then+  `recommended`.+- `decodeProfileExpr :: Expr Src Void -> Maybe ProfileSpec`, which decodes an+  already-evaluated Dhall expression under the current schema and each frozen+  compatibility generation. `Okf.Profile.Registry` uses it, so older profile+  registries still enumerate.+- Published Dhall: `dhall/FieldRule.dhall`, `dhall/defaults/FieldRule.dhall`,+  and `dhall/mk/FieldRule.dhall` (constructors `plain`, `documented`, `enum`,+  `scalar`, and `list`), all+  re-exported from `dhall/package.dhall`, which gains a top-level `mk` record.++### Changed++- **Breaking.** `FieldRule` gains+  `reference :: Maybe HandleReferenceRule`; `ProfileViolation` gains+  `DanglingHandleReference`, `ReferenceHandlePrefixMismatch`,+  `MalformedDocumentReference`, `ExternalReferenceSchemeNotAllowed`, and+  `SelfDocumentReference`; and `ProfileDefinitionError` gains structured+  reference-policy errors. Exhaustive consumers, including Mori, must update+  these cases as well as the earlier conditional missing-field patterns before+  moving both their `cabal.project` and `flake.nix` okf pins.+- **Breaking.** `FieldRule` and `NestedFieldRule` gain+  `when :: Maybe FieldCondition`; missing-field `ProfileViolation` constructors+  carry the activating condition; and `ProfileDefinitionError` gains structured+  condition errors. Exhaustive consumers, including Mori, must update before+  moving their `okf-core` pin.+- **Breaking.** `FieldRule` gains `elementFields :: Maybe NestedRules` and+  `ProfileViolation` gains `MissingNestedProfileField`,+  `MissingRecommendedNestedProfileField`, and `NestedElementNotRecord`.+  `ProfileDefinitionError` gains `ElementFieldsRequireList`. Exhaustive library+  consumers, including Mori, must handle the new diagnostics.+- **Breaking.** `FieldRule` gains `format :: Maybe FieldFormat`;+  `ProfileDefinitionError` gains `InvalidFormatParameter` and+  `ConflictingFieldFormat`; and `ProfileViolation` gains+  `ValueFormatMismatch`. Exhaustive consumers, including Mori, must handle the+  new constructors. The published Dhall schema adds defaulted+  `format : Optional FieldFormat` and exports format constructors.+- `okf-core` now depends on `network-uri >=2.6.4 && <2.7` for absolute RFC 3986+  URI parsing. Hackage marks 2.7.0.0 deprecated; 2.6.4.2 is the newest normal,+  upstream-tagged release.+- **Breaking.** `validateProfile` now accepts `ValidationProfile` and an opaque+  `CompiledProfile` rather than a raw `ProfileSpec`. Library consumers must call+  `compileProfile` once, handle definition errors, and select+  `PermissiveConformance` or `StrictAuthoring`. Exhaustive+  `ProfileViolation` matches must handle `MissingRecommendedProfileField`.+- **Breaking Dhall schema.** `TypeRule` gained+  `frontmatter : FrontmatterRules`. `defaults.TypeRule` supplies empty rules;+  direct record literals must add the field. A frozen decoder continues to load+  the previous self-documenting shape, and the 0.2.x fallback remains intact.+- Profile-wide frontmatter rules now apply to allowed and disallowed unknown+  types. Value constraints merge across profile and type scopes, presence+  declarations remain ordered clauses, applicable required clauses precede+  strict recommendations, and type-level prose wins when present.+- **Breaking.** `FrontmatterRules`'s `required` and `recommended` are now+  `[FieldRule]` rather than `[Text]`, and `ProfileSpec` and `TypeRule` each+  gained `description :: Maybe Text`. The published Dhall schema changed to+  match. Code that constructs or pattern-matches these records must be updated.+- `loadProfileFile` accepts okf 0.2.x descriptors by falling back to a private+  legacy decoder and upgrading the result with every description set to+  `Nothing`. When both decoders fail it reports the *current* decoder's error,+  since that is the schema an author is writing against. The frozen legacy+  shape is kept exercised by `test/fixtures/profiles/legacy-0.2.dhall`, which+  must never be updated.+- Descriptions remain documentary, but their lookup now follows the compiled+  effective rule for a concept type.+ ## [0.2.0.0] - 2026-07-26  ### Added

@@ -0,0 +1,5 @@+--| Cardinality constraint for one profile field.+--+-- `Any` preserves the legacy presence behavior. `Scalar` accepts text, numbers,+-- and booleans. `List` accepts arrays.+< Any | Scalar | List >

@@ -0,0 +1,5 @@+--| A same-scope predicate controlling whether a field presence rule applies.+--+-- `field` names a sibling in the same top-level or nested object. `hasValue`+-- lists the closed scalar textual values that activate the presence rule.+{ field : Text, hasValue : List Text }

@@ -0,0 +1,7 @@+--| Named textual formats available to profile field rules.+< Rfc3339Utc+| Date+| Uri+| UriWithScheme : Text+| DocumentHandle : Text+>

@@ -0,0 +1,29 @@+--| Canonical schema for one documented frontmatter key in an OKF profile.+--+-- Mirrors the `FieldRule` decoder in `okf-core/src/Okf/Profile.hs`.+--+-- `description` is documentation for humans and tooling: it is never checked+-- against a bundle and can never produce a profile violation. It exists so a+-- profile can explain what a key is for at the point the key is declared.+-- `allowedValues = []` leaves textual values unconstrained.+-- `cardinality = Cardinality.Any` preserves the legacy scalar-or-list presence+-- behavior.+let Cardinality = ./Cardinality.dhall++let FieldFormat = ./FieldFormat.dhall++let NestedRules = ./NestedRules.dhall++let FieldCondition = ./FieldCondition.dhall++let HandleReferenceRule = ./HandleReferenceRule.dhall++in  { field : Text+    , description : Optional Text+    , allowedValues : List Text+    , cardinality : Cardinality+    , format : Optional FieldFormat+    , elementFields : Optional NestedRules+    , reference : Optional HandleReferenceRule+    , when : Optional FieldCondition+    }

@@ -1,6 +1,10 @@ --| Canonical schema for a profile's frontmatter expectations. -- -- Mirrors the `FrontmatterRules` decoder in `okf-core/src/Okf/Profile.hs`.-{ required : List Text-, recommended : List Text-}+--+-- Each entry is a `FieldRule`: the frontmatter key, plus an optional description+-- explaining what the key is for. The description is documentary only — it is+-- never checked against a bundle and can never produce a profile violation.+let FieldRule = ./FieldRule.dhall++in  { required : List FieldRule, recommended : List FieldRule }

@@ -0,0 +1,7 @@+--| Policy for a top-level field containing local document handles or explicit+-- external URI alternatives. okf resolves only the local handle and never+-- performs network or registry lookups for an external URI.+{ localPrefix : Text+, externalUriSchemes : List Text+, allowSelf : Bool+}

@@ -0,0 +1,17 @@+--| Canonical schema for one field inside a list element record.+--+-- This deliberately omits `elementFields`, so profile schemas are bounded to+-- one list of flat records rather than recursively nested objects.+let Cardinality = ./Cardinality.dhall++let FieldFormat = ./FieldFormat.dhall++let FieldCondition = ./FieldCondition.dhall++in  { field : Text+    , description : Optional Text+    , allowedValues : List Text+    , cardinality : Cardinality+    , format : Optional FieldFormat+    , when : Optional FieldCondition+    }

@@ -0,0 +1,6 @@+--| Required and recommended fields inside each record of a list-valued field.+let NestedFieldRule = ./NestedFieldRule.dhall++in  { required : List NestedFieldRule+    , recommended : List NestedFieldRule+    }

@@ -11,14 +11,21 @@ -- -- `idField = Some "docId"` names the frontmatter key that holds stable document -- handles.  `None Text` disables every document-ID check.+--+-- `description` documents the profile as a whole, in prose, for whoever has to+-- read or adopt it. Like every description in this schema it is documentary only.+-- `allowUnknownFields = False` closes top-level frontmatter to core OKF keys,+-- the configured `idField`, and the effective profile/type field rules. let TypeRule = ./TypeRule.dhall  let FrontmatterRules = ./FrontmatterRules.dhall  in  { name : Text+    , description : Optional Text     , okfVersion : Text     , frontmatter : FrontmatterRules     , allowUnknownTypes : Bool+    , allowUnknownFields : Bool     , idField : Optional Text     , types : List TypeRule     }

@@ -8,7 +8,15 @@ -- -- `idPrefix = Some "ADR"` means concepts governed by this rule are expected to -- carry a handle of the form `ADR-<number>` in the profile's ID field.+--+-- `description` explains, in prose, what this concept type is for. It is+-- documentary only and is never checked against a bundle.+let FrontmatterRules = ./FrontmatterRules.dhall++in { type : Text+, description : Optional Text+, frontmatter : FrontmatterRules , pathPattern : Optional Text , resourceScheme : Optional Text , requireSchemaSection : Bool

@@ -0,0 +1,24 @@+--| Record-completion defaults for one documented frontmatter key.+let FieldRuleType = ../FieldRule.dhall++let Cardinality = ../Cardinality.dhall++let FieldFormat = ../FieldFormat.dhall++let NestedRules = ../NestedRules.dhall++let FieldCondition = ../FieldCondition.dhall++let HandleReferenceRule = ../HandleReferenceRule.dhall++in  { Type = FieldRuleType+    , default =+      { description = None Text+      , allowedValues = [] : List Text+      , cardinality = Cardinality.Any+      , format = None FieldFormat+      , elementFields = None NestedRules+      , reference = None HandleReferenceRule+      , when = None FieldCondition+      }+    }

@@ -1,6 +1,9 @@ --| Record-completion defaults for profile frontmatter expectations. let FrontmatterRulesType = ../FrontmatterRules.dhall +let FieldRule = ../FieldRule.dhall+ in  { Type = FrontmatterRulesType-    , default = { required = [] : List Text, recommended = [] : List Text }+    , default =+      { required = [] : List FieldRule, recommended = [] : List FieldRule }     }

@@ -0,0 +1,9 @@+--| Record-completion defaults for a document-reference policy.+let HandleReferenceRule = ../HandleReferenceRule.dhall++in  { Type = HandleReferenceRule+    , default =+      { externalUriSchemes = [] : List Text+      , allowSelf = False+      }+    }

@@ -0,0 +1,18 @@+--| Record-completion defaults for one nested field rule.+let NestedFieldRuleType = ../NestedFieldRule.dhall++let Cardinality = ../Cardinality.dhall++let FieldFormat = ../FieldFormat.dhall++let FieldCondition = ../FieldCondition.dhall++in  { Type = NestedFieldRuleType+    , default =+      { description = None Text+      , allowedValues = [] : List Text+      , cardinality = Cardinality.Any+      , format = None FieldFormat+      , when = None FieldCondition+      }+    }

@@ -0,0 +1,11 @@+--| Record-completion defaults for nested required and recommended fields.+let NestedRulesType = ../NestedRules.dhall++let NestedFieldRule = ../NestedFieldRule.dhall++in  { Type = NestedRulesType+    , default =+      { required = [] : List NestedFieldRule+      , recommended = [] : List NestedFieldRule+      }+    }

@@ -7,9 +7,11 @@  in  { Type = ProfileType     , default =-      { okfVersion = "0.1"+      { description = None Text+      , okfVersion = "0.1"       , frontmatter = FrontmatterRules.default       , allowUnknownTypes = True+      , allowUnknownFields = True       , idField = None Text       , types = [] : List TypeRule       }

@@ -1,9 +1,13 @@ --| Record-completion defaults for one per-`type` profile rule. let TypeRuleType = ../TypeRule.dhall +let FrontmatterRules = ./FrontmatterRules.dhall+ in  { Type = TypeRuleType     , default =-      { pathPattern = None Text+      { description = None Text+      , frontmatter = FrontmatterRules.default+      , pathPattern = None Text       , resourceScheme = None Text       , requireSchemaSection = False       , schemaColumns = [] : List Text

@@ -0,0 +1,82 @@+--| Constructors for one documented frontmatter key.+--+-- `FieldRule` is the profile type authors write most often, usually several times+-- inside one list literal, so it ships constructors as well as the record-completion+-- module in `../defaults/FieldRule.dhall`:+--+--     let field = okf.mk.FieldRule+--     in  [ field.documented "type" "The OKF concept type." , field.plain "title" ]+--+-- Both are built on record completion, so a future field added to `FieldRule` with a+-- default in `../defaults/FieldRule.dhall` leaves every call site working unchanged.+-- This protects descriptors written from now on; it does nothing for descriptors that+-- already exist, which keep loading via the legacy fallback decoder in+-- `okf-core/src/Okf/Profile.hs`.+let FieldRule = ../defaults/FieldRule.dhall++let Cardinality = ../Cardinality.dhall++let FieldFormat = ../FieldFormat.dhall++let NestedRules = ../NestedRules.dhall++let FieldCondition = ../FieldCondition.dhall++let HandleReferenceRule = ../defaults/HandleReferenceRule.dhall++in  { plain = \(field : Text) -> FieldRule::{ field }+    , documented =+        \(field : Text) ->+        \(description : Text) ->+          FieldRule::{ field, description = Some description }+    , enum =+        \(field : Text) ->+        \(allowedValues : List Text) ->+          FieldRule::{ field, allowedValues }+    , scalar =+        \(field : Text) -> FieldRule::{ field, cardinality = Cardinality.Scalar }+    , list =+        \(field : Text) -> FieldRule::{ field, cardinality = Cardinality.List }+    , rfc3339Utc =+        \(field : Text) -> FieldRule::{ field, format = Some FieldFormat.Rfc3339Utc }+    , date =+        \(field : Text) -> FieldRule::{ field, format = Some FieldFormat.Date }+    , uri =+        \(field : Text) -> FieldRule::{ field, format = Some FieldFormat.Uri }+    , uriWithScheme =+        \(field : Text) ->+        \(scheme : Text) ->+          FieldRule::{ field, format = Some (FieldFormat.UriWithScheme scheme) }+    , documentHandle =+        \(field : Text) ->+        \(prefix : Text) ->+          FieldRule::{ field, format = Some (FieldFormat.DocumentHandle prefix) }+    , recordList =+        \(field : Text) ->+        \(elementFields : NestedRules) ->+          FieldRule::{+          , field+          , cardinality = Cardinality.List+          , elementFields = Some elementFields+          }+    , conditional =+        \(rule : FieldRule.Type) ->+        \(condition : FieldCondition) ->+          rule with when = Some condition+    , localReference =+        \(field : Text) ->+        \(localPrefix : Text) ->+          FieldRule::{+          , field+          , reference = Some HandleReferenceRule::{ localPrefix }+          }+    , localOrExternalReference =+        \(field : Text) ->+        \(localPrefix : Text) ->+        \(externalUriSchemes : List Text) ->+          FieldRule::{+          , field+          , reference =+              Some HandleReferenceRule::{ localPrefix, externalUriSchemes }+          }+    }

@@ -0,0 +1,41 @@+--| Constructors for one field inside a list element record.+let NestedFieldRule = ../defaults/NestedFieldRule.dhall++let Cardinality = ../Cardinality.dhall++let FieldFormat = ../FieldFormat.dhall++let FieldCondition = ../FieldCondition.dhall++in  { plain = \(field : Text) -> NestedFieldRule::{ field }+    , documented =+        \(field : Text) ->+        \(description : Text) ->+          NestedFieldRule::{ field, description = Some description }+    , enum =+        \(field : Text) ->+        \(allowedValues : List Text) ->+          NestedFieldRule::{ field, allowedValues }+    , scalar =+        \(field : Text) -> NestedFieldRule::{ field, cardinality = Cardinality.Scalar }+    , list =+        \(field : Text) -> NestedFieldRule::{ field, cardinality = Cardinality.List }+    , rfc3339Utc =+        \(field : Text) -> NestedFieldRule::{ field, format = Some FieldFormat.Rfc3339Utc }+    , date =+        \(field : Text) -> NestedFieldRule::{ field, format = Some FieldFormat.Date }+    , uri =+        \(field : Text) -> NestedFieldRule::{ field, format = Some FieldFormat.Uri }+    , uriWithScheme =+        \(field : Text) ->+        \(scheme : Text) ->+          NestedFieldRule::{ field, format = Some (FieldFormat.UriWithScheme scheme) }+    , documentHandle =+        \(field : Text) ->+        \(prefix : Text) ->+          NestedFieldRule::{ field, format = Some (FieldFormat.DocumentHandle prefix) }+    , conditional =+        \(rule : NestedFieldRule.Type) ->+        \(condition : FieldCondition) ->+          rule with when = Some condition+    }

@@ -8,12 +8,32 @@ -- -- okf itself imports nothing remote; the relationship with okf-profiles is one-way -- (okf-profiles imports this).+-- `defaults` holds the `{ Type, default }` record-completion modules; `mk` holds+-- constructor functions for the types authors write repeatedly. Both protect a+-- descriptor written from now on against future additive, defaulted schema+-- fields; neither is a compatibility mechanism for descriptors that already+-- exist (okf-core's legacy fallback decoder is what keeps those loading). { Profile = ./Profile.dhall , TypeRule = ./TypeRule.dhall , FrontmatterRules = ./FrontmatterRules.dhall+, FieldRule = ./FieldRule.dhall+, FieldCondition = ./FieldCondition.dhall+, HandleReferenceRule = ./HandleReferenceRule.dhall+, NestedRules = ./NestedRules.dhall+, NestedFieldRule = ./NestedFieldRule.dhall+, Cardinality = ./Cardinality.dhall+, FieldFormat = ./FieldFormat.dhall , defaults =   { Profile = ./defaults/Profile.dhall   , TypeRule = ./defaults/TypeRule.dhall   , FrontmatterRules = ./defaults/FrontmatterRules.dhall+  , FieldRule = ./defaults/FieldRule.dhall+  , HandleReferenceRule = ./defaults/HandleReferenceRule.dhall+  , NestedRules = ./defaults/NestedRules.dhall+  , NestedFieldRule = ./defaults/NestedFieldRule.dhall+  }+, mk =+  { FieldRule = ./mk/FieldRule.dhall+  , NestedFieldRule = ./mk/NestedFieldRule.dhall   } }

@@ -1,6 +1,6 @@ cabal-version:      3.4 name:               okf-core-version:            0.2.0.0+version:            0.3.0.0 synopsis:   Read, validate, index, and traverse Open Knowledge Format bundles @@ -54,25 +54,27 @@     Okf.Log     Okf.Prelude     Okf.Profile+    Okf.Profile.Registry     Okf.Validation    build-depends:-    , aeson         >=2.2  && <2.4-    , attoparsec    >=0.14 && <0.15-    , base          >=4.20 && <5-    , bytestring    >=0.11 && <0.13+    , aeson         >=2.2   && <2.4+    , attoparsec    >=0.14  && <0.15+    , base          >=4.20  && <5+    , bytestring    >=0.11  && <0.13     , cmark-gfm     ^>=0.2-    , containers    >=0.6  && <0.8-    , dhall         >=1.41 && <1.43-    , directory     >=1.3  && <1.4-    , filepath      >=1.4  && <1.6-    , frontmatter   >=0.1  && <0.2-    , generic-lens  >=2.2  && <2.4+    , containers    >=0.6   && <0.8+    , dhall         >=1.41  && <1.43+    , directory     >=1.3   && <1.4+    , filepath      >=1.4   && <1.6+    , frontmatter   >=0.1   && <0.2+    , generic-lens  >=2.2   && <2.4     , lens          ^>=5.3+    , network-uri   >=2.6.4 && <2.7     , text          ^>=2.1-    , time          >=1.12 && <1.15-    , vector        >=0.13 && <0.14-    , yaml          >=0.11 && <0.12+    , time          >=1.12  && <1.15+    , vector        >=0.13  && <0.14+    , yaml          >=0.11  && <0.12  test-suite okf-core-test   import:         common-options

@@ -5,6 +5,8 @@     DocumentParseError (..),     emptyFrontmatter,     frontmatterLookup,+    frontmatterKeys,+    coreFrontmatterFields,     parseDocument,     serializeDocument, @@ -28,7 +30,10 @@ import Data.Attoparsec.ByteString qualified as Attoparsec import Data.ByteString qualified as ByteString import Data.Frontmatter qualified as Frontmatter+import Data.List qualified as List import Data.Ord (comparing)+import Data.Set (Set)+import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.Encoding qualified as Text.Encoding import Data.Vector qualified as Vector@@ -65,6 +70,19 @@ frontmatterLookup key (Frontmatter rawFields) =   KeyMap.lookup (AesonKey.fromText key) rawFields +-- | All top-level frontmatter keys in lexical order. Aeson's 'KeyMap.keys'+-- order depends on its backing representation, so callers must not expose it+-- directly when deterministic diagnostics matter.+frontmatterKeys :: Frontmatter -> [Text]+frontmatterKeys (Frontmatter rawFields) =+  List.sort (map AesonKey.toText (KeyMap.keys rawFields))++-- | Frontmatter keys understood directly by OKF parsing, validation, and+-- authoring. Closed profiles always permit these keys even when they are not+-- repeated as profile field rules.+coreFrontmatterFields :: Set Text+coreFrontmatterFields = Set.fromList coreFrontmatterFieldOrder+ -- | Build frontmatter from a list of @(key, value)@ pairs. Later duplicate -- keys overwrite earlier ones. frontmatterFromFields :: [(Text, Value)] -> Frontmatter@@ -166,8 +184,10 @@     Just rank -> (rank, "")     Nothing -> (length commonRanks, keyText)   where-    commonRanks =-      zip ["type", "title", "description", "timestamp", "resource", "tags"] [0 ..]+    commonRanks = zip coreFrontmatterFieldOrder [0 ..]++coreFrontmatterFieldOrder :: [Text]+coreFrontmatterFieldOrder = ["type", "title", "description", "timestamp", "resource", "tags"]  parseFrontmatterDocument :: ByteString.ByteString -> Either DocumentParseError OKFDocument parseFrontmatterDocument inputBytes =

@@ -13,289 +13,2209 @@   ( -- * Descriptor     ProfileSpec (..),     FrontmatterRules (..),-    TypeRule (..),-    loadProfileFile,--    -- * Validation-    DocumentId (..),-    parseDocumentId,-    renderDocumentId,-    documentIdsInBundle,-    nextDocumentId,-    ProfileViolation (..),-    validateProfile,--    -- * Body inspection-    schemaSectionColumns,-  )-where--import CMarkGFM qualified-import Control.Exception (SomeException, catch)-import Data.Char (isAsciiLower, isAsciiUpper)-import Data.List qualified as List-import Data.Text qualified as Text-import Data.Text.Read qualified as Text.Read-import Dhall (FromDhall (..), auto, genericAutoWith)-import Dhall qualified-import Numeric.Natural (Natural)-import Okf.Bundle-  ( Concept,-    conceptDocument,-    conceptIdOf,-    conceptResource,-    conceptType,-  )-import Okf.ConceptId (ConceptId, renderConceptId)-import Okf.Document (Frontmatter, frontmatterLookup)-import Okf.Prelude-import "generic-lens" Data.Generics.Labels ()---- | A complete house profile.-data ProfileSpec = ProfileSpec-  { name :: !Text,-    okfVersion :: !Text,-    frontmatter :: !FrontmatterRules,-    allowUnknownTypes :: !Bool,-    idField :: !(Maybe Text),-    types :: ![TypeRule]-  }-  deriving stock (Generic, Eq, Show)-  deriving anyclass (FromDhall)---- | Frontmatter keys the profile expects on every concept.-data FrontmatterRules = FrontmatterRules-  { required :: ![Text],-    recommended :: ![Text]-  }-  deriving stock (Generic, Eq, Show)-  deriving anyclass (FromDhall)---- | One rule per allowed concept @type@ string.-data TypeRule = TypeRule-  { type_ :: !Text,-    pathPattern :: !(Maybe Text),-    resourceScheme :: !(Maybe Text),-    requireSchemaSection :: !Bool,-    schemaColumns :: ![Text],-    idPrefix :: !(Maybe Text)-  }-  deriving stock (Generic, Eq, Show)---- | Decode @type_@ from the Dhall field @type@ by stripping the trailing--- underscore; all other fields map by their exact name. (Mirrors how--- 'Okf.Bundle' uses a @type_@ field to avoid clashing with the @type@ keyword.)-instance FromDhall TypeRule where-  autoWith _normalizer =-    genericAutoWith-      (Dhall.defaultInterpretOptions {Dhall.fieldModifier = stripTrailingUnderscore})-    where-      stripTrailingUnderscore fieldName =-        fromMaybe fieldName (Text.stripSuffix "_" fieldName)---- | Load and decode a Dhall profile descriptor from a file path. Any evaluation--- or decoding failure is captured as a human-readable 'Left'.-loadProfileFile :: FilePath -> IO (Either Text ProfileSpec)-loadProfileFile path =-  (Right <$> Dhall.inputFile auto path)-    `catch` \(e :: SomeException) -> pure (Left (Text.pack (show e)))---- | A parsed document handle: an ASCII-letter-led alphanumeric prefix and a--- positive number, rendered as @PREFIX-N@.-data DocumentId = DocumentId-  { prefix :: !Text,-    number :: !Natural-  }-  deriving stock (Generic, Eq, Ord, Show)---- | Parse a strict document handle. The prefix contains one or more ASCII--- letters or digits and begins with a letter. It is followed by exactly one--- hyphen and a positive decimal number with no leading zero. Thus @ADR-7@--- parses, while @ADR-007@, @ADR-0@, @ADR-@, @-7@, @adr 7@, and--- @ADR-7-extra@ do not.-parseDocumentId :: Text -> Maybe DocumentId-parseDocumentId raw =-  case Text.splitOn "-" raw of-    [prefixText, numberText]-      | validPrefix prefixText,-        validNumberText numberText ->-          case Text.Read.decimal numberText of-            Right (parsedNumber, remainder)-              | Text.null remainder,-                parsedNumber > 0 ->-                  Just (DocumentId prefixText parsedNumber)-            _ -> Nothing-    _ -> Nothing-  where-    validPrefix value =-      case Text.uncons value of-        Just (firstCharacter, rest) ->-          isAsciiLetter firstCharacter && Text.all isAsciiAlphaNumeric rest-        Nothing -> False-    validNumberText value =-      case Text.uncons value of-        Just (firstCharacter, rest) ->-          firstCharacter >= '1'-            && firstCharacter <= '9'-            && Text.all isAsciiDigit rest-        Nothing -> False-    isAsciiLetter character =-      isAsciiLower character || isAsciiUpper character-    isAsciiDigit character =-      character >= '0' && character <= '9'-    isAsciiAlphaNumeric character =-      isAsciiLetter character || isAsciiDigit character---- | Render a document handle as @PREFIX-N@.-renderDocumentId :: DocumentId -> Text-renderDocumentId DocumentId {prefix, number} =-  prefix <> "-" <> Text.pack (show number)---- | Every well-formed handle under the profile's ID field, paired with the--- concept carrying it and sorted by prefix, number, then concept ID. Concepts--- without a well-formed handle are omitted. A profile with no ID field yields--- an empty list.-documentIdsInBundle :: ProfileSpec -> [Concept] -> [(DocumentId, ConceptId)]-documentIdsInBundle spec concepts =-  case spec ^. #idField of-    Nothing -> []-    Just fieldName ->-      List.sortOn-        (\(documentId, cid) -> (documentId, renderConceptId cid))-        [ (documentId, conceptIdOf concept)-        | concept <- concepts,-          Just (String rawDocumentId) <- [frontmatterLookup fieldName (conceptFrontmatter concept)],-          Just documentId <- [parseDocumentId rawDocumentId]-        ]---- | Allocate one more than the highest document-ID number already used for the--- given prefix, or number 1 when the prefix is unused. Gaps are deliberately--- not filled: reusing a retired number could make an old reference silently--- point at a different document.-nextDocumentId :: ProfileSpec -> [Concept] -> Text -> DocumentId-nextDocumentId spec concepts requestedPrefix =-  DocumentId-    { prefix = requestedPrefix,-      number = highestNumber + 1-    }-  where-    highestNumber =-      List.foldl'-        max-        0-        [ documentId ^. #number-        | (documentId, _) <- documentIdsInBundle spec concepts,-          documentId ^. #prefix == requestedPrefix-        ]---- | A single deviation from a profile. Advisory by default at the CLI layer.-data ProfileViolation-  = -- | concept's @type@ is not listed in the profile and unknown types are disallowed-    TypeNotInProfile ConceptId Text-  | -- | a required frontmatter key is missing or empty (concept, key)-    MissingProfileField ConceptId Text-  | -- | concept's file path does not match the type rule's pattern (concept, type, pattern)-    PathPatternMismatch ConceptId Text Text-  | -- | type rule requires a resource scheme but resource is absent (concept, type, scheme)-    MissingResource ConceptId Text Text-  | -- | resource present but its scheme is wrong (concept, expected scheme, actual resource)-    ResourceSchemeMismatch ConceptId Text Text-  | -- | required @# Schema@ section is absent (concept, type)-    MissingSchemaSection ConceptId Text-  | -- | @# Schema@ table columns do not match (concept, type, expected, actual)-    SchemaColumnsMismatch ConceptId Text [Text] [Text]-  | -- | type rule declares an @idPrefix@ but the concept has no handle (concept, type, prefix)-    MissingDocumentId ConceptId Text Text-  | -- | handle present but malformed for the declared prefix (concept, prefix, actual value)-    MalformedDocumentId ConceptId Text Text-  | -- | the same handle appears on more than one concept (handle, concept, other concept)-    DuplicateDocumentId Text ConceptId ConceptId-  deriving stock (Generic, Eq, Show)---- | Check every concept against the profile, returning all deviations. Concepts--- whose @type@ is not in the profile vocabulary skip the per-rule checks (there--- is no rule to check against) and only produce a 'TypeNotInProfile' violation--- when @allowUnknownTypes@ is @False@.-validateProfile :: ProfileSpec -> [Concept] -> [ProfileViolation]-validateProfile spec concepts =-  concatMap checkConcept concepts <> checkDuplicateDocumentIds spec concepts-  where-    rulesByType = [(rule ^. #type_, rule) | rule <- spec ^. #types]--    checkConcept concept =-      let cid = conceptIdOf concept-          ctype = conceptType concept-       in case lookup ctype rulesByType of-            Nothing ->-              [TypeNotInProfile cid ctype | not (spec ^. #allowUnknownTypes)]-            Just rule ->-              checkRequiredFields cid concept-                <> checkPath cid ctype rule-                <> checkResource cid ctype rule concept-                <> checkSchema cid ctype rule concept-                <> checkDocumentId spec cid ctype rule concept--    checkRequiredFields cid concept =-      [ MissingProfileField cid key-      | key <- spec ^. #frontmatter . #required,-        not (hasNonEmptyField key (conceptFrontmatter concept))-      ]---- | Check a profile-declared document ID for one concept.-checkDocumentId :: ProfileSpec -> ConceptId -> Text -> TypeRule -> Concept -> [ProfileViolation]-checkDocumentId spec cid ctype rule concept =-  case (spec ^. #idField, rule ^. #idPrefix) of-    (Just fieldName, Just expectedPrefix) ->-      case frontmatterLookup fieldName (conceptFrontmatter concept) of-        Just (String value)-          | not (Text.null (Text.strip value)) ->-              case parseDocumentId value of-                Just documentId-                  | documentId ^. #prefix == expectedPrefix -> []-                _ -> [MalformedDocumentId cid expectedPrefix value]-        _ -> [MissingDocumentId cid ctype expectedPrefix]-    _ -> []---- | Check every non-empty value under the profile's ID field for bundle-wide--- uniqueness. Concept IDs are sorted before grouping so output is deterministic.-checkDuplicateDocumentIds :: ProfileSpec -> [Concept] -> [ProfileViolation]-checkDuplicateDocumentIds spec concepts =-  case spec ^. #idField of-    Nothing -> []-    Just fieldName ->-      concatMap duplicateViolations (groupedHandles fieldName)-  where-    groupedHandles fieldName =-      List.groupBy-        (\(leftHandle, _) (rightHandle, _) -> leftHandle == rightHandle)-        (handles fieldName)-    handles fieldName =-      List.sortOn-        (\(handle, cid) -> (handle, renderConceptId cid))-        [ (handle, conceptIdOf concept)-        | concept <- concepts,-          Just (String handle) <- [frontmatterLookup fieldName (conceptFrontmatter concept)],-          not (Text.null (Text.strip handle))-        ]-    duplicateViolations ((handle, firstConcept) : duplicates) =-      [ DuplicateDocumentId handle firstConcept duplicateConcept-      | (_, duplicateConcept) <- duplicates-      ]-    duplicateViolations [] = []---- | Project a concept's frontmatter (the document's @frontmatter@ field).-conceptFrontmatter :: Concept -> Frontmatter-conceptFrontmatter concept = conceptDocument concept ^. #frontmatter---- | A field counts as present only if it is a non-empty string or a non-empty--- list (mirroring how the core validator treats @type@). Anything else,--- including a missing key, does not count.-hasNonEmptyField :: Text -> Frontmatter -> Bool-hasNonEmptyField key fm =-  case frontmatterLookup key fm of-    Just (String value) -> not (Text.null (Text.strip value))-    Just (Array values) -> not (null values)-    _ -> False+    FieldCondition (..),+    HandleReferenceRule (..),+    FieldRule (..),+    NestedRules (..),+    NestedFieldRule (..),+    Cardinality (..),+    FieldFormat (..),+    TypeRule (..),+    FieldPath (..),+    FieldPathSegment (..),+    loadProfileFile,+    decodeProfileExpr,+    profileFieldDescription,+    CompiledProfile,+    ProfileDefinitionError (..),+    compileProfile,+    compiledProfileSpec,+    profileFieldDescriptionForType,++    -- * Validation+    DocumentId (..),+    parseDocumentId,+    renderDocumentId,+    documentIdsInBundle,+    nextDocumentId,+    ProfileViolation (..),+    validateProfile,++    -- * Body inspection+    schemaSectionColumns,+  )+where++import CMarkGFM qualified+import Control.Exception (SomeException, catch)+import Data.Aeson (ToJSON (..), object, (.=))+import Data.Aeson.Key qualified as Aeson.Key+import Data.Aeson.KeyMap qualified as Aeson.KeyMap+import Data.Char (isAsciiLower, isAsciiUpper)+import Data.List qualified as List+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (mapMaybe)+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Text.Read qualified as Text.Read+import Data.Time.Calendar (Day)+import Data.Time.Clock (UTCTime)+import Data.Time.Format.ISO8601 (iso8601ParseM)+import Data.Vector qualified as Vector+import Data.Void (Void)+import Dhall (FromDhall (..), auto, genericAutoWith)+import Dhall qualified+import Dhall.Core (Expr)+import Dhall.Src (Src)+import Network.URI (parseURI, uriScheme)+import Numeric.Natural (Natural)+import Okf.Bundle+  ( Concept,+    conceptDocument,+    conceptIdOf,+    conceptResource,+    conceptType,+  )+import Okf.ConceptId (ConceptId, renderConceptId)+import Okf.Document (Frontmatter, coreFrontmatterFields, frontmatterKeys, frontmatterLookup)+import Okf.Prelude hiding (List, (.=))+import Okf.Validation (ValidationProfile (..))+import "generic-lens" Data.Generics.Labels ()++-- | A complete house profile. @description@ is prose documenting the profile as+-- a whole; like every description in this module it is never checked against a+-- bundle and can never produce a 'ProfileViolation'.+data ProfileSpec = ProfileSpec+  { name :: !Text,+    description :: !(Maybe Text),+    okfVersion :: !Text,+    frontmatter :: !FrontmatterRules,+    allowUnknownTypes :: !Bool,+    allowUnknownFields :: !Bool,+    idField :: !(Maybe Text),+    types :: ![TypeRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | Frontmatter keys the profile expects on every concept.+data FrontmatterRules = FrontmatterRules+  { required :: ![FieldRule],+    recommended :: ![FieldRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | A same-scope predicate controlling whether a field's presence rule applies.+-- The source field must compile to a closed scalar textual vocabulary.+data FieldCondition = FieldCondition+  { field :: !Text,+    hasValue :: ![Text]+  }+  deriving stock (Generic, Eq, Ord, Show)+  deriving anyclass (FromDhall)++-- | A top-level field whose textual values point either to a local document+-- handle with one prefix or to an absolute URI with an explicitly allowed+-- scheme. External targets are never resolved by okf.+data HandleReferenceRule = HandleReferenceRule+  { localPrefix :: !Text,+    externalUriSchemes :: ![Text],+    allowSelf :: !Bool+  }+  deriving stock (Generic, Eq, Ord, Show)+  deriving anyclass (FromDhall)++-- | One documented frontmatter key. The description is prose for humans and is+-- never checked against a bundle.+data FieldRule = FieldRule+  { field :: !Text,+    description :: !(Maybe Text),+    allowedValues :: ![Text],+    cardinality :: !Cardinality,+    format :: !(Maybe FieldFormat),+    elementFields :: !(Maybe NestedRules),+    reference :: !(Maybe HandleReferenceRule),+    when :: !(Maybe FieldCondition)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | Rules for the flat object stored in each element of a list-valued field.+-- The nested rule type has no @elementFields@ member, which makes the public+-- descriptor depth-bounded rather than recursive.+data NestedRules = NestedRules+  { required :: ![NestedFieldRule],+    recommended :: ![NestedFieldRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data NestedFieldRule = NestedFieldRule+  { field :: !Text,+    description :: !(Maybe Text),+    allowedValues :: ![Text],+    cardinality :: !Cardinality,+    format :: !(Maybe FieldFormat),+    when :: !(Maybe FieldCondition)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data Cardinality = Any | Scalar | List+  deriving stock (Generic, Eq, Ord, Show)+  deriving anyclass (FromDhall)++-- | A named textual format. Formats constrain present text values but do not+-- imply that a field must be present.+data FieldFormat+  = Rfc3339Utc+  | Date+  | Uri+  | UriWithScheme Text+  | DocumentHandle Text+  deriving stock (Generic, Eq, Ord, Show)+  deriving anyclass (FromDhall)++-- | One rule per allowed concept @type@ string.+data TypeRule = TypeRule+  { type_ :: !Text,+    description :: !(Maybe Text),+    frontmatter :: !FrontmatterRules,+    pathPattern :: !(Maybe Text),+    resourceScheme :: !(Maybe Text),+    requireSchemaSection :: !Bool,+    schemaColumns :: ![Text],+    idPrefix :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)++-- | Decode @type_@ from the Dhall field @type@ by stripping the trailing+-- underscore; all other fields map by their exact name. (Mirrors how+-- 'Okf.Bundle' uses a @type_@ field to avoid clashing with the @type@ keyword.)+instance FromDhall TypeRule where+  autoWith _normalizer =+    genericAutoWith+      (Dhall.defaultInterpretOptions {Dhall.fieldModifier = stripTrailingUnderscore})+    where+      stripTrailingUnderscore fieldName =+        fromMaybe fieldName (Text.stripSuffix "_" fieldName)++-- | Encode a profile so tooling can consume the same descriptor okf reads.+-- Written by hand rather than derived so the key order is stable and, more+-- importantly, so 'TypeRule' emits @type@ rather than the Haskell field name+-- @type_@ — matching the Dhall field and how 'Okf.Graph.Node' already encodes.+instance ToJSON ProfileSpec where+  toJSON ProfileSpec {name, description, okfVersion, frontmatter, allowUnknownTypes, allowUnknownFields, idField, types = typeRules} =+    object+      [ "name" .= name,+        "description" .= description,+        "okfVersion" .= okfVersion,+        "allowUnknownTypes" .= allowUnknownTypes,+        "allowUnknownFields" .= allowUnknownFields,+        "idField" .= idField,+        "frontmatter" .= frontmatter,+        "types" .= typeRules+      ]++instance ToJSON FrontmatterRules where+  toJSON FrontmatterRules {required, recommended} =+    object+      [ "required" .= required,+        "recommended" .= recommended+      ]++instance ToJSON FieldCondition where+  toJSON FieldCondition {field = fieldName, hasValue} =+    object+      [ "field" .= fieldName,+        "hasValue" .= hasValue+      ]++instance ToJSON HandleReferenceRule where+  toJSON HandleReferenceRule {localPrefix, externalUriSchemes, allowSelf} =+    object+      [ "localPrefix" .= localPrefix,+        "externalUriSchemes" .= externalUriSchemes,+        "allowSelf" .= allowSelf+      ]++instance ToJSON FieldRule where+  toJSON FieldRule {field = fieldName, description, allowedValues, cardinality, format, elementFields, reference, when = condition} =+    object+      [ "field" .= fieldName,+        "description" .= description,+        "allowedValues" .= allowedValues,+        "cardinality" .= cardinality,+        "format" .= format,+        "elementFields" .= elementFields,+        "reference" .= reference,+        "when" .= condition+      ]++instance ToJSON NestedRules where+  toJSON NestedRules {required, recommended} =+    object+      [ "required" .= required,+        "recommended" .= recommended+      ]++instance ToJSON NestedFieldRule where+  toJSON NestedFieldRule {field = fieldName, description, allowedValues, cardinality, format, when = condition} =+    object+      [ "field" .= fieldName,+        "description" .= description,+        "allowedValues" .= allowedValues,+        "cardinality" .= cardinality,+        "format" .= format,+        "when" .= condition+      ]++instance ToJSON Cardinality where+  toJSON = String . cardinalityName++cardinalityName :: Cardinality -> Text+cardinalityName = \case+  Any -> "any"+  Scalar -> "scalar"+  List -> "list"++instance ToJSON FieldFormat where+  toJSON = \case+    Rfc3339Utc -> String "rfc3339-utc"+    Date -> String "date"+    Uri -> String "uri"+    UriWithScheme scheme -> object ["uriWithScheme" .= scheme]+    DocumentHandle prefix -> object ["documentHandle" .= prefix]++instance ToJSON TypeRule where+  toJSON+    TypeRule+      { type_ = ruleType,+        description,+        frontmatter,+        pathPattern,+        resourceScheme,+        requireSchemaSection,+        schemaColumns,+        idPrefix+      } =+      object+        [ "type" .= ruleType,+          "description" .= description,+          "frontmatter" .= frontmatter,+          "pathPattern" .= pathPattern,+          "resourceScheme" .= resourceScheme,+          "requireSchemaSection" .= requireSchemaSection,+          "schemaColumns" .= schemaColumns,+          "idPrefix" .= idPrefix+        ]++-- | The okf 0.2.x profile record: frontmatter keys were bare strings and+-- nothing carried a description. Decoded only as a fallback, so descriptors+-- written before descriptions existed keep loading unchanged. Deliberately+-- private and deliberately frozen — it is a record of a retired shape, not a+-- second profile model. Exercised by+-- @okf-core\/test\/fixtures\/profiles\/legacy-0.2.dhall@.+data LegacyProfileSpec = LegacyProfileSpec+  { name :: !Text,+    okfVersion :: !Text,+    frontmatter :: !LegacyFrontmatterRules,+    allowUnknownTypes :: !Bool,+    idField :: !(Maybe Text),+    types :: ![LegacyTypeRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | The okf 0.2.x frontmatter record: two lists of bare key names.+data LegacyFrontmatterRules = LegacyFrontmatterRules+  { required :: ![Text],+    recommended :: ![Text]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | The okf 0.2.x per-@type@ rule: today's 'TypeRule' without descriptions or+-- type-specific frontmatter.+data LegacyTypeRule = LegacyTypeRule+  { type_ :: !Text,+    pathPattern :: !(Maybe Text),+    resourceScheme :: !(Maybe Text),+    requireSchemaSection :: !Bool,+    schemaColumns :: ![Text],+    idPrefix :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)++instance FromDhall LegacyTypeRule where+  autoWith _normalizer =+    genericAutoWith+      (Dhall.defaultInterpretOptions {Dhall.fieldModifier = stripTrailingUnderscore})+    where+      stripTrailingUnderscore fieldName =+        fromMaybe fieldName (Text.stripSuffix "_" fieldName)++-- | The complete condition-aware descriptor generation, frozen before+-- top-level document-reference policies were added. This is the immediately+-- preceding public descriptor generation.+data ConditionalProfileFieldRule = ConditionalProfileFieldRule+  { field :: !Text,+    description :: !(Maybe Text),+    allowedValues :: ![Text],+    cardinality :: !Cardinality,+    format :: !(Maybe FieldFormat),+    elementFields :: !(Maybe ConditionalProfileNestedRules),+    when :: !(Maybe FieldCondition)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data ConditionalProfileNestedRules = ConditionalProfileNestedRules+  { required :: ![ConditionalProfileNestedFieldRule],+    recommended :: ![ConditionalProfileNestedFieldRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data ConditionalProfileNestedFieldRule = ConditionalProfileNestedFieldRule+  { field :: !Text,+    description :: !(Maybe Text),+    allowedValues :: ![Text],+    cardinality :: !Cardinality,+    format :: !(Maybe FieldFormat),+    when :: !(Maybe FieldCondition)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data ConditionalProfileFrontmatterRules = ConditionalProfileFrontmatterRules+  { required :: ![ConditionalProfileFieldRule],+    recommended :: ![ConditionalProfileFieldRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data ConditionalProfileSpec = ConditionalProfileSpec+  { name :: !Text,+    description :: !(Maybe Text),+    okfVersion :: !Text,+    frontmatter :: !ConditionalProfileFrontmatterRules,+    allowUnknownTypes :: !Bool,+    allowUnknownFields :: !Bool,+    idField :: !(Maybe Text),+    types :: ![ConditionalProfileTypeRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data ConditionalProfileTypeRule = ConditionalProfileTypeRule+  { type_ :: !Text,+    description :: !(Maybe Text),+    frontmatter :: !ConditionalProfileFrontmatterRules,+    pathPattern :: !(Maybe Text),+    resourceScheme :: !(Maybe Text),+    requireSchemaSection :: !Bool,+    schemaColumns :: ![Text],+    idPrefix :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)++instance FromDhall ConditionalProfileTypeRule where+  autoWith _normalizer =+    genericAutoWith+      (Dhall.defaultInterpretOptions {Dhall.fieldModifier = stripTrailingUnderscore})+    where+      stripTrailingUnderscore fieldName =+        fromMaybe fieldName (Text.stripSuffix "_" fieldName)++-- | The complete bounded-nested descriptor generation, frozen before+-- same-scope field conditions were added. This is the immediately preceding+-- public descriptor generation.+data NestedProfileFieldRule = NestedProfileFieldRule+  { field :: !Text,+    description :: !(Maybe Text),+    allowedValues :: ![Text],+    cardinality :: !Cardinality,+    format :: !(Maybe FieldFormat),+    elementFields :: !(Maybe NestedProfileRules)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data NestedProfileRules = NestedProfileRules+  { required :: ![NestedProfileNestedFieldRule],+    recommended :: ![NestedProfileNestedFieldRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data NestedProfileNestedFieldRule = NestedProfileNestedFieldRule+  { field :: !Text,+    description :: !(Maybe Text),+    allowedValues :: ![Text],+    cardinality :: !Cardinality,+    format :: !(Maybe FieldFormat)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data NestedProfileFrontmatterRules = NestedProfileFrontmatterRules+  { required :: ![NestedProfileFieldRule],+    recommended :: ![NestedProfileFieldRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data NestedProfileSpec = NestedProfileSpec+  { name :: !Text,+    description :: !(Maybe Text),+    okfVersion :: !Text,+    frontmatter :: !NestedProfileFrontmatterRules,+    allowUnknownTypes :: !Bool,+    allowUnknownFields :: !Bool,+    idField :: !(Maybe Text),+    types :: ![NestedProfileTypeRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data NestedProfileTypeRule = NestedProfileTypeRule+  { type_ :: !Text,+    description :: !(Maybe Text),+    frontmatter :: !NestedProfileFrontmatterRules,+    pathPattern :: !(Maybe Text),+    resourceScheme :: !(Maybe Text),+    requireSchemaSection :: !Bool,+    schemaColumns :: ![Text],+    idPrefix :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)++instance FromDhall NestedProfileTypeRule where+  autoWith _normalizer =+    genericAutoWith+      (Dhall.defaultInterpretOptions {Dhall.fieldModifier = stripTrailingUnderscore})+    where+      stripTrailingUnderscore fieldName =+        fromMaybe fieldName (Text.stripSuffix "_" fieldName)++-- | The complete EP-4 field rule, frozen before one-level nested records were+-- added. This is the immediately preceding public descriptor generation.+data FormatFieldRule = FormatFieldRule+  { field :: !Text,+    description :: !(Maybe Text),+    allowedValues :: ![Text],+    cardinality :: !Cardinality,+    format :: !(Maybe FieldFormat)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data FormatFrontmatterRules = FormatFrontmatterRules+  { required :: ![FormatFieldRule],+    recommended :: ![FormatFieldRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data FormatProfileSpec = FormatProfileSpec+  { name :: !Text,+    description :: !(Maybe Text),+    okfVersion :: !Text,+    frontmatter :: !FormatFrontmatterRules,+    allowUnknownTypes :: !Bool,+    allowUnknownFields :: !Bool,+    idField :: !(Maybe Text),+    types :: ![FormatTypeRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data FormatTypeRule = FormatTypeRule+  { type_ :: !Text,+    description :: !(Maybe Text),+    frontmatter :: !FormatFrontmatterRules,+    pathPattern :: !(Maybe Text),+    resourceScheme :: !(Maybe Text),+    requireSchemaSection :: !Bool,+    schemaColumns :: ![Text],+    idPrefix :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)++instance FromDhall FormatTypeRule where+  autoWith _normalizer =+    genericAutoWith+      (Dhall.defaultInterpretOptions {Dhall.fieldModifier = stripTrailingUnderscore})+    where+      stripTrailingUnderscore fieldName =+        fromMaybe fieldName (Text.stripSuffix "_" fieldName)++-- | The EP-3 field rule, frozen before named formats were added.+data CardinalityFieldRule = CardinalityFieldRule+  { field :: !Text,+    description :: !(Maybe Text),+    allowedValues :: ![Text],+    cardinality :: !Cardinality+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data CardinalityFrontmatterRules = CardinalityFrontmatterRules+  { required :: ![CardinalityFieldRule],+    recommended :: ![CardinalityFieldRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | The complete EP-3 profile shape, frozen before named formats were added.+data CardinalityProfileSpec = CardinalityProfileSpec+  { name :: !Text,+    description :: !(Maybe Text),+    okfVersion :: !Text,+    frontmatter :: !CardinalityFrontmatterRules,+    allowUnknownTypes :: !Bool,+    allowUnknownFields :: !Bool,+    idField :: !(Maybe Text),+    types :: ![CardinalityTypeRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data CardinalityTypeRule = CardinalityTypeRule+  { type_ :: !Text,+    description :: !(Maybe Text),+    frontmatter :: !CardinalityFrontmatterRules,+    pathPattern :: !(Maybe Text),+    resourceScheme :: !(Maybe Text),+    requireSchemaSection :: !Bool,+    schemaColumns :: ![Text],+    idPrefix :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)++instance FromDhall CardinalityTypeRule where+  autoWith _normalizer =+    genericAutoWith+      (Dhall.defaultInterpretOptions {Dhall.fieldModifier = stripTrailingUnderscore})+    where+      stripTrailingUnderscore fieldName =+        fromMaybe fieldName (Text.stripSuffix "_" fieldName)++-- | The EP-2 field rule, frozen before cardinality was added.+data VocabularyFieldRule = VocabularyFieldRule+  { field :: !Text,+    description :: !(Maybe Text),+    allowedValues :: ![Text]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data VocabularyFrontmatterRules = VocabularyFrontmatterRules+  { required :: ![VocabularyFieldRule],+    recommended :: ![VocabularyFieldRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | The EP-2 profile shape, frozen before cardinality was added.+data VocabularyProfileSpec = VocabularyProfileSpec+  { name :: !Text,+    description :: !(Maybe Text),+    okfVersion :: !Text,+    frontmatter :: !VocabularyFrontmatterRules,+    allowUnknownTypes :: !Bool,+    allowUnknownFields :: !Bool,+    idField :: !(Maybe Text),+    types :: ![VocabularyTypeRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data VocabularyTypeRule = VocabularyTypeRule+  { type_ :: !Text,+    description :: !(Maybe Text),+    frontmatter :: !VocabularyFrontmatterRules,+    pathPattern :: !(Maybe Text),+    resourceScheme :: !(Maybe Text),+    requireSchemaSection :: !Bool,+    schemaColumns :: ![Text],+    idPrefix :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)++instance FromDhall VocabularyTypeRule where+  autoWith _normalizer =+    genericAutoWith+      (Dhall.defaultInterpretOptions {Dhall.fieldModifier = stripTrailingUnderscore})+    where+      stripTrailingUnderscore fieldName =+        fromMaybe fieldName (Text.stripSuffix "_" fieldName)++-- | A field rule from either self-documenting schema generation, before value+-- vocabularies were added.+data PreviousFieldRule = PreviousFieldRule+  { field :: !Text,+    description :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data PreviousFrontmatterRules = PreviousFrontmatterRules+  { required :: ![PreviousFieldRule],+    recommended :: ![PreviousFieldRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++-- | The type-aware shape from EP-1, frozen before vocabularies and field-name+-- closure were added.+data TypeAwareProfileSpec = TypeAwareProfileSpec+  { name :: !Text,+    description :: !(Maybe Text),+    okfVersion :: !Text,+    frontmatter :: !PreviousFrontmatterRules,+    allowUnknownTypes :: !Bool,+    idField :: !(Maybe Text),+    types :: ![TypeAwareTypeRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data TypeAwareTypeRule = TypeAwareTypeRule+  { type_ :: !Text,+    description :: !(Maybe Text),+    frontmatter :: !PreviousFrontmatterRules,+    pathPattern :: !(Maybe Text),+    resourceScheme :: !(Maybe Text),+    requireSchemaSection :: !Bool,+    schemaColumns :: ![Text],+    idPrefix :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)++instance FromDhall TypeAwareTypeRule where+  autoWith _normalizer =+    genericAutoWith+      (Dhall.defaultInterpretOptions {Dhall.fieldModifier = stripTrailingUnderscore})+    where+      stripTrailingUnderscore fieldName =+        fromMaybe fieldName (Text.stripSuffix "_" fieldName)++-- | The self-documenting profile shape published immediately before+-- type-specific frontmatter rules. It is frozen as a compatibility decoder in+-- exactly the same way as the older 0.2.x shape below.+data DescribedProfileSpec = DescribedProfileSpec+  { name :: !Text,+    description :: !(Maybe Text),+    okfVersion :: !Text,+    frontmatter :: !PreviousFrontmatterRules,+    allowUnknownTypes :: !Bool,+    idField :: !(Maybe Text),+    types :: ![DescribedTypeRule]+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromDhall)++data DescribedTypeRule = DescribedTypeRule+  { type_ :: !Text,+    description :: !(Maybe Text),+    pathPattern :: !(Maybe Text),+    resourceScheme :: !(Maybe Text),+    requireSchemaSection :: !Bool,+    schemaColumns :: ![Text],+    idPrefix :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)++instance FromDhall DescribedTypeRule where+  autoWith _normalizer =+    genericAutoWith+      (Dhall.defaultInterpretOptions {Dhall.fieldModifier = stripTrailingUnderscore})+    where+      stripTrailingUnderscore fieldName =+        fromMaybe fieldName (Text.stripSuffix "_" fieldName)++emptyFrontmatterRules :: FrontmatterRules+emptyFrontmatterRules = FrontmatterRules {required = [], recommended = []}++upgradePreviousFrontmatter :: PreviousFrontmatterRules -> FrontmatterRules+upgradePreviousFrontmatter previous =+  FrontmatterRules+    { required = map upgradeField (previous ^. #required),+      recommended = map upgradeField (previous ^. #recommended)+    }+  where+    upgradeField rule =+      FieldRule+        { field = rule ^. #field,+          description = rule ^. #description,+          allowedValues = [],+          cardinality = Any,+          format = Nothing,+          elementFields = Nothing,+          reference = Nothing,+          when = Nothing+        }++upgradeConditionalProfileFrontmatter :: ConditionalProfileFrontmatterRules -> FrontmatterRules+upgradeConditionalProfileFrontmatter previous =+  FrontmatterRules+    { required = map upgradeField (previous ^. #required),+      recommended = map upgradeField (previous ^. #recommended)+    }+  where+    upgradeField rule =+      FieldRule+        { field = rule ^. #field,+          description = rule ^. #description,+          allowedValues = rule ^. #allowedValues,+          cardinality = rule ^. #cardinality,+          format = rule ^. #format,+          elementFields = upgradeNestedRules <$> rule ^. #elementFields,+          reference = Nothing,+          when = rule ^. #when+        }+    upgradeNestedRules rules =+      NestedRules+        { required = map upgradeNestedField (rules ^. #required),+          recommended = map upgradeNestedField (rules ^. #recommended)+        }+    upgradeNestedField rule =+      NestedFieldRule+        { field = rule ^. #field,+          description = rule ^. #description,+          allowedValues = rule ^. #allowedValues,+          cardinality = rule ^. #cardinality,+          format = rule ^. #format,+          when = rule ^. #when+        }++upgradeNestedProfileFrontmatter :: NestedProfileFrontmatterRules -> FrontmatterRules+upgradeNestedProfileFrontmatter previous =+  FrontmatterRules+    { required = map upgradeField (previous ^. #required),+      recommended = map upgradeField (previous ^. #recommended)+    }+  where+    upgradeField rule =+      FieldRule+        { field = rule ^. #field,+          description = rule ^. #description,+          allowedValues = rule ^. #allowedValues,+          cardinality = rule ^. #cardinality,+          format = rule ^. #format,+          elementFields = upgradeNestedProfileRules <$> rule ^. #elementFields,+          reference = Nothing,+          when = Nothing+        }+    upgradeNestedProfileRules rules =+      NestedRules+        { required = map upgradeNestedField (rules ^. #required),+          recommended = map upgradeNestedField (rules ^. #recommended)+        }+    upgradeNestedField rule =+      NestedFieldRule+        { field = rule ^. #field,+          description = rule ^. #description,+          allowedValues = rule ^. #allowedValues,+          cardinality = rule ^. #cardinality,+          format = rule ^. #format,+          when = Nothing+        }++upgradeFormatFrontmatter :: FormatFrontmatterRules -> FrontmatterRules+upgradeFormatFrontmatter previous =+  FrontmatterRules+    { required = map upgradeField (previous ^. #required),+      recommended = map upgradeField (previous ^. #recommended)+    }+  where+    upgradeField rule =+      FieldRule+        { field = rule ^. #field,+          description = rule ^. #description,+          allowedValues = rule ^. #allowedValues,+          cardinality = rule ^. #cardinality,+          format = rule ^. #format,+          elementFields = Nothing,+          reference = Nothing,+          when = Nothing+        }++upgradeCardinalityFrontmatter :: CardinalityFrontmatterRules -> FrontmatterRules+upgradeCardinalityFrontmatter previous =+  FrontmatterRules+    { required = map upgradeField (previous ^. #required),+      recommended = map upgradeField (previous ^. #recommended)+    }+  where+    upgradeField rule =+      FieldRule+        { field = rule ^. #field,+          description = rule ^. #description,+          allowedValues = rule ^. #allowedValues,+          cardinality = rule ^. #cardinality,+          format = Nothing,+          elementFields = Nothing,+          reference = Nothing,+          when = Nothing+        }++upgradeVocabularyFrontmatter :: VocabularyFrontmatterRules -> FrontmatterRules+upgradeVocabularyFrontmatter previous =+  FrontmatterRules+    { required = map upgradeField (previous ^. #required),+      recommended = map upgradeField (previous ^. #recommended)+    }+  where+    upgradeField rule =+      FieldRule+        { field = rule ^. #field,+          description = rule ^. #description,+          allowedValues = rule ^. #allowedValues,+          cardinality = Any,+          format = Nothing,+          elementFields = Nothing,+          reference = Nothing,+          when = Nothing+        }++upgradeConditionalProfile :: ConditionalProfileSpec -> ProfileSpec+upgradeConditionalProfile previous =+  ProfileSpec+    { name = previous ^. #name,+      description = previous ^. #description,+      okfVersion = previous ^. #okfVersion,+      frontmatter = upgradeConditionalProfileFrontmatter (previous ^. #frontmatter),+      allowUnknownTypes = previous ^. #allowUnknownTypes,+      allowUnknownFields = previous ^. #allowUnknownFields,+      idField = previous ^. #idField,+      types = map upgradeRule (previous ^. #types)+    }+  where+    upgradeRule rule =+      TypeRule+        { type_ = rule ^. #type_,+          description = rule ^. #description,+          frontmatter = upgradeConditionalProfileFrontmatter (rule ^. #frontmatter),+          pathPattern = rule ^. #pathPattern,+          resourceScheme = rule ^. #resourceScheme,+          requireSchemaSection = rule ^. #requireSchemaSection,+          schemaColumns = rule ^. #schemaColumns,+          idPrefix = rule ^. #idPrefix+        }++upgradeNestedProfile :: NestedProfileSpec -> ProfileSpec+upgradeNestedProfile previous =+  ProfileSpec+    { name = previous ^. #name,+      description = previous ^. #description,+      okfVersion = previous ^. #okfVersion,+      frontmatter = upgradeNestedProfileFrontmatter (previous ^. #frontmatter),+      allowUnknownTypes = previous ^. #allowUnknownTypes,+      allowUnknownFields = previous ^. #allowUnknownFields,+      idField = previous ^. #idField,+      types = map upgradeRule (previous ^. #types)+    }+  where+    upgradeRule rule =+      TypeRule+        { type_ = rule ^. #type_,+          description = rule ^. #description,+          frontmatter = upgradeNestedProfileFrontmatter (rule ^. #frontmatter),+          pathPattern = rule ^. #pathPattern,+          resourceScheme = rule ^. #resourceScheme,+          requireSchemaSection = rule ^. #requireSchemaSection,+          schemaColumns = rule ^. #schemaColumns,+          idPrefix = rule ^. #idPrefix+        }++upgradeFormatProfile :: FormatProfileSpec -> ProfileSpec+upgradeFormatProfile previous =+  ProfileSpec+    { name = previous ^. #name,+      description = previous ^. #description,+      okfVersion = previous ^. #okfVersion,+      frontmatter = upgradeFormatFrontmatter (previous ^. #frontmatter),+      allowUnknownTypes = previous ^. #allowUnknownTypes,+      allowUnknownFields = previous ^. #allowUnknownFields,+      idField = previous ^. #idField,+      types = map upgradeRule (previous ^. #types)+    }+  where+    upgradeRule rule =+      TypeRule+        { type_ = rule ^. #type_,+          description = rule ^. #description,+          frontmatter = upgradeFormatFrontmatter (rule ^. #frontmatter),+          pathPattern = rule ^. #pathPattern,+          resourceScheme = rule ^. #resourceScheme,+          requireSchemaSection = rule ^. #requireSchemaSection,+          schemaColumns = rule ^. #schemaColumns,+          idPrefix = rule ^. #idPrefix+        }++upgradeCardinalityProfile :: CardinalityProfileSpec -> ProfileSpec+upgradeCardinalityProfile previous =+  ProfileSpec+    { name = previous ^. #name,+      description = previous ^. #description,+      okfVersion = previous ^. #okfVersion,+      frontmatter = upgradeCardinalityFrontmatter (previous ^. #frontmatter),+      allowUnknownTypes = previous ^. #allowUnknownTypes,+      allowUnknownFields = previous ^. #allowUnknownFields,+      idField = previous ^. #idField,+      types = map upgradeRule (previous ^. #types)+    }+  where+    upgradeRule rule =+      TypeRule+        { type_ = rule ^. #type_,+          description = rule ^. #description,+          frontmatter = upgradeCardinalityFrontmatter (rule ^. #frontmatter),+          pathPattern = rule ^. #pathPattern,+          resourceScheme = rule ^. #resourceScheme,+          requireSchemaSection = rule ^. #requireSchemaSection,+          schemaColumns = rule ^. #schemaColumns,+          idPrefix = rule ^. #idPrefix+        }++upgradeVocabularyProfile :: VocabularyProfileSpec -> ProfileSpec+upgradeVocabularyProfile previous =+  ProfileSpec+    { name = previous ^. #name,+      description = previous ^. #description,+      okfVersion = previous ^. #okfVersion,+      frontmatter = upgradeVocabularyFrontmatter (previous ^. #frontmatter),+      allowUnknownTypes = previous ^. #allowUnknownTypes,+      allowUnknownFields = previous ^. #allowUnknownFields,+      idField = previous ^. #idField,+      types = map upgradeRule (previous ^. #types)+    }+  where+    upgradeRule rule =+      TypeRule+        { type_ = rule ^. #type_,+          description = rule ^. #description,+          frontmatter = upgradeVocabularyFrontmatter (rule ^. #frontmatter),+          pathPattern = rule ^. #pathPattern,+          resourceScheme = rule ^. #resourceScheme,+          requireSchemaSection = rule ^. #requireSchemaSection,+          schemaColumns = rule ^. #schemaColumns,+          idPrefix = rule ^. #idPrefix+        }++upgradeTypeAwareProfile :: TypeAwareProfileSpec -> ProfileSpec+upgradeTypeAwareProfile previous =+  ProfileSpec+    { name = previous ^. #name,+      description = previous ^. #description,+      okfVersion = previous ^. #okfVersion,+      frontmatter = upgradePreviousFrontmatter (previous ^. #frontmatter),+      allowUnknownTypes = previous ^. #allowUnknownTypes,+      allowUnknownFields = True,+      idField = previous ^. #idField,+      types = map upgradeRule (previous ^. #types)+    }+  where+    upgradeRule rule =+      TypeRule+        { type_ = rule ^. #type_,+          description = rule ^. #description,+          frontmatter = upgradePreviousFrontmatter (rule ^. #frontmatter),+          pathPattern = rule ^. #pathPattern,+          resourceScheme = rule ^. #resourceScheme,+          requireSchemaSection = rule ^. #requireSchemaSection,+          schemaColumns = rule ^. #schemaColumns,+          idPrefix = rule ^. #idPrefix+        }++upgradeDescribedProfile :: DescribedProfileSpec -> ProfileSpec+upgradeDescribedProfile described =+  ProfileSpec+    { name = described ^. #name,+      description = described ^. #description,+      okfVersion = described ^. #okfVersion,+      frontmatter = upgradePreviousFrontmatter (described ^. #frontmatter),+      allowUnknownTypes = described ^. #allowUnknownTypes,+      allowUnknownFields = True,+      idField = described ^. #idField,+      types = map upgradeRule (described ^. #types)+    }+  where+    upgradeRule rule =+      TypeRule+        { type_ = rule ^. #type_,+          description = rule ^. #description,+          frontmatter = emptyFrontmatterRules,+          pathPattern = rule ^. #pathPattern,+          resourceScheme = rule ^. #resourceScheme,+          requireSchemaSection = rule ^. #requireSchemaSection,+          schemaColumns = rule ^. #schemaColumns,+          idPrefix = rule ^. #idPrefix+        }++-- | Lift a 0.2.x profile into the current shape by attaching no descriptions+-- and empty type-specific frontmatter.+upgradeLegacyProfile :: LegacyProfileSpec -> ProfileSpec+upgradeLegacyProfile legacy =+  ProfileSpec+    { name = legacy ^. #name,+      description = Nothing,+      okfVersion = legacy ^. #okfVersion,+      frontmatter =+        FrontmatterRules+          { required = map undocumented (legacy ^. #frontmatter . #required),+            recommended = map undocumented (legacy ^. #frontmatter . #recommended)+          },+      allowUnknownTypes = legacy ^. #allowUnknownTypes,+      allowUnknownFields = True,+      idField = legacy ^. #idField,+      types = map upgradeRule (legacy ^. #types)+    }+  where+    undocumented key = FieldRule {field = key, description = Nothing, allowedValues = [], cardinality = Any, format = Nothing, elementFields = Nothing, reference = Nothing, when = Nothing}+    upgradeRule rule =+      TypeRule+        { type_ = rule ^. #type_,+          description = Nothing,+          frontmatter = emptyFrontmatterRules,+          pathPattern = rule ^. #pathPattern,+          resourceScheme = rule ^. #resourceScheme,+          requireSchemaSection = rule ^. #requireSchemaSection,+          schemaColumns = rule ^. #schemaColumns,+          idPrefix = rule ^. #idPrefix+        }++-- | Load and decode a Dhall profile descriptor from a file path. Any evaluation+-- or decoding failure is captured as a human-readable 'Left'.+--+-- The condition-aware shape, bounded-nested shape, EP-4 format shape, EP-3+-- cardinality shape, EP-2 vocabulary shape, type-aware EP-1 shape,+-- self-documenting shape, and okf 0.2.x shape are accepted by frozen fallback decoders and upgraded+-- with their no-op defaults. When every decoder fails, the /current/ decoder's+-- error is reported.+loadProfileFile :: FilePath -> IO (Either Text ProfileSpec)+loadProfileFile path = do+  current <- tryDecode (Dhall.inputFile auto path)+  case current of+    Right spec -> pure (Right spec)+    Left currentError -> do+      conditional <- tryDecode (Dhall.inputFile auto path)+      case conditional of+        Right conditionalSpec -> pure (Right (upgradeConditionalProfile conditionalSpec))+        Left _conditionalError -> do+          nested <- tryDecode (Dhall.inputFile auto path)+          case nested of+            Right nestedSpec -> pure (Right (upgradeNestedProfile nestedSpec))+            Left _nestedError -> do+              formatted <- tryDecode (Dhall.inputFile auto path)+              case formatted of+                Right formatSpec -> pure (Right (upgradeFormatProfile formatSpec))+                Left _formatError -> do+                  cardinality <- tryDecode (Dhall.inputFile auto path)+                  case cardinality of+                    Right cardinalitySpec -> pure (Right (upgradeCardinalityProfile cardinalitySpec))+                    Left _cardinalityError -> do+                      vocabulary <- tryDecode (Dhall.inputFile auto path)+                      case vocabulary of+                        Right vocabularySpec -> pure (Right (upgradeVocabularyProfile vocabularySpec))+                        Left _vocabularyError -> do+                          typeAware <- tryDecode (Dhall.inputFile auto path)+                          case typeAware of+                            Right typeAwareSpec -> pure (Right (upgradeTypeAwareProfile typeAwareSpec))+                            Left _typeAwareError -> do+                              described <- tryDecode (Dhall.inputFile auto path)+                              case described of+                                Right describedSpec -> pure (Right (upgradeDescribedProfile describedSpec))+                                Left _describedError -> do+                                  legacy <- tryDecode (Dhall.inputFile auto path)+                                  pure $ case legacy of+                                    Right legacySpec -> Right (upgradeLegacyProfile legacySpec)+                                    Left _legacyError -> Left currentError+  where+    -- The nine calls look identical but are inferred at distinct result types;+    -- @auto@ picks the corresponding current or frozen decoder.+    tryDecode :: IO a -> IO (Either Text a)+    tryDecode action =+      (Right <$> action)+        `catch` \(exception :: SomeException) -> pure (Left (Text.pack (show exception)))++-- | Does an already-evaluated Dhall expression decode as a profile? Tries the+-- current schema, then the condition-aware, bounded-nested, EP-4, EP-3, EP-2, EP-1,+-- self-documenting, and okf 0.2.x schemas,+-- so the published @okf-profiles@ package still enumerates. Uses+-- 'Dhall.rawInput', which normalizes and runs the decoder's extractor without+-- throwing, which is what lets registry enumeration be pure.+decodeProfileExpr :: Expr Src Void -> Maybe ProfileSpec+decodeProfileExpr expression =+  Dhall.rawInput Dhall.auto expression+    <|> fmap upgradeConditionalProfile (Dhall.rawInput Dhall.auto expression)+    <|> fmap upgradeNestedProfile (Dhall.rawInput Dhall.auto expression)+    <|> fmap upgradeFormatProfile (Dhall.rawInput Dhall.auto expression)+    <|> fmap upgradeCardinalityProfile (Dhall.rawInput Dhall.auto expression)+    <|> fmap upgradeVocabularyProfile (Dhall.rawInput Dhall.auto expression)+    <|> fmap upgradeTypeAwareProfile (Dhall.rawInput Dhall.auto expression)+    <|> fmap upgradeDescribedProfile (Dhall.rawInput Dhall.auto expression)+    <|> fmap upgradeLegacyProfile (Dhall.rawInput Dhall.auto expression)++-- | The description a profile attaches to a frontmatter key, looking in+-- @required@ first and then @recommended@. 'Nothing' when the key is+-- undocumented or absent from the profile entirely.+profileFieldDescription :: ProfileSpec -> Text -> Maybe Text+profileFieldDescription spec key =+  case [rule | rule <- rules, rule ^. #field == key] of+    (rule : _) -> rule ^. #description+    [] -> Nothing+  where+    rules = spec ^. #frontmatter . #required <> spec ^. #frontmatter . #recommended++-- | A malformed profile definition. The optional type is absent for profile+-- scope and present for a type-specific scope. The list name is @required@ or+-- @recommended@.+data ProfileDefinitionError+  = DuplicateTypeRule Text+  | DuplicateFieldRule (Maybe Text) Text Text+  | ConflictingFieldRequirement (Maybe Text) Text+  | UnsatisfiableVocabulary (Maybe Text) Text [Text] [Text]+  | ConflictingCardinality (Maybe Text) Text Cardinality Cardinality+  | ElementFieldsRequireList (Maybe Text) FieldPath Cardinality+  | InvalidFormatParameter FieldPath FieldFormat Text+  | ConflictingFieldFormat FieldPath FieldFormat FieldFormat+  | EmptyConditionValues (Maybe Text) FieldPath FieldPath+  | ConditionFieldNotDeclared (Maybe Text) FieldPath FieldPath+  | ConditionFieldNotScalar (Maybe Text) FieldPath FieldPath Cardinality+  | ConditionFieldOpenVocabulary (Maybe Text) FieldPath FieldPath+  | ConditionFieldHasUnreachableValues (Maybe Text) FieldPath FieldPath [Text] [Text]+  | SelfConditionalField (Maybe Text) FieldPath+  | InvalidReferencePrefix (Maybe Text) FieldPath Text+  | ReferencePrefixNotDeclared (Maybe Text) FieldPath Text+  | ReferenceRequiresIdField (Maybe Text) FieldPath+  | InvalidExternalReferenceScheme (Maybe Text) FieldPath Text+  | ConflictingReferencePrefix Text FieldPath Text Text+  | ReferenceWithFormat (Maybe Text) FieldPath FieldFormat+  deriving stock (Generic, Eq, Ord, Show)++data FieldRequirement = RecommendedField | RequiredField+  deriving stock (Eq, Ord, Show)++data CompiledCondition = CompiledCondition+  { field :: !Text,+    hasValue :: ![Text]+  }+  deriving stock (Generic, Eq, Show)++data PresenceClause = PresenceClause+  { requirement :: !FieldRequirement,+    condition :: !(Maybe CompiledCondition)+  }+  deriving stock (Generic, Eq, Show)++data EffectiveFieldRule = EffectiveFieldRule+  { presenceClauses :: ![PresenceClause],+    description :: !(Maybe Text),+    allowedValues :: ![Text],+    cardinality :: !Cardinality,+    format :: !(Maybe FieldFormat),+    elementFields :: !(Maybe (Map Text EffectiveFieldRule)),+    reference :: !(Maybe HandleReferenceRule)+  }+  deriving stock (Generic, Eq, Show)++-- | A raw profile whose authoring contradictions have been rejected and whose+-- effective profile-plus-type frontmatter rules have been precomputed.+data CompiledProfile = CompiledProfile+  { spec :: !ProfileSpec,+    baseRules :: !(Map Text EffectiveFieldRule),+    rulesByType :: !(Map Text (Map Text EffectiveFieldRule))+  }+  deriving stock (Generic, Eq, Show)++compiledProfileSpec :: CompiledProfile -> ProfileSpec+compiledProfileSpec compiled = compiled ^. #spec++compileProfile :: ProfileSpec -> Either (NonEmpty ProfileDefinitionError) CompiledProfile+compileProfile rawSpec =+  case definitionErrors of+    firstError : remainingErrors -> Left (firstError :| remainingErrors)+    [] ->+      Right+        CompiledProfile+          { spec = rawSpec,+            baseRules,+            rulesByType =+              Map.fromList+                [ (rule ^. #type_, mergeRules baseRules (compileRules (rule ^. #frontmatter)))+                | rule <- rawSpec ^. #types+                ]+          }+  where+    baseRules = compileRules (rawSpec ^. #frontmatter)+    typeNames = map (^. #type_) (rawSpec ^. #types)+    definitionErrors =+      List.sortOn definitionErrorKey $+        map DuplicateTypeRule (duplicates typeNames)+          <> scopeErrors Nothing (rawSpec ^. #frontmatter)+          <> concat+            [ scopeErrors (Just (rule ^. #type_)) (rule ^. #frontmatter)+            | rule <- rawSpec ^. #types+            ]+          <> vocabularyErrors+          <> cardinalityErrors+          <> nestedCardinalityErrors+          <> formatParameterErrors+          <> conflictingFormatErrors+          <> conditionDefinitionErrors+          <> referenceDefinitionErrors++    definitionErrorKey = \case+      DuplicateTypeRule ctype -> (1 :: Int, ctype, 0 :: Int, "", 0 :: Int)+      DuplicateFieldRule scope listName key ->+        let (scopeRank, typeName) = scopeKey scope+         in (scopeRank, typeName, listKey listName, key, 0)+      ConflictingFieldRequirement scope key ->+        let (scopeRank, typeName) = scopeKey scope+         in (scopeRank, typeName, 2, key, 0)+      UnsatisfiableVocabulary scope key _ _ ->+        let (scopeRank, typeName) = scopeKey scope+         in (scopeRank, typeName, 3, key, 0)+      ConflictingCardinality scope key _ _ ->+        let (scopeRank, typeName) = scopeKey scope+         in (scopeRank, typeName, 4, key, 0)+      ElementFieldsRequireList scope path cardinality ->+        let (scopeRank, typeName) = scopeKey scope+         in (scopeRank, typeName, 4, renderFieldPathKey path, fromEnum (cardinality == Scalar))+      InvalidFormatParameter path fieldFormat parameter ->+        (2, renderFieldPathKey path, 5, Text.pack (show fieldFormat), Text.length parameter)+      ConflictingFieldFormat path profileFormat typeFormat ->+        (2, renderFieldPathKey path, 6, Text.pack (show profileFormat), fromEnum (profileFormat == typeFormat))+      EmptyConditionValues scope target source -> conditionErrorKey scope target source 7+      ConditionFieldNotDeclared scope target source -> conditionErrorKey scope target source 8+      ConditionFieldNotScalar scope target source cardinality ->+        let (scopeRank, typeName) = scopeKey scope+         in (scopeRank, typeName, 9, renderFieldPathKey target <> ":" <> renderFieldPathKey source, fromEnum (cardinality == Scalar))+      ConditionFieldOpenVocabulary scope target source -> conditionErrorKey scope target source 10+      ConditionFieldHasUnreachableValues scope target source _ _ -> conditionErrorKey scope target source 11+      SelfConditionalField scope target ->+        let (scopeRank, typeName) = scopeKey scope+         in (scopeRank, typeName, 12, renderFieldPathKey target, 0)+      InvalidReferencePrefix scope target prefix -> referenceErrorKey scope target 13 prefix+      ReferencePrefixNotDeclared scope target prefix -> referenceErrorKey scope target 14 prefix+      ReferenceRequiresIdField scope target -> referenceErrorKey scope target 15 ""+      InvalidExternalReferenceScheme scope target scheme -> referenceErrorKey scope target 16 scheme+      ConflictingReferencePrefix ctype target profilePrefix typePrefix ->+        (1, ctype, 17, renderFieldPathKey target <> ":" <> profilePrefix, Text.length typePrefix)+      ReferenceWithFormat scope target fieldFormat -> referenceErrorKey scope target 18 (Text.pack (show fieldFormat))++    scopeKey Nothing = (0, "")+    scopeKey (Just ctype) = (1, ctype)+    listKey "required" = 0+    listKey _ = 1+    conditionErrorKey scope target source rank =+      let (scopeRank, typeName) = scopeKey scope+       in (scopeRank, typeName, rank, renderFieldPathKey target <> ":" <> renderFieldPathKey source, 0)+    referenceErrorKey scope target rank detail =+      let (scopeRank, typeName) = scopeKey scope+       in (scopeRank, typeName, rank, renderFieldPathKey target <> ":" <> detail, 0)++    scopeErrors scope FrontmatterRules {required, recommended} =+      [DuplicateFieldRule scope "required" key | key <- duplicates (map (^. #field) required)]+        <> [DuplicateFieldRule scope "recommended" key | key <- duplicates (map (^. #field) recommended)]+        <> [ ConflictingFieldRequirement scope key+           | key <- List.nub (List.sort (List.intersect (map (^. #field) required) (map (^. #field) recommended)))+           ]+        <> concatMap (nestedScopeErrors scope) (required <> recommended)++    nestedScopeErrors scope parentRule =+      case parentRule ^. #elementFields of+        Nothing -> []+        Just NestedRules {required, recommended} ->+          let qualify key = parentRule ^. #field <> "." <> key+           in [DuplicateFieldRule scope "nested required" (qualify key) | key <- duplicates (map (^. #field) required)]+                <> [DuplicateFieldRule scope "nested recommended" (qualify key) | key <- duplicates (map (^. #field) recommended)]+                <> [ ConflictingFieldRequirement scope (qualify key)+                   | key <- List.nub (List.sort (List.intersect (map (^. #field) required) (map (^. #field) recommended)))+                   ]++    duplicates = mapMaybe duplicateHead . List.group . List.sort+    duplicateHead (candidate : _ : _) = Just candidate+    duplicateHead _ = Nothing++    vocabularyErrors =+      [ UnsatisfiableVocabulary (Just (rule ^. #type_)) key profileValues typeValues+      | rule <- rawSpec ^. #types,+        let typeRules = compileRules (rule ^. #frontmatter),+        (key, (profileRule, typeRule)) <- Map.toAscList (Map.intersectionWith (,) baseRules typeRules),+        let profileValues = profileRule ^. #allowedValues+            typeValues = typeRule ^. #allowedValues,+        not (null profileValues),+        not (null typeValues),+        null (mergeVocabulary profileValues typeValues)+      ]+        <> [ UnsatisfiableVocabulary (Just (rule ^. #type_)) (parentKey <> "." <> nestedKey) profileValues typeValues+           | rule <- rawSpec ^. #types,+             let typeRules = compileRules (rule ^. #frontmatter),+             (parentKey, (profileRule, typeRule)) <- Map.toAscList (Map.intersectionWith (,) baseRules typeRules),+             Just profileNested <- [profileRule ^. #elementFields],+             Just typeNested <- [typeRule ^. #elementFields],+             (nestedKey, (profileNestedRule, typeNestedRule)) <- Map.toAscList (Map.intersectionWith (,) profileNested typeNested),+             let profileValues = profileNestedRule ^. #allowedValues+                 typeValues = typeNestedRule ^. #allowedValues,+             not (null profileValues),+             not (null typeValues),+             null (mergeVocabulary profileValues typeValues)+           ]++    cardinalityErrors =+      [ ConflictingCardinality (Just (rule ^. #type_)) key profileCardinality typeCardinality+      | rule <- rawSpec ^. #types,+        let typeRules = compileRules (rule ^. #frontmatter),+        (key, (profileRule, typeRule)) <- Map.toAscList (Map.intersectionWith (,) baseRules typeRules),+        let profileCardinality = profileRule ^. #cardinality+            typeCardinality = typeRule ^. #cardinality,+        profileCardinality /= Any,+        typeCardinality /= Any,+        profileCardinality /= typeCardinality+      ]+        <> [ ConflictingCardinality (Just (rule ^. #type_)) (parentKey <> "." <> nestedKey) profileCardinality typeCardinality+           | rule <- rawSpec ^. #types,+             let typeRules = compileRules (rule ^. #frontmatter),+             (parentKey, (profileRule, typeRule)) <- Map.toAscList (Map.intersectionWith (,) baseRules typeRules),+             Just profileNested <- [profileRule ^. #elementFields],+             Just typeNested <- [typeRule ^. #elementFields],+             (nestedKey, (profileNestedRule, typeNestedRule)) <- Map.toAscList (Map.intersectionWith (,) profileNested typeNested),+             let profileCardinality = profileNestedRule ^. #cardinality+                 typeCardinality = typeNestedRule ^. #cardinality,+             profileCardinality /= Any,+             typeCardinality /= Any,+             profileCardinality /= typeCardinality+           ]++    nestedCardinalityErrors =+      [ ElementFieldsRequireList scope (topLevelFieldPath (fieldRule ^. #field)) Scalar+      | (scope, rules) <- (Nothing, rawSpec ^. #frontmatter) : [(Just (rule ^. #type_), rule ^. #frontmatter) | rule <- rawSpec ^. #types],+        fieldRule <- rules ^. #required <> rules ^. #recommended,+        isJust (fieldRule ^. #elementFields),+        fieldRule ^. #cardinality == Scalar+      ]++    formatParameterErrors =+      [ InvalidFormatParameter (topLevelFieldPath (rule ^. #field)) fieldFormat parameter+      | rules <- (rawSpec ^. #frontmatter) : map (^. #frontmatter) (rawSpec ^. #types),+        rule <- rules ^. #required <> rules ^. #recommended,+        Just (fieldFormat, parameter) <- [invalidFormatParameter =<< rule ^. #format]+      ]+        <> [ InvalidFormatParameter (nestedDefinitionPath (rule ^. #field) (nestedRule ^. #field)) fieldFormat parameter+           | rules <- (rawSpec ^. #frontmatter) : map (^. #frontmatter) (rawSpec ^. #types),+             rule <- rules ^. #required <> rules ^. #recommended,+             Just nestedRules <- [rule ^. #elementFields],+             nestedRule <- nestedRules ^. #required <> nestedRules ^. #recommended,+             Just (fieldFormat, parameter) <- [invalidFormatParameter =<< nestedRule ^. #format]+           ]++    conflictingFormatErrors =+      [ ConflictingFieldFormat (topLevelFieldPath key) profileFormat typeFormat+      | rule <- rawSpec ^. #types,+        let typeRules = compileRules (rule ^. #frontmatter),+        (key, (profileRule, typeRule)) <- Map.toAscList (Map.intersectionWith (,) baseRules typeRules),+        Just profileFormat <- [profileRule ^. #format],+        Just typeFormat <- [typeRule ^. #format],+        mergeFieldFormat (Just profileFormat) (Just typeFormat) == Nothing+      ]+        <> [ ConflictingFieldFormat (nestedDefinitionPath parentKey nestedKey) profileFormat typeFormat+           | rule <- rawSpec ^. #types,+             let typeRules = compileRules (rule ^. #frontmatter),+             (parentKey, (profileRule, typeRule)) <- Map.toAscList (Map.intersectionWith (,) baseRules typeRules),+             Just profileNested <- [profileRule ^. #elementFields],+             Just typeNested <- [typeRule ^. #elementFields],+             (nestedKey, (profileNestedRule, typeNestedRule)) <- Map.toAscList (Map.intersectionWith (,) profileNested typeNested),+             Just profileFormat <- [profileNestedRule ^. #format],+             Just typeFormat <- [typeNestedRule ^. #format],+             mergeFieldFormat (Just profileFormat) (Just typeFormat) == Nothing+           ]++    conditionDefinitionErrors =+      conditionErrors Nothing Nothing (rawSpec ^. #frontmatter) baseRules+        <> concat+          [ let typeRules = compileRules (rule ^. #frontmatter)+                mergedRules = mergeRules baseRules typeRules+             in conditionErrors (Just (rule ^. #type_)) Nothing (rule ^. #frontmatter) mergedRules+          | rule <- rawSpec ^. #types+          ]++    conditionErrors scope parent rules effectiveRules =+      concatMap (fieldConditionErrors scope parent effectiveRules) (rules ^. #required <> rules ^. #recommended)+        <> concat+          [ case (rawRule ^. #elementFields, Map.lookup (rawRule ^. #field) effectiveRules >>= (^. #elementFields)) of+              (Just nestedRules, Just effectiveNestedRules) ->+                concatMap+                  (fieldConditionErrors scope (Just (rawRule ^. #field)) effectiveNestedRules)+                  (nestedRules ^. #required <> nestedRules ^. #recommended)+              _ -> []+          | rawRule <- rules ^. #required <> rules ^. #recommended+          ]++    fieldConditionErrors scope parent effectiveRules rawRule =+      case rawRule ^. #when of+        Nothing -> []+        Just FieldCondition {field = sourceKey, hasValue = conditionValues} ->+          let targetKey = rawRule ^. #field+              targetPath = maybe (topLevelFieldPath targetKey) (\parentKey -> nestedDefinitionPath parentKey targetKey) parent+              sourcePath = maybe (topLevelFieldPath sourceKey) (\parentKey -> nestedDefinitionPath parentKey sourceKey) parent+              normalizedValues = deduplicate conditionValues+              sourceErrors =+                case Map.lookup sourceKey effectiveRules of+                  Nothing -> [ConditionFieldNotDeclared scope targetPath sourcePath]+                  Just sourceRule ->+                    [ ConditionFieldNotScalar scope targetPath sourcePath (sourceRule ^. #cardinality)+                    | sourceRule ^. #cardinality /= Scalar+                    ]+                      <> [ ConditionFieldOpenVocabulary scope targetPath sourcePath+                         | null (sourceRule ^. #allowedValues)+                         ]+                      <> let unreachable = filter (`notElem` sourceRule ^. #allowedValues) normalizedValues+                          in [ ConditionFieldHasUnreachableValues scope targetPath sourcePath unreachable (sourceRule ^. #allowedValues)+                             | not (null (sourceRule ^. #allowedValues)),+                               not (null unreachable)+                             ]+           in [EmptyConditionValues scope targetPath sourcePath | null normalizedValues]+                <> [SelfConditionalField scope targetPath | targetKey == sourceKey]+                <> sourceErrors++    referenceDefinitionErrors =+      List.nub $+        concatMap rawReferenceErrors scopedRules+          <> concatMap mergedReferenceErrors (rawSpec ^. #types)+      where+        declaredPrefixes = mapMaybe (^. #idPrefix) (rawSpec ^. #types)+        scopedRules =+          (Nothing, rawSpec ^. #frontmatter)+            : [(Just (rule ^. #type_), rule ^. #frontmatter) | rule <- rawSpec ^. #types]++        rawReferenceErrors (scope, rules) =+          concatMap (fieldReferenceErrors scope) (rules ^. #required <> rules ^. #recommended)++        fieldReferenceErrors scope rule =+          case rule ^. #reference of+            Nothing -> []+            Just policy ->+              let path = topLevelFieldPath (rule ^. #field)+                  prefix = policy ^. #localPrefix+                  schemes = deduplicateSchemes (policy ^. #externalUriSchemes)+               in [InvalidReferencePrefix scope path prefix | not (validDocumentHandlePrefix prefix)]+                    <> [ReferencePrefixNotDeclared scope path prefix | prefix `notElem` declaredPrefixes]+                    <> [ReferenceRequiresIdField scope path | isNothing (rawSpec ^. #idField)]+                    <> [InvalidExternalReferenceScheme scope path scheme | scheme <- schemes, not (validUriScheme scheme)]+                    <> [ReferenceWithFormat scope path fieldFormat | Just fieldFormat <- [rule ^. #format]]++        mergedReferenceErrors typeRule =+          [ ConflictingReferencePrefix (typeRule ^. #type_) (topLevelFieldPath key) (profilePolicy ^. #localPrefix) (typePolicy ^. #localPrefix)+          | let typeFields = compileRules (typeRule ^. #frontmatter),+            (key, (profileRule, typeFieldRule)) <- Map.toAscList (Map.intersectionWith (,) baseRules typeFields),+            Just profilePolicy <- [profileRule ^. #reference],+            Just typePolicy <- [typeFieldRule ^. #reference],+            profilePolicy ^. #localPrefix /= typePolicy ^. #localPrefix+          ]+            <> [ ReferenceWithFormat (Just (typeRule ^. #type_)) (topLevelFieldPath key) fieldFormat+               | let typeFields = compileRules (typeRule ^. #frontmatter),+                 (key, (profileRule, typeFieldRule)) <- Map.toAscList (Map.intersectionWith (,) baseRules typeFields),+                 (referenceRule, formatRule) <- [(profileRule, typeFieldRule), (typeFieldRule, profileRule)],+                 isJust (referenceRule ^. #reference),+                 Just fieldFormat <- [formatRule ^. #format]+               ]++    renderFieldPathKey (FieldPath (firstSegment :| remainingSegments)) =+      Text.intercalate "." (map renderSegment (firstSegment : remainingSegments))+    renderSegment (FieldName name) = name+    renderSegment (ArrayIndex elementIndex) = Text.pack (show elementIndex)++compileRules :: FrontmatterRules -> Map Text EffectiveFieldRule+compileRules FrontmatterRules {required, recommended} =+  Map.fromList+    ( [ (rule ^. #field, compileFieldRule RequiredField rule)+      | rule <- required+      ]+        <> [ (rule ^. #field, compileFieldRule RecommendedField rule)+           | rule <- recommended+           ]+    )++compileFieldRule :: FieldRequirement -> FieldRule -> EffectiveFieldRule+compileFieldRule requirement rule =+  EffectiveFieldRule+    { presenceClauses = [PresenceClause requirement (compileCondition <$> rule ^. #when)],+      description = rule ^. #description,+      allowedValues = deduplicate (rule ^. #allowedValues),+      cardinality =+        case (rule ^. #elementFields, rule ^. #cardinality) of+          (Just _, Any) -> List+          (_, cardinality) -> cardinality,+      format = rule ^. #format,+      elementFields = compileNestedRules <$> rule ^. #elementFields,+      reference = compileReferenceRule <$> rule ^. #reference+    }++compileNestedRules :: NestedRules -> Map Text EffectiveFieldRule+compileNestedRules NestedRules {required, recommended} =+  Map.fromList+    ( [ (rule ^. #field, compileNestedFieldRule RequiredField rule)+      | rule <- required+      ]+        <> [ (rule ^. #field, compileNestedFieldRule RecommendedField rule)+           | rule <- recommended+           ]+    )++compileNestedFieldRule :: FieldRequirement -> NestedFieldRule -> EffectiveFieldRule+compileNestedFieldRule requirement rule =+  EffectiveFieldRule+    { presenceClauses = [PresenceClause requirement (compileCondition <$> rule ^. #when)],+      description = rule ^. #description,+      allowedValues = deduplicate (rule ^. #allowedValues),+      cardinality = rule ^. #cardinality,+      format = rule ^. #format,+      elementFields = Nothing,+      reference = Nothing+    }++mergeRules :: Map Text EffectiveFieldRule -> Map Text EffectiveFieldRule -> Map Text EffectiveFieldRule+mergeRules = Map.unionWith mergeEffectiveFieldRule++mergeEffectiveFieldRule :: EffectiveFieldRule -> EffectiveFieldRule -> EffectiveFieldRule+mergeEffectiveFieldRule profileRule typeRule =+  EffectiveFieldRule+    { presenceClauses = profileRule ^. #presenceClauses <> typeRule ^. #presenceClauses,+      description = typeRule ^. #description <|> profileRule ^. #description,+      allowedValues = mergeVocabulary (profileRule ^. #allowedValues) (typeRule ^. #allowedValues),+      cardinality = mergeCardinality (profileRule ^. #cardinality) (typeRule ^. #cardinality),+      format = fromMaybe (profileRule ^. #format) (mergeFieldFormat (profileRule ^. #format) (typeRule ^. #format)),+      elementFields = mergeElementFields (profileRule ^. #elementFields) (typeRule ^. #elementFields),+      reference = fromMaybe (profileRule ^. #reference) (mergeReferenceRule (profileRule ^. #reference) (typeRule ^. #reference))+    }++compileCondition :: FieldCondition -> CompiledCondition+compileCondition rawCondition =+  CompiledCondition+    { field = rawCondition ^. #field,+      hasValue = deduplicate (rawCondition ^. #hasValue)+    }++compileReferenceRule :: HandleReferenceRule -> HandleReferenceRule+compileReferenceRule policy =+  HandleReferenceRule+    { localPrefix = policy ^. #localPrefix,+      externalUriSchemes = map Text.toCaseFold (deduplicateSchemes (policy ^. #externalUriSchemes)),+      allowSelf = policy ^. #allowSelf+    }++mergeElementFields :: Maybe (Map Text EffectiveFieldRule) -> Maybe (Map Text EffectiveFieldRule) -> Maybe (Map Text EffectiveFieldRule)+mergeElementFields Nothing typeRules = typeRules+mergeElementFields profileRules Nothing = profileRules+mergeElementFields (Just profileRules) (Just typeRules) = Just (Map.unionWith mergeEffectiveFieldRule profileRules typeRules)++mergeReferenceRule :: Maybe HandleReferenceRule -> Maybe HandleReferenceRule -> Maybe (Maybe HandleReferenceRule)+mergeReferenceRule Nothing typePolicy = Just typePolicy+mergeReferenceRule profilePolicy Nothing = Just profilePolicy+mergeReferenceRule (Just profilePolicy) (Just typePolicy)+  | profilePolicy ^. #localPrefix == typePolicy ^. #localPrefix =+      Just . Just $+        HandleReferenceRule+          { localPrefix = profilePolicy ^. #localPrefix,+            externalUriSchemes =+              filter+                (`Set.member` Set.fromList (typePolicy ^. #externalUriSchemes))+                (profilePolicy ^. #externalUriSchemes),+            allowSelf = profilePolicy ^. #allowSelf && typePolicy ^. #allowSelf+          }+  | otherwise = Nothing++mergeFieldFormat :: Maybe FieldFormat -> Maybe FieldFormat -> Maybe (Maybe FieldFormat)+mergeFieldFormat Nothing typeFormat = Just typeFormat+mergeFieldFormat profileFormat Nothing = Just profileFormat+mergeFieldFormat (Just Uri) (Just typeFormat@(UriWithScheme _)) = Just (Just typeFormat)+mergeFieldFormat (Just profileFormat@(UriWithScheme _)) (Just Uri) = Just (Just profileFormat)+mergeFieldFormat profileFormat typeFormat+  | profileFormat == typeFormat = Just profileFormat+  | otherwise = Nothing++invalidFormatParameter :: FieldFormat -> Maybe (FieldFormat, Text)+invalidFormatParameter fieldFormat =+  case fieldFormat of+    UriWithScheme scheme+      | not (validUriScheme scheme) -> Just (fieldFormat, scheme)+    DocumentHandle prefix+      | not (validDocumentHandlePrefix prefix) -> Just (fieldFormat, prefix)+    _ -> Nothing++validUriScheme :: Text -> Bool+validUriScheme scheme =+  case Text.uncons scheme of+    Just (firstCharacter, rest) -> isAsciiLetter firstCharacter && Text.all validRest rest+    Nothing -> False+  where+    validRest character =+      isAsciiLetter character+        || ('0' <= character && character <= '9')+        || character `elem` ['+', '.', '-']++validDocumentHandlePrefix :: Text -> Bool+validDocumentHandlePrefix prefix =+  case parseDocumentId (prefix <> "-1") of+    Just documentId -> documentId ^. #prefix == prefix+    Nothing -> False++isAsciiLetter :: Char -> Bool+isAsciiLetter character = isAsciiLower character || isAsciiUpper character++mergeCardinality :: Cardinality -> Cardinality -> Cardinality+mergeCardinality Any typeCardinality = typeCardinality+mergeCardinality profileCardinality Any = profileCardinality+mergeCardinality profileCardinality _typeCardinality = profileCardinality++mergeVocabulary :: [Text] -> [Text] -> [Text]+mergeVocabulary [] typeValues = typeValues+mergeVocabulary profileValues [] = profileValues+mergeVocabulary profileValues typeValues =+  filter (`Set.member` Set.fromList typeValues) profileValues++deduplicate :: [Text] -> [Text]+deduplicate = go Set.empty+  where+    go _ [] = []+    go seen (value : rest)+      | value `Set.member` seen = go seen rest+      | otherwise = value : go (Set.insert value seen) rest++deduplicateSchemes :: [Text] -> [Text]+deduplicateSchemes = go Set.empty+  where+    go _ [] = []+    go seen (scheme : rest)+      | normalized `Set.member` seen = go seen rest+      | otherwise = scheme : go (Set.insert normalized seen) rest+      where+        normalized = Text.toCaseFold scheme++effectiveRulesForType :: CompiledProfile -> Text -> Map Text EffectiveFieldRule+effectiveRulesForType compiled ctype =+  Map.findWithDefault (compiled ^. #baseRules) ctype (compiled ^. #rulesByType)++profileFieldDescriptionForType :: CompiledProfile -> Text -> Text -> Maybe Text+profileFieldDescriptionForType compiled ctype key =+  Map.lookup key (effectiveRulesForType compiled ctype) >>= (^. #description)++-- | A parsed document handle: an ASCII-letter-led alphanumeric prefix and a+-- positive number, rendered as @PREFIX-N@.+data DocumentId = DocumentId+  { prefix :: !Text,+    number :: !Natural+  }+  deriving stock (Generic, Eq, Ord, Show)++-- | Parse a strict document handle. The prefix contains one or more ASCII+-- letters or digits and begins with a letter. It is followed by exactly one+-- hyphen and a positive decimal number with no leading zero. Thus @ADR-7@+-- parses, while @ADR-007@, @ADR-0@, @ADR-@, @-7@, @adr 7@, and+-- @ADR-7-extra@ do not.+parseDocumentId :: Text -> Maybe DocumentId+parseDocumentId raw =+  case Text.splitOn "-" raw of+    [prefixText, numberText]+      | validPrefix prefixText,+        validNumberText numberText ->+          case Text.Read.decimal numberText of+            Right (parsedNumber, remainder)+              | Text.null remainder,+                parsedNumber > 0 ->+                  Just (DocumentId prefixText parsedNumber)+            _ -> Nothing+    _ -> Nothing+  where+    validPrefix value =+      case Text.uncons value of+        Just (firstCharacter, rest) ->+          isAsciiLetter firstCharacter && Text.all isAsciiAlphaNumeric rest+        Nothing -> False+    validNumberText value =+      case Text.uncons value of+        Just (firstCharacter, rest) ->+          firstCharacter >= '1'+            && firstCharacter <= '9'+            && Text.all isAsciiDigit rest+        Nothing -> False+    isAsciiDigit character =+      character >= '0' && character <= '9'+    isAsciiAlphaNumeric character =+      isAsciiLetter character || isAsciiDigit character++-- | Render a document handle as @PREFIX-N@.+renderDocumentId :: DocumentId -> Text+renderDocumentId DocumentId {prefix, number} =+  prefix <> "-" <> Text.pack (show number)++-- | Every well-formed handle under the profile's ID field, paired with the+-- concept carrying it and sorted by prefix, number, then concept ID. Concepts+-- without a well-formed handle are omitted. A profile with no ID field yields+-- an empty list.+documentIdsInBundle :: ProfileSpec -> [Concept] -> [(DocumentId, ConceptId)]+documentIdsInBundle spec concepts =+  case spec ^. #idField of+    Nothing -> []+    Just fieldName ->+      List.sortOn+        (\(documentId, cid) -> (documentId, renderConceptId cid))+        [ (documentId, conceptIdOf concept)+        | concept <- concepts,+          Just (String rawDocumentId) <- [frontmatterLookup fieldName (conceptFrontmatter concept)],+          Just documentId <- [parseDocumentId rawDocumentId]+        ]++-- | Allocate one more than the highest document-ID number already used for the+-- given prefix, or number 1 when the prefix is unused. Gaps are deliberately+-- not filled: reusing a retired number could make an old reference silently+-- point at a different document.+nextDocumentId :: ProfileSpec -> [Concept] -> Text -> DocumentId+nextDocumentId spec concepts requestedPrefix =+  DocumentId+    { prefix = requestedPrefix,+      number = highestNumber + 1+    }+  where+    highestNumber =+      List.foldl'+        max+        0+        [ documentId ^. #number+        | (documentId, _) <- documentIdsInBundle spec concepts,+          documentId ^. #prefix == requestedPrefix+        ]++-- | One structural segment of a frontmatter path. EP-2 produces top-level+-- 'FieldName' paths; later bounded nested validation can append field names and+-- array indexes without encoding paths as ad hoc text.+data FieldPathSegment+  = FieldName Text+  | ArrayIndex Int+  deriving stock (Generic, Eq, Ord, Show)++newtype FieldPath = FieldPath+  { segments :: NonEmpty FieldPathSegment+  }+  deriving stock (Generic, Eq, Ord, Show)++topLevelFieldPath :: Text -> FieldPath+topLevelFieldPath key = FieldPath (FieldName key :| [])++nestedDefinitionPath :: Text -> Text -> FieldPath+nestedDefinitionPath parent child =+  FieldPath (FieldName parent :| [FieldName child])++nestedValuePath :: Text -> Int -> Text -> FieldPath+nestedValuePath parent elementIndex child =+  FieldPath (FieldName parent :| [ArrayIndex elementIndex, FieldName child])++nestedElementPath :: Text -> Int -> FieldPath+nestedElementPath parent elementIndex =+  FieldPath (FieldName parent :| [ArrayIndex elementIndex])++-- | A single deviation from a profile. Advisory by default at the CLI layer.+data ProfileViolation+  = -- | concept's @type@ is not listed in the profile and unknown types are disallowed+    TypeNotInProfile ConceptId Text+  | -- | a required frontmatter key is missing or empty (concept, key, activating condition)+    MissingProfileField ConceptId Text (Maybe FieldCondition)+  | -- | a recommended frontmatter key is missing under strict authoring+    MissingRecommendedProfileField ConceptId Text (Maybe FieldCondition)+  | -- | a required field is missing inside one list element record+    MissingNestedProfileField ConceptId FieldPath (Maybe FieldCondition)+  | -- | a recommended nested field is missing under strict authoring+    MissingRecommendedNestedProfileField ConceptId FieldPath (Maybe FieldCondition)+  | -- | a present value is outside the effective textual vocabulary+    ValueNotInVocabulary ConceptId FieldPath [Text] Value+  | -- | a present value has the wrong scalar/list shape+    CardinalityMismatch ConceptId FieldPath Cardinality Value+  | -- | a present value does not satisfy its named textual format+    ValueFormatMismatch ConceptId FieldPath FieldFormat Value+  | -- | a local reference has the right prefix but no valid owner in this bundle+    DanglingHandleReference ConceptId FieldPath Text+  | -- | a parsed local handle uses a prefix other than the declared target prefix+    ReferenceHandlePrefixMismatch ConceptId FieldPath Text Text+  | -- | a reference value is neither textual local handle nor valid absolute URI+    MalformedDocumentReference ConceptId FieldPath Value+  | -- | an absolute external URI uses a scheme the profile did not permit+    ExternalReferenceSchemeNotAllowed ConceptId FieldPath Text [Text]+  | -- | a local handle resolves to the concept carrying the reference+    SelfDocumentReference ConceptId FieldPath Text+  | -- | a closed profile does not declare this top-level field+    FieldNotInProfile ConceptId Text+  | -- | a declared list element is not an object record+    NestedElementNotRecord ConceptId FieldPath Value+  | -- | concept's file path does not match the type rule's pattern (concept, type, pattern)+    PathPatternMismatch ConceptId Text Text+  | -- | type rule requires a resource scheme but resource is absent (concept, type, scheme)+    MissingResource ConceptId Text Text+  | -- | resource present but its scheme is wrong (concept, expected scheme, actual resource)+    ResourceSchemeMismatch ConceptId Text Text+  | -- | required @# Schema@ section is absent (concept, type)+    MissingSchemaSection ConceptId Text+  | -- | @# Schema@ table columns do not match (concept, type, expected, actual)+    SchemaColumnsMismatch ConceptId Text [Text] [Text]+  | -- | type rule declares an @idPrefix@ but the concept has no handle (concept, type, prefix)+    MissingDocumentId ConceptId Text Text+  | -- | handle present but malformed for the declared prefix (concept, prefix, actual value)+    MalformedDocumentId ConceptId Text Text+  | -- | the same handle appears on more than one concept (handle, concept, other concept)+    DuplicateDocumentId Text ConceptId ConceptId+  deriving stock (Generic, Eq, Show)++-- | Check every concept against a compiled profile, returning all deviations.+-- Profile-wide rules apply even to unknown types; a matching type rule adds its+-- frontmatter rules and the existing type-specific structural checks.+validateProfile :: ValidationProfile -> CompiledProfile -> [Concept] -> [ProfileViolation]+validateProfile validationProfile compiled concepts =+  concatMap checkConcept sortedConcepts <> checkDuplicateDocumentIds spec sortedConcepts+  where+    spec = compiledProfileSpec compiled+    sortedConcepts = List.sortOn (renderConceptId . conceptIdOf) concepts+    rulesByType = [(rule ^. #type_, rule) | rule <- spec ^. #types]+    validDocumentIdIndex = buildValidDocumentIdIndex spec rulesByType sortedConcepts++    checkConcept concept =+      let cid = conceptIdOf concept+          ctype = conceptType concept+          fieldViolations = checkFields cid ctype concept <> checkUnknownFields cid ctype concept+       in case lookup ctype rulesByType of+            Nothing ->+              [TypeNotInProfile cid ctype | not (spec ^. #allowUnknownTypes)] <> fieldViolations+            Just rule ->+              fieldViolations+                <> checkPath cid ctype rule+                <> checkResource cid ctype rule concept+                <> checkSchema cid ctype rule concept+                <> checkDocumentId spec cid ctype rule concept++    checkFields cid ctype concept =+      concatMap checkField (Map.toAscList (effectiveRulesForType compiled ctype))+      where+        checkField (key, rule) =+          case evaluateFieldValue (rule ^. #cardinality) (frontmatterLookup key (conceptFrontmatter concept)) of+            FieldAbsent actual ->+              presenceViolations key rule+                <> maybe [] (vocabularyViolations key rule) actual+                <> maybe [] (formatViolations key rule) actual+                <> maybe [] (referenceViolations key rule) actual+            FieldPresent actual ->+              vocabularyViolations key rule actual+                <> formatViolations key rule actual+                <> referenceViolations key rule actual+                <> nestedViolations key rule actual+            FieldWrongShape actual -> [CardinalityMismatch cid (topLevelFieldPath key) (rule ^. #cardinality) actual]++        presenceViolations key rule =+          case applicablePresenceClause validationProfile (\sourceKey -> frontmatterLookup sourceKey (conceptFrontmatter concept)) rule of+            Nothing -> []+            Just clause ->+              [ case clause ^. #requirement of+                  RequiredField -> MissingProfileField cid key (conditionForViolation <$> clause ^. #condition)+                  RecommendedField -> MissingRecommendedProfileField cid key (conditionForViolation <$> clause ^. #condition)+              ]+        vocabularyViolations key rule actual =+          [ ValueNotInVocabulary cid (topLevelFieldPath key) (rule ^. #allowedValues) actual+          | not (null (rule ^. #allowedValues)),+            not (valueMatchesVocabulary (rule ^. #allowedValues) actual)+          ]+        formatViolations key rule actual =+          [ ValueFormatMismatch cid (topLevelFieldPath key) fieldFormat actual+          | Just fieldFormat <- [rule ^. #format],+            not (valueMatchesFormat fieldFormat actual)+          ]+        referenceViolations key rule actual =+          case rule ^. #reference of+            Nothing -> []+            Just policy -> validateReferenceValue validDocumentIdIndex cid (topLevelFieldPath key) policy actual++        nestedViolations parentKey parentRule = \case+          Array elementValues+            | Just nestedRules <- parentRule ^. #elementFields ->+                concat+                  [ case elementValue of+                      Object objectFields ->+                        concatMap+                          (checkNestedField parentKey elementIndex objectFields)+                          (Map.toAscList nestedRules)+                      _ -> [NestedElementNotRecord cid (nestedElementPath parentKey elementIndex) elementValue]+                  | (elementIndex, elementValue) <- zip [0 ..] (Vector.toList elementValues)+                  ]+          _ -> []++        checkNestedField parentKey elementIndex objectFields (key, rule) =+          let path = nestedValuePath parentKey elementIndex key+              actualValue = Aeson.KeyMap.lookup (Aeson.Key.fromText key) objectFields+           in case evaluateFieldValue (rule ^. #cardinality) actualValue of+                FieldAbsent actual ->+                  nestedPresenceViolations objectFields path rule+                    <> maybe [] (nestedVocabularyViolations path rule) actual+                    <> maybe [] (nestedFormatViolations path rule) actual+                FieldPresent actual ->+                  nestedVocabularyViolations path rule actual+                    <> nestedFormatViolations path rule actual+                FieldWrongShape actual -> [CardinalityMismatch cid path (rule ^. #cardinality) actual]++        nestedPresenceViolations objectFields path rule =+          case applicablePresenceClause validationProfile lookupSibling rule of+            Nothing -> []+            Just clause ->+              [ case clause ^. #requirement of+                  RequiredField -> MissingNestedProfileField cid path (conditionForViolation <$> clause ^. #condition)+                  RecommendedField -> MissingRecommendedNestedProfileField cid path (conditionForViolation <$> clause ^. #condition)+              ]+          where+            lookupSibling sourceKey = Aeson.KeyMap.lookup (Aeson.Key.fromText sourceKey) objectFields+        nestedVocabularyViolations path rule actual =+          [ ValueNotInVocabulary cid path (rule ^. #allowedValues) actual+          | not (null (rule ^. #allowedValues)),+            not (valueMatchesVocabulary (rule ^. #allowedValues) actual)+          ]+        nestedFormatViolations path rule actual =+          [ ValueFormatMismatch cid path fieldFormat actual+          | Just fieldFormat <- [rule ^. #format],+            not (valueMatchesFormat fieldFormat actual)+          ]++    checkUnknownFields cid ctype concept+      | spec ^. #allowUnknownFields = []+      | otherwise =+          [ FieldNotInProfile cid key+          | key <- frontmatterKeys (conceptFrontmatter concept),+            key `Set.notMember` allowedFields ctype+          ]++    allowedFields ctype =+      coreFrontmatterFields+        <> Map.keysSet (effectiveRulesForType compiled ctype)+        <> maybe Set.empty Set.singleton (spec ^. #idField)++-- | Index only handles that are valid owners under the compiled profile's raw+-- type declarations: the concept has a matching type rule, that rule declares+-- the parsed handle's exact prefix, and the profile declares the owning field.+-- Multiple owners are retained so a duplicate target still counts as existing;+-- the existing bundle-wide duplicate diagnostic remains authoritative.+buildValidDocumentIdIndex :: ProfileSpec -> [(Text, TypeRule)] -> [Concept] -> Map DocumentId [ConceptId]+buildValidDocumentIdIndex spec rulesByType concepts =+  case spec ^. #idField of+    Nothing -> Map.empty+    Just fieldName ->+      Map.fromListWith+        (flip (<>))+        [ (documentId, [conceptIdOf concept])+        | concept <- concepts,+          Just typeRule <- [lookup (conceptType concept) rulesByType],+          Just expectedPrefix <- [typeRule ^. #idPrefix],+          Just (String rawDocumentId) <- [frontmatterLookup fieldName (conceptFrontmatter concept)],+          Just documentId <- [parseDocumentId rawDocumentId],+          documentId ^. #prefix == expectedPrefix+        ]++validateReferenceValue :: Map DocumentId [ConceptId] -> ConceptId -> FieldPath -> HandleReferenceRule -> Value -> [ProfileViolation]+validateReferenceValue validOwners sourceConcept path policy = \case+  String rawReference -> validateReferenceText validOwners sourceConcept path policy rawReference+  Array values ->+    concat+      [ case value of+          String rawReference -> validateReferenceText validOwners sourceConcept (appendArrayIndex path elementIndex) policy rawReference+          _ -> [MalformedDocumentReference sourceConcept (appendArrayIndex path elementIndex) value]+      | (elementIndex, value) <- zip [0 ..] (Vector.toList values)+      ]+  actual -> [MalformedDocumentReference sourceConcept path actual]++validateReferenceText :: Map DocumentId [ConceptId] -> ConceptId -> FieldPath -> HandleReferenceRule -> Text -> [ProfileViolation]+validateReferenceText validOwners sourceConcept path policy rawReference =+  case parseDocumentId rawReference of+    Just documentId+      | documentId ^. #prefix /= policy ^. #localPrefix ->+          [ReferenceHandlePrefixMismatch sourceConcept path rawReference (policy ^. #localPrefix)]+      | otherwise ->+          case Map.lookup documentId validOwners of+            Nothing -> [DanglingHandleReference sourceConcept path rawReference]+            Just owners+              | not (policy ^. #allowSelf),+                sourceConcept `elem` owners ->+                  [SelfDocumentReference sourceConcept path rawReference]+              | otherwise -> []+    Nothing ->+      case parseURI (Text.unpack rawReference) of+        Just parsed+          | not (Text.null normalizedScheme), normalizedScheme `elem` policy ^. #externalUriSchemes -> []+          | not (Text.null normalizedScheme) ->+              [ ExternalReferenceSchemeNotAllowed+                  sourceConcept+                  path+                  normalizedScheme+                  (policy ^. #externalUriSchemes)+              ]+          | otherwise -> [MalformedDocumentReference sourceConcept path (String rawReference)]+          where+            normalizedScheme = Text.toCaseFold (Text.dropWhileEnd (== ':') (Text.pack (uriScheme parsed)))+        Nothing -> [MalformedDocumentReference sourceConcept path (String rawReference)]++appendArrayIndex :: FieldPath -> Int -> FieldPath+appendArrayIndex (FieldPath pathSegments) elementIndex =+  FieldPath (pathSegments <> (ArrayIndex elementIndex :| []))++applicablePresenceClause :: ValidationProfile -> (Text -> Maybe Value) -> EffectiveFieldRule -> Maybe PresenceClause+applicablePresenceClause validationProfile lookupValue rule =+  List.find applies requiredClauses+    <|> if validationProfile == StrictAuthoring then List.find applies recommendedClauses else Nothing+  where+    requiredClauses = filter ((== RequiredField) . (^. #requirement)) (rule ^. #presenceClauses)+    recommendedClauses = filter ((== RecommendedField) . (^. #requirement)) (rule ^. #presenceClauses)+    applies clause = maybe True conditionApplies (clause ^. #condition)+    conditionApplies condition =+      case lookupValue (condition ^. #field) of+        Just (String actual) -> actual `elem` condition ^. #hasValue+        _ -> False++conditionForViolation :: CompiledCondition -> FieldCondition+conditionForViolation condition =+  FieldCondition+    { field = condition ^. #field,+      hasValue = condition ^. #hasValue+    }++valueMatchesVocabulary :: [Text] -> Value -> Bool+valueMatchesVocabulary allowed = \case+  String value -> value `elem` allowed+  Array values -> all elementMatches (Vector.toList values)+  _ -> False+  where+    elementMatches (String value) = value `elem` allowed+    elementMatches _ = False++valueMatchesFormat :: FieldFormat -> Value -> Bool+valueMatchesFormat fieldFormat = \case+  String value -> textMatchesFormat fieldFormat value+  Array values -> all elementMatches (Vector.toList values)+  _ -> False+  where+    elementMatches (String value) = textMatchesFormat fieldFormat value+    elementMatches _ = False++textMatchesFormat :: FieldFormat -> Text -> Bool+textMatchesFormat fieldFormat value =+  case fieldFormat of+    Rfc3339Utc ->+      hasExtendedUtcShape value+        && isJust (iso8601ParseM (Text.unpack value) :: Maybe UTCTime)+    Date ->+      hasExtendedDateShape value+        && isJust (iso8601ParseM (Text.unpack value) :: Maybe Day)+    Uri -> isJust (parseURI (Text.unpack value))+    UriWithScheme expectedScheme ->+      case parseURI (Text.unpack value) of+        Just parsed ->+          Text.toCaseFold (Text.dropWhileEnd (== ':') (Text.pack (uriScheme parsed)))+            == Text.toCaseFold expectedScheme+        Nothing -> False+    DocumentHandle expectedPrefix ->+      case parseDocumentId value of+        Just documentId -> documentId ^. #prefix == expectedPrefix+        Nothing -> False++hasExtendedDateShape :: Text -> Bool+hasExtendedDateShape value =+  Text.length value == 10+    && Text.index value 4 == '-'+    && Text.index value 7 == '-'++hasExtendedUtcShape :: Text -> Bool+hasExtendedUtcShape value =+  Text.length value >= 20+    && Text.index value 4 == '-'+    && Text.index value 7 == '-'+    && Text.index value 10 == 'T'+    && Text.index value 13 == ':'+    && Text.index value 16 == ':'+    && Text.last value == 'Z'++data FieldValueEvaluation+  = FieldAbsent (Maybe Value)+  | FieldPresent Value+  | FieldWrongShape Value++evaluateFieldValue :: Cardinality -> Maybe Value -> FieldValueEvaluation+evaluateFieldValue _ Nothing = FieldAbsent Nothing+evaluateFieldValue Any (Just actual)+  | legacyValueIsPresent actual = FieldPresent actual+  | otherwise = FieldAbsent (Just actual)+evaluateFieldValue Scalar (Just actual) =+  case actual of+    String value+      | Text.null (Text.strip value) -> FieldAbsent (Just actual)+      | otherwise -> FieldPresent actual+    Number _ -> FieldPresent actual+    Bool _ -> FieldPresent actual+    _ -> FieldWrongShape actual+evaluateFieldValue List (Just actual) =+  case actual of+    Array values+      | null values -> FieldAbsent (Just actual)+      | otherwise -> FieldPresent actual+    _ -> FieldWrongShape actual++legacyValueIsPresent :: Value -> Bool+legacyValueIsPresent = \case+  String value -> not (Text.null (Text.strip value))+  Array values -> not (null values)+  _ -> False++-- | Check a profile-declared document ID for one concept.+checkDocumentId :: ProfileSpec -> ConceptId -> Text -> TypeRule -> Concept -> [ProfileViolation]+checkDocumentId spec cid ctype rule concept =+  case (spec ^. #idField, rule ^. #idPrefix) of+    (Just fieldName, Just expectedPrefix) ->+      case frontmatterLookup fieldName (conceptFrontmatter concept) of+        Just (String value)+          | not (Text.null (Text.strip value)) ->+              case parseDocumentId value of+                Just documentId+                  | documentId ^. #prefix == expectedPrefix -> []+                _ -> [MalformedDocumentId cid expectedPrefix value]+        _ -> [MissingDocumentId cid ctype expectedPrefix]+    _ -> []++-- | Check every non-empty value under the profile's ID field for bundle-wide+-- uniqueness. Concept IDs are sorted before grouping so output is deterministic.+checkDuplicateDocumentIds :: ProfileSpec -> [Concept] -> [ProfileViolation]+checkDuplicateDocumentIds spec concepts =+  case spec ^. #idField of+    Nothing -> []+    Just fieldName ->+      concatMap duplicateViolations (groupedHandles fieldName)+  where+    groupedHandles fieldName =+      List.groupBy+        (\(leftHandle, _) (rightHandle, _) -> leftHandle == rightHandle)+        (handles fieldName)+    handles fieldName =+      List.sortOn+        (\(handle, cid) -> (handle, renderConceptId cid))+        [ (handle, conceptIdOf concept)+        | concept <- concepts,+          Just (String handle) <- [frontmatterLookup fieldName (conceptFrontmatter concept)],+          not (Text.null (Text.strip handle))+        ]+    duplicateViolations ((handle, firstConcept) : duplicates) =+      [ DuplicateDocumentId handle firstConcept duplicateConcept+      | (_, duplicateConcept) <- duplicates+      ]+    duplicateViolations [] = []++-- | Project a concept's frontmatter (the document's @frontmatter@ field).+conceptFrontmatter :: Concept -> Frontmatter+conceptFrontmatter concept = conceptDocument concept ^. #frontmatter  -- | A type rule's @pathPattern@, when present, constrains where the concept's -- file may live.

@@ -0,0 +1,174 @@+{-# LANGUAGE PackageImports #-}++-- | Profile registries: discovery of the profiles a Dhall package publishes.+--+-- A /registry/ is nothing more than a Dhall expression that evaluates to a+-- record whose fields (possibly nested) are profile values. There is no+-- manifest and no metadata format; profiles are found structurally, by walking+-- the normalized record and asking of each field \"does this value decode as a+-- 'ProfileSpec'?\".+--+-- The published @okf-profiles@ package is already exactly this shape, so+-- 'loadRegistry' works against it unchanged.+module Okf.Profile.Registry+  ( -- * References+    RegistryRef (..),+    defaultRegistryReference,+    resolveRegistryRef,+    renderRegistryRef,++    -- * Enumeration+    RegistryEntry (..),+    loadRegistry,+    registryEntries,+    findRegistryEntry,+    rootExportLabel,+  )+where++import Control.Exception (SomeException, catch)+import Data.List qualified as List+import Data.Text qualified as Text+import Data.Text.IO qualified as Text.IO+import Data.Void (Void)+import Dhall qualified+import Dhall.Core (Expr (RecordLit), recordFieldValue)+import Dhall.Map qualified+import Dhall.Src (Src)+import Okf.Prelude+import Okf.Profile (ProfileSpec, decodeProfileExpr)+import System.Directory (doesDirectoryExist, doesFileExist)+import System.FilePath (takeDirectory, (</>))+import "generic-lens" Data.Generics.Labels ()++-- | How a registry reference is to be evaluated. A file must be evaluated with+-- its own directory as the import root, or its relative imports (such as+-- @./profiles/postgresql.dhall@) will not resolve.+data RegistryRef+  = -- | a Dhall file on disk+    RegistryFile !FilePath+  | -- | a raw Dhall expression, such as a hash-pinned URL+    RegistryExpression !Text+  deriving stock (Generic, Eq, Show)++-- | One profile published by a registry, under the dotted field path at which+-- it was found. The export path is empty when the registry reference is itself+-- a profile; 'rootExportLabel' is the display form for that case.+data RegistryEntry = RegistryEntry+  { export :: !Text,+    spec :: !ProfileSpec+  }+  deriving stock (Generic, Eq, Show)++-- | The built-in registry: the @okf-profiles@ package, pinned by tag /and/+-- integrity hash. Pinning gives Dhall's content-addressed cache something+-- stable to key on, so listing costs one network fetch ever, and a later+-- @okf-profiles@ release cannot silently change what okf reports. Moving to a+-- newer tag means changing the URL and the hash together.+defaultRegistryReference :: Text+defaultRegistryReference =+  "https://raw.githubusercontent.com/shinzui/okf-profiles/v0.4.2/package.dhall\+  \ sha256:39e79b65672439cde9c1271e3d92abf68ba1e2427541598e0d04de23e741f0cb"++-- | How an entry with an empty export path is displayed.+rootExportLabel :: Text+rootExportLabel = "(root)"++-- | Decide how to evaluate a registry reference: an existing file is evaluated+-- as a file, an existing directory holding @package.dhall@ resolves to that+-- file, and anything else is handed to Dhall verbatim as an expression. Only+-- the last case can reach the network, and only if the expression says so.+resolveRegistryRef :: Text -> IO RegistryRef+resolveRegistryRef reference = do+  let path = Text.unpack (Text.strip reference)+  isFile <- doesFileExist path+  if isFile+    then pure (RegistryFile path)+    else do+      isDirectory <- doesDirectoryExist path+      if isDirectory+        then do+          let packagePath = path </> "package.dhall"+          hasPackage <- doesFileExist packagePath+          pure+            ( if hasPackage+                then RegistryFile packagePath+                else RegistryExpression reference+            )+        else pure (RegistryExpression reference)++-- | Render a reference for display in messages.+renderRegistryRef :: RegistryRef -> Text+renderRegistryRef (RegistryFile path) = Text.pack path+renderRegistryRef (RegistryExpression expression) = expression++-- | Evaluate a registry and enumerate the profiles it publishes. Any parse,+-- import, type, or IO failure is captured as a human-readable 'Left', matching+-- how 'Okf.Profile.loadProfileFile' behaves.+loadRegistry :: RegistryRef -> IO (Either Text [RegistryEntry])+loadRegistry reference =+  (Right . registryEntries <$> evaluateRef reference)+    `catch` \(e :: SomeException) -> pure (Left (Text.pack (show e)))++-- | Parse, resolve imports, type check, and normalize a registry reference.+evaluateRef :: RegistryRef -> IO (Expr Src Void)+evaluateRef (RegistryFile path) = do+  contents <- Text.IO.readFile path+  Dhall.inputExprWithSettings+    ( Dhall.defaultInputSettings+        & set Dhall.rootDirectory (takeDirectory path)+        & set Dhall.sourceName path+    )+    contents+evaluateRef (RegistryExpression expression) = Dhall.inputExpr expression++-- | Every profile in a normalized registry expression, sorted by export path.+--+-- The rule, stated plainly: if the whole expression decodes as a profile, that+-- is the single entry (with an empty export path). Otherwise, if it is a record+-- literal that is not a schema record, visit each field under a dot-qualified+-- path and apply the same rule. Anything else contributes nothing.+--+-- Detection is \"decodes successfully\", not type equality: Dhall record+-- extraction ignores fields the decoder does not ask for, so a registry+-- publishing locally extended profiles still enumerates.+registryEntries :: Expr Src Void -> [RegistryEntry]+registryEntries expression = List.sortOn (^. #export) (walk "" expression)+  where+    walk path expr =+      case profileAt expr of+        Just profileSpec -> [RegistryEntry {export = path, spec = profileSpec}]+        Nothing ->+          case expr of+            RecordLit fields+              | not (isSchemaRecord fields) ->+                  concat+                    [ walk (qualify path label) (recordFieldValue entry)+                    | (label, entry) <- Dhall.Map.toList fields+                    ]+            _ -> []++    qualify "" label = label+    qualify path label = path <> "." <> label++    -- Dhall's record-completion idiom exports a schema as @{ Type, default }@.+    -- Those are not profiles, and today they are rejected anyway because no+    -- profile @default@ supplies @name@. Skipping them explicitly means a+    -- future default that gained a @name@ could not start showing up as a+    -- phantom profile.+    isSchemaRecord fields =+      isJust (Dhall.Map.lookup "Type" fields)+        && isJust (Dhall.Map.lookup "default" fields)++-- | Does this expression decode as a profile? Delegates to+-- 'Okf.Profile.decodeProfileExpr', which tries the current schema and then the+-- okf 0.2.x one, so a registry written before field descriptions existed — the+-- published @okf-profiles@ package included — still enumerates. It cannot+-- throw, which is what lets enumeration be a pure function over an+-- already-evaluated expression.+profileAt :: Expr Src Void -> Maybe ProfileSpec+profileAt = decodeProfileExpr++-- | Look up an entry by its exact export path.+findRegistryEntry :: Text -> [RegistryEntry] -> Maybe RegistryEntry+findRegistryEntry path = List.find ((== path) . (^. #export))

@@ -3,1090 +3,2567 @@ module Main (main) where  import Data.Aeson (object, toJSON, (.=))-import Data.Foldable (for_)-import Data.List qualified as List-import Data.Text qualified as Text-import Data.Text.IO qualified as Text.IO-import Okf.Bundle-import Okf.ConceptId-import Okf.Discovery-import Okf.Document-import Okf.Graph-import Okf.Index-import Okf.Log-import Okf.Prelude hiding (setField, (.=))-import Okf.Profile-import Okf.Validation-import System.Directory-  ( createDirectoryIfMissing,-    doesDirectoryExist,-    doesFileExist,-    getTemporaryDirectory,-    removeDirectoryRecursive,-  )-import System.Exit (exitFailure)-import System.FilePath (normalise, takeDirectory, (</>))-import System.IO.Temp (createTempDirectory)-import "generic-lens" Data.Generics.Labels ()--main :: IO ()-main = do-  results <--    sequence-      [ test "parse valid document with YAML frontmatter" testParseValidDocument,-        test "parse document with no frontmatter as empty-frontmatter body" testParseNoFrontmatter,-        test "reject unterminated frontmatter" testRejectUnterminatedFrontmatter,-        test "reject frontmatter that is not a YAML mapping" testRejectNonMappingFrontmatter,-        test "validate permissive profile with only type" testPermissiveValidation,-        test "validate strict profile requiring title description timestamp" testStrictValidation,-        test "validate rejects tags that are not a string list" testRejectInvalidTags,-        test "round-trip preserves semantic frontmatter and body" testRoundTrip,-        test "reject invalid concept id segment" testRejectInvalidConceptId,-        test "convert concept id tables/users to tables/users.md" testConceptIdToFilePath,-        testIO "walkBundle reports a structured IO error for a missing root" testWalkBundleMissingRoot,-        testIO "walkBundle skips index.md and log.md" testWalkBundleSkipsReserved,-        testIO "walkBundle discovers nested concept IDs" testWalkBundleDiscoversNestedConceptIds,-        testIO "discoverBundleRoots finds a directory holding index.md" testDiscoverIndexMd,-        testIO "discoverBundleRoots finds a directory holding a typed concept" testDiscoverTypedConcept,-        testIO "discoverBundleRoots ignores markdown without a type field" testDiscoverIgnoresPlainMarkdown,-        testIO "discoverBundleRoots does not descend into a bundle it found" testDiscoverPrunesNestedBundles,-        testIO "discoverBundleRoots skips hidden and build directories" testDiscoverSkipsNoise,-        testIO "discoverBundleRoots honours maxDepth" testDiscoverHonoursMaxDepth,-        testIO "discoverBundleRoots reports a fixture bundle as its own root" testDiscoverFixtureBundle,-        test "parseLog/serializeLog round-trips a canonical log" testLogRoundTrip,-        test "validateLog flags a non-ISO date heading" testValidateLogNonIsoDate,-        test "validateLog flags an empty date group" testValidateLogEmptyDay,-        test "validateLog flags out-of-order days" testValidateLogOutOfOrder,-        testIO "walkLogs discovers nested log.md files" testWalkLogsDiscoversNested,-        test "logStaleness flags a concept newer than its nearest log" testLogStalenessFlagsNewerConcept,-        test "logStaleness prefers the deepest enclosing log" testLogStalenessPrefersDeepestLog,-        test "appendLogEntry inserts newest-first and prepends within a day" testAppendLogEntry,-        testIO "generateIndex groups documents by frontmatter type" testGenerateIndexGroupsByType,-        testIO "extractLinks resolves relative and absolute bundle links" testExtractLinksResolveBundleLinks,-        testIO "extractLinks ignores external markdown URLs" testExtractLinksIgnoresExternalUrls,-        testIO "buildGraph includes only edges to existing concepts" testBuildGraphIncludesKnownEdges,-        testIO "writeBundleIndexes is deterministic" testWriteBundleIndexesDeterministic,-        testIO "fixture valid bundle validates and graphs expected edges" testFixtureValidBundle,-        testIO "fixture graph JSON shape is stable" testFixtureGraphJsonShape,-        testIO "fixture unterminated frontmatter reports parse error" testFixtureUnterminatedFrontmatter,-        testIO "fixture missing type reports validation error" testFixtureMissingType,-        test "frontmatter builder round-trips through serialize and parse" testFrontmatterBuilderRoundTrip,-        test "serializeDocument emits deterministic key order" testSerializeDeterministicKeyOrder,-        test "rendered concept link round-trips through extractConceptLinks" testConceptLinkRoundTrip,-        test "over-escaping relative links do not resolve inside bundle" testRejectOverEscapingRelativeLink,-        test "validateBundle reports a dangling reference" testValidateBundleDanglingReference,-        test "validateBundle accepts a bundle whose links all resolve" testValidateBundleAcceptsResolved,-        test "duplicateConceptIds finds repeated ids" testDuplicateConceptIds,-        test "conceptFromDocument derives typed fields from frontmatter" testConceptFromDocumentDerivesFields,-        testIO "writeBundle then walkBundle round-trips" testWriteBundleRoundTrip,-        testIO "fixture dangling link reports a bundle validation error" testFixtureDanglingLink,-        testIO "loadProfileFile decodes the postgresql fixture" testLoadProfileFixture,-        testIO "loadProfileFile decodes record-completed document ID rules" testLoadDocumentIdProfileFixture,-        test "parseDocumentId accepts only canonical handles" testParseDocumentId,-        testIO "documentIdsInBundle sorts handles by prefix and number" testDocumentIdsInBundle,-        test "nextDocumentId skips gaps and starts unused prefixes at one" testNextDocumentId,-        testIO "findConceptsByDocumentId resolves and reports duplicate handles" testFindConceptsByDocumentId,-        test "validateProfile accepts a conforming table concept" testProfileConformingTable,-        test "validateProfile flags a type not in the vocabulary" testProfileUnknownType,-        test "validateProfile flags a missing required field" testProfileMissingField,-        test "validateProfile flags a resource scheme mismatch" testProfileResourceMismatch,-        test "validateProfile flags a path pattern mismatch" testProfilePathMismatch,-        test "validateProfile flags a missing # Schema section" testProfileMissingSchema,-        test "validateProfile flags mismatched # Schema columns" testProfileSchemaColumnsMismatch,-        test "validateProfile accepts a conforming document ID" testProfileConformingDocumentId,-        test "validateProfile flags a missing document ID" testProfileMissingDocumentId,-        test "validateProfile flags malformed document IDs" testProfileMalformedDocumentIds,-        test "validateProfile flags duplicate document IDs" testProfileDuplicateDocumentIds,-        test "validateProfile document ID checks are off by default" testProfileDocumentIdsOffByDefault,-        test "schemaSectionColumns reads the header row of the Schema table" testSchemaSectionColumns,-        testIO "validateProfile reports the expected deviations for the fixture bundle" testProfileDeviationsFixture,-        testIO "validateProfile reports document ID fixture deviations" testDocumentIdDeviationsFixture-      ]-  unless (and results) exitFailure--test :: Text -> Either Text () -> IO Bool-test name assertion =-  case assertion of-    Right () -> do-      putStrLn ("PASS " <> Text.unpack name)-      pure True-    Left message -> do-      putStrLn ("FAIL " <> Text.unpack name <> ": " <> Text.unpack message)-      pure False--testIO :: Text -> IO (Either Text ()) -> IO Bool-testIO name assertion = do-  result <- assertion-  test name result--testParseValidDocument :: Either Text ()-testParseValidDocument = do-  document <- firstShow (parseDocument sampleDocument)-  assertEqual (Just (String "BigQuery Table")) (frontmatterLookup "type" (document ^. #frontmatter))-  assertEqual "# Schema\n\nBody text.\n" (body document)--testParseNoFrontmatter :: Either Text ()-testParseNoFrontmatter = do-  document <- firstShow (parseDocument "# Draft\n")-  assertEqual Nothing (frontmatterLookup "type" (document ^. #frontmatter))-  assertEqual "# Draft\n" (body document)--testRejectUnterminatedFrontmatter :: Either Text ()-testRejectUnterminatedFrontmatter =-  assertEqual (Left UnterminatedFrontmatter) (parseDocument "---\ntype: BigQuery Table\n")--testRejectNonMappingFrontmatter :: Either Text ()-testRejectNonMappingFrontmatter =-  assertEqual (Left FrontmatterNotMapping) (parseDocument "---\n- one\n- two\n---\nBody\n")--testPermissiveValidation :: Either Text ()-testPermissiveValidation = do-  document <- firstShow (parseDocument "---\ntype: BigQuery Table\n---\nBody\n")-  assertEqual [] (validateDocument PermissiveConformance document)--testStrictValidation :: Either Text ()-testStrictValidation = do-  document <- firstShow (parseDocument "---\ntype: BigQuery Table\n---\nBody\n")-  let errors = validateDocument StrictAuthoring document-  assertBool "missing title" (MissingRecommendedField "title" `List.elem` errors)-  assertBool "missing description" (MissingRecommendedField "description" `List.elem` errors)-  assertBool "missing timestamp" (MissingRecommendedField "timestamp" `List.elem` errors)--testRejectInvalidTags :: Either Text ()-testRejectInvalidTags = do-  document <- firstShow (parseDocument "---\ntype: BigQuery Table\ntags: orders\n---\nBody\n")-  assertEqual [FieldMustBeListOfText "tags"] (validateDocument PermissiveConformance document)--testRoundTrip :: Either Text ()-testRoundTrip = do-  document <- firstShow (parseDocument sampleDocument)-  assertEqual [] (validateDocument PermissiveConformance document)-  assertEqual [] (validateDocument StrictAuthoring document)-  reparsed <- firstShow (parseDocument (serializeDocument document))-  assertEqual (document ^. #frontmatter) (reparsed ^. #frontmatter)-  assertEqual (body document) (body reparsed)--testRejectInvalidConceptId :: Either Text ()-testRejectInvalidConceptId =-  assertEqual (Left (InvalidConceptIdSegment "-users")) (parseConceptId "tables/-users")--testConceptIdToFilePath :: Either Text ()-testConceptIdToFilePath = do-  conceptId <- firstShow (parseConceptId "tables/users")-  assertEqual "tables/users.md" (conceptIdToFilePath conceptId)--testWalkBundleMissingRoot :: IO (Either Text ())-testWalkBundleMissingRoot = do-  temporaryDirectory <- getTemporaryDirectory-  root <- createTempDirectory temporaryDirectory "okf-core-missing-parent"-  let missingRoot = root </> "missing"-  result <- walkBundle missingRoot-  removeDirectoryRecursive root-  pure-    ( case result of-        Left (BundleIoError path message)-          | path == missingRoot && "does not exist" `Text.isInfixOf` message -> Right ()-        other -> Left ("expected missing-root BundleIoError, got " <> Text.pack (show other))-    )--testWalkBundleSkipsReserved :: IO (Either Text ())-testWalkBundleSkipsReserved =-  withFixtureBundle-    ( \root -> do-        concepts <- readBundle root-        pure (assertEqual ["datasets/sales", "tables/customers", "tables/orders"] (renderConceptId . conceptIdOf <$> concepts))-    )--testWalkBundleDiscoversNestedConceptIds :: IO (Either Text ())-testWalkBundleDiscoversNestedConceptIds =-  withFixtureBundle-    ( \root -> do-        concepts <- readBundle root-        pure-          ( do-              expected <- firstShow (parseConceptId "tables/orders")-              assertBool "nested concept exists" (isJust (findConcept expected concepts))-          )-    )---- | Build a throwaway directory tree, run an action on it, and clean up.-withDiscoveryTree :: String -> [(FilePath, Text)] -> (FilePath -> IO a) -> IO a-withDiscoveryTree label files action = do-  temporaryDirectory <- getTemporaryDirectory-  root <- createTempDirectory temporaryDirectory label-  for_ files $ \(relativePath, content) -> do-    createDirectoryIfMissing True (root </> takeDirectory relativePath)-    Text.IO.writeFile (root </> relativePath) content-  result <- action root-  removeDirectoryRecursive root-  pure result--typedConcept :: Text -> Text-typedConcept titleText =-  Text.unlines ["---", "type: Table", "title: " <> titleText, "---", "", "# " <> titleText]--plainMarkdown :: Text-plainMarkdown = "# Just prose\n\nNo frontmatter here.\n"--testDiscoverIndexMd :: IO (Either Text ())-testDiscoverIndexMd =-  withDiscoveryTree "okf-discovery-index" [("kb/index.md", "# Index\n")] $ \root -> do-    found <- discoverBundleRoots defaultDiscoveryOptions root-    pure (assertEqual [normalise (root </> "kb")] found)--testDiscoverTypedConcept :: IO (Either Text ())-testDiscoverTypedConcept =-  withDiscoveryTree "okf-discovery-typed" [("kb/tables/orders.md", typedConcept "Orders")] $ \root -> do-    found <- discoverBundleRoots defaultDiscoveryOptions root-    pure (assertEqual [normalise (root </> "kb" </> "tables")] found)--testDiscoverIgnoresPlainMarkdown :: IO (Either Text ())-testDiscoverIgnoresPlainMarkdown =-  withDiscoveryTree-    "okf-discovery-plain"-    [("notes/README.md", plainMarkdown), ("notes/CHANGELOG.md", plainMarkdown)]-    $ \root -> do-      found <- discoverBundleRoots defaultDiscoveryOptions root-      pure (assertEqual [] found)--testDiscoverPrunesNestedBundles :: IO (Either Text ())-testDiscoverPrunesNestedBundles =-  withDiscoveryTree-    "okf-discovery-prune"-    [ ("kb/index.md", "# Index\n"),-      ("kb/tables/index.md", "# Tables\n"),-      ("kb/tables/orders.md", typedConcept "Orders")-    ]-    $ \root -> do-      found <- discoverBundleRoots defaultDiscoveryOptions root-      pure (assertEqual [normalise (root </> "kb")] found)--testDiscoverSkipsNoise :: IO (Either Text ())-testDiscoverSkipsNoise =-  withDiscoveryTree-    "okf-discovery-noise"-    [ (".hidden/index.md", "# Hidden\n"),-      ("dist-newstyle/index.md", "# Build output\n"),-      ("kb/index.md", "# Index\n")-    ]-    $ \root -> do-      found <- discoverBundleRoots defaultDiscoveryOptions root-      pure (assertEqual [normalise (root </> "kb")] found)--testDiscoverHonoursMaxDepth :: IO (Either Text ())-testDiscoverHonoursMaxDepth =-  withDiscoveryTree "okf-discovery-depth" [("a/b/c/index.md", "# Deep\n")] $ \root -> do-    shallow <- discoverBundleRoots defaultDiscoveryOptions {maxDepth = 2} root-    deep <- discoverBundleRoots defaultDiscoveryOptions {maxDepth = 3} root-    pure (assertEqual [] shallow >> assertEqual [normalise (root </> "a" </> "b" </> "c")] deep)--testDiscoverFixtureBundle :: IO (Either Text ())-testDiscoverFixtureBundle = do-  bundle <- fixturePath "valid-bundle"-  found <- discoverBundleRoots defaultDiscoveryOptions bundle-  pure (assertEqual [normalise bundle] found)--testLogRoundTrip :: Either Text ()-testLogRoundTrip = do-  let canonicalLog =-        Text.unlines-          [ "# Directory Update Log",-            "",-            "## 2026-06-23",-            "* **Update**: Refreshed [orders](tables/orders.md).",-            "* **Creation**: Added customers.",-            "",-            "## 2026-06-01",-            "* Deprecated a stale note."-          ]-      parsed = parseLog canonicalLog-      reparsed = parseLog (serializeLog parsed)-  assertEqual-    ( Log-        { logTitle = "Directory Update Log",-          logDays =-            [ LogDay-                { logDate = "2026-06-23",-                  logEntries =-                    [ LogEntry (Just "Update") "Refreshed [orders](tables/orders.md).",-                      LogEntry (Just "Creation") "Added customers."-                    ]-                },-              LogDay-                { logDate = "2026-06-01",-                  logEntries = [LogEntry Nothing "Deprecated a stale note."]-                }-            ]-        }-    )-    parsed-  assertEqual parsed reparsed--testValidateLogNonIsoDate :: Either Text ()-testValidateLogNonIsoDate =-  assertBool-    "expected LogDateNotIso"-    (LogDateNotIso "not-a-date" `List.elem` validateLog (parseLog "# Log\n\n## not-a-date\n* **Update**: oops\n"))--testValidateLogEmptyDay :: Either Text ()-testValidateLogEmptyDay =-  assertBool-    "expected LogEmptyDay"-    (LogEmptyDay "2026-06-23" `List.elem` validateLog (parseLog "# Log\n\n## 2026-06-23\n"))--testValidateLogOutOfOrder :: Either Text ()-testValidateLogOutOfOrder =-  assertBool-    "expected LogDaysOutOfOrder"-    ( LogDaysOutOfOrder "2026-01-01" "2026-06-23"-        `List.elem` validateLog (parseLog "# Log\n\n## 2026-01-01\n* Old.\n\n## 2026-06-23\n* New.\n")-    )--testWalkLogsDiscoversNested :: IO (Either Text ())-testWalkLogsDiscoversNested = do-  temporaryDirectory <- getTemporaryDirectory-  root <- createTempDirectory temporaryDirectory "okf-core-logs"-  createDirectoryIfMissing True (root </> "tables")-  Text.IO.writeFile (root </> "log.md") "# Root Log\n\n## 2026-06-23\n* Root entry.\n"-  Text.IO.writeFile (root </> "tables" </> "log.md") "# Tables Log\n\n## 2026-06-22\n* Tables entry.\n"-  result <- walkLogs root-  removeDirectoryRecursive root-  pure-    ( case result of-        Right logs -> assertEqual ["log.md", "tables/log.md"] (logSourcePath <$> logs)-        Left bundleError -> Left ("expected logs, got " <> Text.pack (show bundleError))-    )--testLogStalenessFlagsNewerConcept :: Either Text ()-testLogStalenessFlagsNewerConcept = do-  staleId <- parseTestConceptId "stale"-  staleConcept <- testConceptWithTimestamp "stale" "2026-06-23T00:00:00Z"-  currentConcept <- testConceptWithTimestamp "current" "2026-01-01T00:00:00Z"-  let logs = [LogFile "log.md" (parseLog "# Log\n\n## 2026-06-01\n* **Update**: logged.\n")]-  assertEqual-    [ LogStaleness-        { staleConcept = staleId,-          staleConceptDate = "2026-06-23",-          staleLogPath = Just "log.md",-          staleLogDate = Just "2026-06-01"-        }-    ]-    (logStaleness [staleConcept, currentConcept] logs)--testLogStalenessPrefersDeepestLog :: Either Text ()-testLogStalenessPrefersDeepestLog = do-  usersId <- parseTestConceptId "tables/users"-  usersConcept <- testConceptWithTimestamp "tables/users" "2026-06-21T00:00:00Z"-  let logs =-        [ LogFile "log.md" (parseLog "# Root Log\n\n## 2026-06-01\n* **Update**: root.\n"),-          LogFile "tables/log.md" (parseLog "# Tables Log\n\n## 2026-06-20\n* **Update**: tables.\n")-        ]-  assertEqual-    [ LogStaleness-        { staleConcept = usersId,-          staleConceptDate = "2026-06-21",-          staleLogPath = Just "tables/log.md",-          staleLogDate = Just "2026-06-20"-        }-    ]-    (logStaleness [usersConcept] logs)--testAppendLogEntry :: Either Text ()-testAppendLogEntry =-  assertEqual-    ( Log-        { logTitle = "Log",-          logDays =-            [ LogDay "2026-06-23" [LogEntry (Just "Update") "new"],-              LogDay "2026-06-01" [LogEntry (Just "Update") "prepended", LogEntry (Just "Creation") "old"]-            ]-        }-    )-    ( appendLogEntry-        "2026-06-01"-        (LogEntry (Just "Update") "prepended")-        ( appendLogEntry-            "2026-06-23"-            (LogEntry (Just "Update") "new")-            (Log "Log" [LogDay "2026-06-01" [LogEntry (Just "Creation") "old"]])-        )-    )--testGenerateIndexGroupsByType :: IO (Either Text ())-testGenerateIndexGroupsByType =-  withFixtureBundle-    ( \root -> do-        concepts <- readBundle root-        pure-          ( do-              orders <- requireConcept "tables/orders" concepts-              customers <- requireConcept "tables/customers" concepts-              let rendered = renderIndex [] [orders, customers]-              assertBool "has type heading" ("# BigQuery Table" `Text.isInfixOf` rendered)-              assertBool "has orders bullet" ("[Orders](orders.md) - Order records." `Text.isInfixOf` rendered)-              assertBool "has customers bullet" ("[Customers](customers.md) - Customer records." `Text.isInfixOf` rendered)-          )-    )--testExtractLinksResolveBundleLinks :: IO (Either Text ())-testExtractLinksResolveBundleLinks =-  withFixtureBundle-    ( \root -> do-        concepts <- readBundle root-        pure-          ( do-              orders <- requireConcept "tables/orders" concepts-              customers <- firstShow (parseConceptId "tables/customers")-              sales <- firstShow (parseConceptId "datasets/sales")-              let links = extractConceptLinks orders-              assertBool "absolute or ./ customers link" (customers `List.elem` links)-              assertBool "../ sales link" (sales `List.elem` links)-          )-    )--testExtractLinksIgnoresExternalUrls :: IO (Either Text ())-testExtractLinksIgnoresExternalUrls =-  withFixtureBundle-    ( \root -> do-        concepts <- readBundle root-        pure-          ( do-              orders <- requireConcept "tables/orders" concepts-              assertEqual 4 (length (extractConceptLinks orders))-          )-    )--testBuildGraphIncludesKnownEdges :: IO (Either Text ())-testBuildGraphIncludesKnownEdges =-  withFixtureBundle-    ( \root -> do-        concepts <- readBundle root-        pure-          ( do-              orders <- firstShow (parseConceptId "tables/orders")-              customers <- firstShow (parseConceptId "tables/customers")-              missing <- firstShow (parseConceptId "missing")-              let graph = buildGraph concepts-              assertEqual 3 (length (nodes graph))-              assertBool "known edge exists" (Edge {source = orders, target = customers} `List.elem` edges graph)-              assertBool "broken edge excluded" (Edge {source = orders, target = missing} `notElem` edges graph)-          )-    )--testWriteBundleIndexesDeterministic :: IO (Either Text ())-testWriteBundleIndexesDeterministic =-  withFixtureBundle-    ( \root -> do-        firstResult <- writeBundleIndexes root-        firstIndex <- Text.IO.readFile (root </> "tables" </> "index.md")-        secondResult <- writeBundleIndexes root-        secondIndex <- Text.IO.readFile (root </> "tables" </> "index.md")-        pure-          ( do-              firstShow firstResult-              firstShow secondResult-              assertEqual firstIndex secondIndex-              assertBool "tables index has BigQuery Table section" ("# BigQuery Table" `Text.isInfixOf` secondIndex)-          )-    )--testFixtureValidBundle :: IO (Either Text ())-testFixtureValidBundle = do-  root <- fixturePath "valid-bundle"-  concepts <- readBundle root-  pure-    ( do-        orders <- firstShow (parseConceptId "tables/orders")-        customers <- firstShow (parseConceptId "tables/customers")-        sales <- firstShow (parseConceptId "datasets/sales")-        assertEqual 4 (length concepts)-        assertEqual [] (foldMap (validateDocument PermissiveConformance . conceptDocument) concepts)-        let graph = buildGraph concepts-        assertBool "orders to customers" (Edge {source = orders, target = customers} `List.elem` edges graph)-        assertBool "orders to sales" (Edge {source = orders, target = sales} `List.elem` edges graph)-    )--testFixtureGraphJsonShape :: IO (Either Text ())-testFixtureGraphJsonShape = do-  root <- fixturePath "valid-bundle"-  concepts <- readBundle root-  orders <- requireConceptIO "tables/orders" concepts-  pure-    ( case filter (\Node {id = nodeId} -> nodeId == conceptIdOf orders) (nodes (buildGraph concepts)) of-        [ordersNode] ->-          assertEqual-            ( object-                [ "id" .= ("tables/orders" :: Text),-                  "label" .= ("Orders" :: Text),-                  "type" .= ("BigQuery Table" :: Text),-                  "description" .= Just ("Order fact table." :: Text),-                  "resource" .= Just ("bigquery://analytics.tables.orders" :: Text),-                  "tags" .= ["orders" :: Text, "sales"]-                ]-            )-            (toJSON ordersNode)-        other -> Left ("expected one orders node, got " <> Text.pack (show (length other)))-    )--testFixtureUnterminatedFrontmatter :: IO (Either Text ())-testFixtureUnterminatedFrontmatter = do-  root <- fixturePath "invalid-unterminated-frontmatter"-  result <- walkBundle root-  pure-    ( case result of-        Left (InvalidConceptDocument "broken.md" UnterminatedFrontmatter) -> Right ()-        other -> Left ("expected unterminated frontmatter error, got " <> Text.pack (show other))-    )--testFixtureMissingType :: IO (Either Text ())-testFixtureMissingType = do-  root <- fixturePath "invalid-missing-type"-  concepts <- readBundle root-  pure-    ( do-        assertEqual 1 (length concepts)-        case foldMap (validateDocument PermissiveConformance . conceptDocument) concepts of-          [MissingRequiredField "type"] -> Right ()-          other -> Left ("expected missing type error, got " <> Text.pack (show other))-    )--testFrontmatterBuilderRoundTrip :: Either Text ()-testFrontmatterBuilderRoundTrip = do-  let frontmatterValue =-        setField "version" (String "0.2.0")-          . setTags ["orders", "sales"]-          . setResource "bigquery://analytics.tables.orders"-          $ okfCommon-            OkfCommon-              { commonType = "BigQuery Table",-                commonTitle = Just "Orders",-                commonDescription = Just "Order fact table.",-                commonTimestamp = Just "2026-06-16T00:00:00Z"-              }-      original = OKFDocument frontmatterValue "# Orders\n\nBody text.\n"-  reparsed <- firstShow (parseDocument (serializeDocument original))-  assertEqual (original ^. #frontmatter) (reparsed ^. #frontmatter)-  assertEqual (body original) (body reparsed)--testSerializeDeterministicKeyOrder :: Either Text ()-testSerializeDeterministicKeyOrder = do-  let frontmatterValue =-        setField "zeta" (String "z")-          . setField "alpha" (String "a")-          . setTags ["t"]-          . setResource "res://x"-          . setType "Recipe"-          . setTimestamp "2026-06-16T00:00:00Z"-          . setDescription "Desc"-          . setTitle "Demo"-          $ emptyFrontmatter-      rendered = serializeDocument (OKFDocument frontmatterValue "# Demo\n")-      expectedOrder =-        ["type:", "title:", "description:", "timestamp:", "resource:", "tags:", "alpha:", "zeta:"]-  keyIndices <- traverse (\key -> maybe (Left ("missing key " <> key)) Right (substringIndex key rendered)) expectedOrder-  assertBool ("keys not in deterministic order: " <> Text.pack (show keyIndices)) (strictlyIncreasing keyIndices)--testConceptLinkRoundTrip :: Either Text ()-testConceptLinkRoundTrip = do-  sourceId <- parseTestConceptId "recipes/haskell-library-repo"-  let targetStrings = ["orders", "modules/nix-haskell-flake", "refs/source-system.v1"]-  mapM_-    ( \rawTarget -> do-        targetId <- parseTestConceptId rawTarget-        let extracted = extractFromBodyLinkingTo sourceId targetId-        assertEqual [targetId] extracted-    )-    targetStrings--parseTestConceptId :: Text -> Either Text ConceptId-parseTestConceptId rawId =-  first (\err -> "bad concept id " <> rawId <> ": " <> Text.pack (show err)) (parseConceptId rawId)--extractFromBodyLinkingTo :: ConceptId -> ConceptId -> [ConceptId]-extractFromBodyLinkingTo sourceId targetId =-  extractConceptLinks-    (conceptFromDocument sourceId (OKFDocument (setType "Test" emptyFrontmatter) ("See " <> renderConceptLink targetId "link" <> ".\n")))--testRejectOverEscapingRelativeLink :: Either Text ()-testRejectOverEscapingRelativeLink = do-  sourceId <- parseTestConceptId "a/b/source"-  targetId <- parseTestConceptId "tables/orders"-  let concept =-        conceptFromDocument-          sourceId-          (OKFDocument (setType "Test" emptyFrontmatter) "[Escapes](../../../tables/orders.md)\n")-  assertEqual [] (extractConceptLinks concept)-  assertEqual [] (validateBundle PermissiveConformance [concept, targetConcept targetId])-  where-    targetConcept targetId =-      conceptFromDocument-        targetId-        (OKFDocument (setType "Test" emptyFrontmatter) "# Orders\n")--testValidateBundleDanglingReference :: Either Text ()-testValidateBundleDanglingReference = do-  aId <- parseTestConceptId "a"-  bId <- parseTestConceptId "b"-  conceptA <- testConcept "a" ("See " <> renderConceptLink bId "b" <> ".\n")-  assertEqual [DanglingReference aId bId] (validateBundle StrictAuthoring [conceptA])--testValidateBundleAcceptsResolved :: Either Text ()-testValidateBundleAcceptsResolved = do-  bId <- parseTestConceptId "b"-  conceptA <- testConcept "a" ("See " <> renderConceptLink bId "b" <> ".\n")-  conceptB <- testConcept "b" "Standalone.\n"-  assertEqual [] (validateBundle StrictAuthoring [conceptA, conceptB])--testDuplicateConceptIds :: Either Text ()-testDuplicateConceptIds = do-  aId <- parseTestConceptId "a"-  conceptA <- testConcept "a" "First.\n"-  conceptAAgain <- testConcept "a" "Second.\n"-  assertEqual [aId] (duplicateConceptIds [conceptA, conceptAAgain])---- | Build an in-memory concept via the public 'conceptFromDocument' constructor,--- so its typed fields are derived from the frontmatter and cannot diverge.--- Includes all StrictAuthoring fields so per-document validation passes and--- bundle-level checks can be isolated.-testConcept :: Text -> Text -> Either Text Concept-testConcept rawId bodyText = do-  conceptId <- parseTestConceptId rawId-  let frontmatterValue =-        okfCommon-          OkfCommon-            { commonType = "Test",-              commonTitle = Just "Title",-              commonDescription = Just "Description",-              commonTimestamp = Just "2026-06-16T00:00:00Z"-            }-  pure (conceptFromDocument conceptId (OKFDocument frontmatterValue bodyText))--testConceptWithTimestamp :: Text -> Text -> Either Text Concept-testConceptWithTimestamp rawId timestamp = do-  conceptId <- parseTestConceptId rawId-  let frontmatterValue =-        okfCommon-          OkfCommon-            { commonType = "Test",-              commonTitle = Just "Title",-              commonDescription = Just "Description",-              commonTimestamp = Just timestamp-            }-  pure (conceptFromDocument conceptId (OKFDocument frontmatterValue "# Test\n"))--testConceptFromDocumentDerivesFields :: Either Text ()-testConceptFromDocumentDerivesFields = do-  conceptId <- parseTestConceptId "tables/orders"-  let frontmatterValue =-        okfCommon-          OkfCommon-            { commonType = "BigQuery Table",-              commonTitle = Just "Orders",-              commonDescription = Nothing,-              commonTimestamp = Nothing-            }-      concept = conceptFromDocument conceptId (OKFDocument frontmatterValue "# Orders\n")-  assertEqual "BigQuery Table" (conceptType concept)-  assertEqual (Just "Orders") (conceptTitle concept)-  assertEqual "tables/orders.md" (conceptSourcePath concept)--testWriteBundleRoundTrip :: IO (Either Text ())-testWriteBundleRoundTrip = do-  temporaryDirectory <- getTemporaryDirectory-  root <- createTempDirectory temporaryDirectory "okf-core-writebundle"-  let buildConcepts = do-        orders <- testConcept "tables/orders" "# Orders\n\nOrder records.\n"-        customers <- testConcept "tables/customers" "# Customers\n\nCustomer records.\n"-        pure [orders, customers]-  case buildConcepts of-    Left message -> do-      removeDirectoryRecursive root-      pure (Left message)-    Right concepts -> do-      writeBundle root concepts-      recovered <- readBundle root-      removeDirectoryRecursive root-      pure-        ( do-            assertEqual-              (List.sort (renderConceptId . conceptIdOf <$> concepts))-              (List.sort (renderConceptId . conceptIdOf <$> recovered))-            assertEqual-              (List.sort ((body . conceptDocument) <$> concepts))-              (List.sort ((body . conceptDocument) <$> recovered))-        )--testFixtureDanglingLink :: IO (Either Text ())-testFixtureDanglingLink = do-  root <- fixturePath "invalid-dangling-link"-  concepts <- readBundle root-  pure-    ( case validateBundle PermissiveConformance concepts of-        errs-          | any isDangling errs -> Right ()-          | otherwise -> Left ("expected a DanglingReference, got: " <> Text.pack (show errs))-    )-  where-    isDangling DanglingReference {} = True-    isDangling _ = False---- | Resolve a fixture file path regardless of whether tests run from the repo--- root or the package directory (mirrors 'fixturePath' for files).-fixtureFilePath :: FilePath -> IO FilePath-fixtureFilePath name = findExisting candidates-  where-    candidates =-      [ "okf-core" </> "test" </> "fixtures" </> name,-        "test" </> "fixtures" </> name-      ]-    findExisting [] = fail ("fixture file not found: " <> name)-    findExisting (candidate : rest) = do-      exists <- doesFileExist candidate-      if exists then pure candidate else findExisting rest---- | Milestone 1: the Dhall descriptor round-trips into a 'ProfileSpec'.-testLoadProfileFixture :: IO (Either Text ())-testLoadProfileFixture = do-  path <- fixtureFilePath "profiles/postgresql.dhall"-  result <- loadProfileFile path-  pure $ case result of-    Left err -> Left ("failed to load profile: " <> err)-    Right spec -> do-      assertEqual "shinzui-postgresql" (spec ^. #name)-      assertEqual False (spec ^. #allowUnknownTypes)-      assertEqual ["type", "title"] (spec ^. #frontmatter . #required)-      assertEqual-        ["PostgreSQL Schema", "PostgreSQL Table", "PostgreSQL View"]-        (map (^. #type_) (spec ^. #types))--testLoadDocumentIdProfileFixture :: IO (Either Text ())-testLoadDocumentIdProfileFixture = do-  path <- fixtureFilePath "profiles/decisions.dhall"-  result <- loadProfileFile path-  pure $ case result of-    Left err -> Left ("failed to load document ID profile: " <> err)-    Right spec -> do-      assertEqual (Just "docId") (spec ^. #idField)-      assertEqual [Just "ADR"] (map (^. #idPrefix) (spec ^. #types))--testParseDocumentId :: Either Text ()-testParseDocumentId = do-  assertEqual-    (Just (DocumentId {prefix = "ADR", number = 7}))-    (parseDocumentId "ADR-7")-  mapM_-    (\invalid -> assertEqual Nothing (parseDocumentId invalid))-    ["ADR-007", "ADR-0", "ADR-", "-7", "ADR 7", "ADR-7-extra"]-  assertEqual (Just "ADR-7") (renderDocumentId <$> parseDocumentId "ADR-7")--testDocumentIdsInBundle :: IO (Either Text ())-testDocumentIdsInBundle = do-  descriptorPath <- fixtureFilePath "profiles/decisions.dhall"-  loaded <- loadProfileFile descriptorPath-  root <- fixturePath "doc-ids"-  concepts <- readBundle root-  pure $ case loaded of-    Left err -> Left ("failed to load document ID profile: " <> err)-    Right spec -> do-      useMarkdown <- parseTestConceptId "decisions/use-markdown"-      usePostgres <- parseTestConceptId "decisions/use-postgres"-      adoptOkf <- parseTestConceptId "decisions/adopt-okf"-      assertEqual-        [ (DocumentId "ADR" 1, useMarkdown),-          (DocumentId "ADR" 2, usePostgres),-          (DocumentId "ADR" 3, adoptOkf)-        ]-        (documentIdsInBundle spec concepts)--testNextDocumentId :: Either Text ()-testNextDocumentId = do-  firstConcept <--    profileConcept-      "decisions/first"-      [("type", String "Decision Record"), ("title", String "First"), ("docId", String "ADR-1")]-      "# First\n"-  thirdConcept <--    profileConcept-      "decisions/third"-      [("type", String "Decision Record"), ("title", String "Third"), ("docId", String "ADR-3")]-      "# Third\n"-  let concepts = [firstConcept, thirdConcept]-  assertEqual (DocumentId "ADR" 4) (nextDocumentId testDocumentIdProfileSpec concepts "ADR")-  assertEqual (DocumentId "RFC" 1) (nextDocumentId testDocumentIdProfileSpec concepts "RFC")--testFindConceptsByDocumentId :: IO (Either Text ())-testFindConceptsByDocumentId = do-  validRoot <- fixturePath "doc-ids"-  validConcepts <- readBundle validRoot-  deviationRoot <- fixturePath "doc-id-deviations"-  deviationConcepts <- readBundle deviationRoot-  pure $ do-    usePostgres <- parseTestConceptId "decisions/use-postgres"-    firstId <- parseTestConceptId "decisions/first"-    secondId <- parseTestConceptId "decisions/second"-    assertEqual-      [usePostgres]-      (conceptIdOf <$> findConceptsByDocumentId Nothing "ADR-2" validConcepts)-    assertEqual-      [firstId, secondId]-      (conceptIdOf <$> findConceptsByDocumentId (Just "docId") "ADR-1" deviationConcepts)---- | A standalone profile literal so the validation tests do not depend on the--- Dhall fixture. One rule: PostgreSQL Table, fully constrained.-testProfileSpec :: ProfileSpec-testProfileSpec =-  ProfileSpec-    { name = "test-postgresql",-      okfVersion = "0.1",-      frontmatter = FrontmatterRules {required = ["type", "title"], recommended = []},-      allowUnknownTypes = False,-      idField = Nothing,-      types =-        [ TypeRule-            { type_ = "PostgreSQL Table",-              pathPattern = Just "schemas/*/tables/*",-              resourceScheme = Just "postgresql",-              requireSchemaSection = True,-              schemaColumns = ["Column", "Type", "Nullable", "Description"],-              idPrefix = Nothing-            }-        ]-    }--testDocumentIdProfileSpec :: ProfileSpec-testDocumentIdProfileSpec =-  ProfileSpec-    { name = "test-decisions",-      okfVersion = "0.1",-      frontmatter = FrontmatterRules {required = ["type", "title"], recommended = []},-      allowUnknownTypes = False,-      idField = Just "docId",-      types =-        [ TypeRule-            { type_ = "Decision Record",-              pathPattern = Just "decisions/*",-              resourceScheme = Nothing,-              requireSchemaSection = False,-              schemaColumns = [],-              idPrefix = Just "ADR"-            }-        ]-    }---- | Build an in-memory concept from a raw ID, frontmatter pairs, and a body.-profileConcept :: Text -> [(Text, Value)] -> Text -> Either Text Concept-profileConcept rawId fieldPairs bodyText = do-  conceptId <- parseTestConceptId rawId-  pure (conceptFromDocument conceptId (OKFDocument (frontmatterFromFields fieldPairs) bodyText))---- | A well-formed @# Schema@ section matching the profile's required columns.-schemaSectionBody :: Text-schemaSectionBody =-  Text.unlines-    [ "# Schema",-      "",-      "| Column | Type   | Nullable | Description |",-      "|--------|--------|----------|-------------|",-      "| id     | bigint | no       | Primary key |"-    ]--testProfileConformingTable :: Either Text ()-testProfileConformingTable = do-  concept <--    profileConcept-      "schemas/sales/tables/orders"-      [ ("type", String "PostgreSQL Table"),-        ("title", String "Orders"),-        ("resource", String "postgresql://warehouse/sales/orders")-      ]-      schemaSectionBody-  assertEqual [] (validateProfile testProfileSpec [concept])--testProfileUnknownType :: Either Text ()-testProfileUnknownType = do-  concept <--    profileConcept-      "schemas/sales/tables/bad"-      [("type", String "pg table"), ("title", String "Bad"), ("resource", String "postgresql://x")]-      schemaSectionBody-  cid <- parseTestConceptId "schemas/sales/tables/bad"-  assertEqual [TypeNotInProfile cid "pg table"] (validateProfile testProfileSpec [concept])--testProfileMissingField :: Either Text ()-testProfileMissingField = do-  concept <--    profileConcept-      "schemas/sales/tables/orders"-      [("type", String "PostgreSQL Table"), ("resource", String "postgresql://x")]-      schemaSectionBody-  cid <- parseTestConceptId "schemas/sales/tables/orders"-  assertEqual [MissingProfileField cid "title"] (validateProfile testProfileSpec [concept])--testProfileResourceMismatch :: Either Text ()-testProfileResourceMismatch = do-  concept <--    profileConcept-      "schemas/sales/tables/orders"-      [("type", String "PostgreSQL Table"), ("title", String "Orders"), ("resource", String "mysql://x")]-      schemaSectionBody-  cid <- parseTestConceptId "schemas/sales/tables/orders"-  assertEqual-    [ResourceSchemeMismatch cid "postgresql" "mysql://x"]-    (validateProfile testProfileSpec [concept])--testProfilePathMismatch :: Either Text ()-testProfilePathMismatch = do-  concept <--    profileConcept-      "tables/orders"-      [("type", String "PostgreSQL Table"), ("title", String "Orders"), ("resource", String "postgresql://x")]-      schemaSectionBody-  cid <- parseTestConceptId "tables/orders"-  assertEqual-    [PathPatternMismatch cid "PostgreSQL Table" "schemas/*/tables/*"]-    (validateProfile testProfileSpec [concept])--testProfileMissingSchema :: Either Text ()-testProfileMissingSchema = do-  concept <--    profileConcept-      "schemas/sales/tables/orders"-      [("type", String "PostgreSQL Table"), ("title", String "Orders"), ("resource", String "postgresql://x")]-      "# Overview\n\nNo schema section here.\n"-  cid <- parseTestConceptId "schemas/sales/tables/orders"-  assertEqual-    [MissingSchemaSection cid "PostgreSQL Table"]-    (validateProfile testProfileSpec [concept])--testProfileSchemaColumnsMismatch :: Either Text ()-testProfileSchemaColumnsMismatch = do-  let mismatchBody =-        Text.unlines-          ["# Schema", "", "| Col | Type |", "|-----|------|", "| id  | bigint |"]-  concept <--    profileConcept-      "schemas/sales/tables/orders"-      [("type", String "PostgreSQL Table"), ("title", String "Orders"), ("resource", String "postgresql://x")]-      mismatchBody-  cid <- parseTestConceptId "schemas/sales/tables/orders"-  assertEqual-    [SchemaColumnsMismatch cid "PostgreSQL Table" ["Column", "Type", "Nullable", "Description"] ["Col", "Type"]]-    (validateProfile testProfileSpec [concept])--testProfileConformingDocumentId :: Either Text ()-testProfileConformingDocumentId = do-  concept <--    profileConcept-      "decisions/one"-      [("type", String "Decision Record"), ("title", String "One"), ("docId", String "ADR-1")]-      "# One\n"-  assertEqual [] (validateProfile testDocumentIdProfileSpec [concept])--testProfileMissingDocumentId :: Either Text ()-testProfileMissingDocumentId = do-  concept <--    profileConcept-      "decisions/one"-      [("type", String "Decision Record"), ("title", String "One")]-      "# One\n"-  cid <- parseTestConceptId "decisions/one"-  assertEqual-    [MissingDocumentId cid "Decision Record" "ADR"]-    (validateProfile testDocumentIdProfileSpec [concept])--testProfileMalformedDocumentIds :: Either Text ()-testProfileMalformedDocumentIds = do-  leadingZero <--    profileConcept-      "decisions/leading-zero"-      [("type", String "Decision Record"), ("title", String "Leading zero"), ("docId", String "ADR-007")]-      "# Leading zero\n"-  wrongPrefix <--    profileConcept-      "decisions/wrong-prefix"-      [("type", String "Decision Record"), ("title", String "Wrong prefix"), ("docId", String "RFC-1")]-      "# Wrong prefix\n"-  leadingZeroId <- parseTestConceptId "decisions/leading-zero"-  wrongPrefixId <- parseTestConceptId "decisions/wrong-prefix"-  assertEqual-    [ MalformedDocumentId leadingZeroId "ADR" "ADR-007",-      MalformedDocumentId wrongPrefixId "ADR" "RFC-1"-    ]-    (validateProfile testDocumentIdProfileSpec [leadingZero, wrongPrefix])--testProfileDuplicateDocumentIds :: Either Text ()-testProfileDuplicateDocumentIds = do-  second <--    profileConcept-      "decisions/second"-      [("type", String "Decision Record"), ("title", String "Second"), ("docId", String "ADR-1")]-      "# Second\n"-  firstConcept <--    profileConcept-      "decisions/first"-      [("type", String "Decision Record"), ("title", String "First"), ("docId", String "ADR-1")]-      "# First\n"-  firstId <- parseTestConceptId "decisions/first"-  secondId <- parseTestConceptId "decisions/second"-  assertEqual-    [DuplicateDocumentId "ADR-1" firstId secondId]-    (validateProfile testDocumentIdProfileSpec [second, firstConcept])--testProfileDocumentIdsOffByDefault :: Either Text ()-testProfileDocumentIdsOffByDefault = do-  concept <--    profileConcept-      "schemas/sales/tables/orders"-      [ ("type", String "PostgreSQL Table"),-        ("title", String "Orders"),-        ("resource", String "postgresql://warehouse/sales/orders"),-        ("docId", String "not-a-handle")-      ]-      schemaSectionBody-  assertEqual [] (validateProfile testProfileSpec [concept])--testSchemaSectionColumns :: Either Text ()-testSchemaSectionColumns =-  assertEqual-    (Just ["Column", "Type", "Nullable", "Description"])-    (schemaSectionColumns schemaSectionBody)---- | Milestone 5: walking the deviating fixture and validating it against the--- shipped descriptor produces exactly the expected advisory deviations.-testProfileDeviationsFixture :: IO (Either Text ())-testProfileDeviationsFixture = do-  descriptorPath <- fixtureFilePath "profiles/postgresql.dhall"-  loaded <- loadProfileFile descriptorPath-  root <- fixturePath "profile-deviations"-  concepts <- readBundle root-  pure $ case loaded of-    Left err -> Left ("failed to load profile: " <> err)-    Right spec -> do-      badId <- parseTestConceptId "schemas/sales/tables/bad"-      ordersId <- parseTestConceptId "schemas/sales/tables/orders"-      assertEqual-        [TypeNotInProfile badId "pg table", MissingProfileField ordersId "title"]-        (validateProfile spec concepts)--testDocumentIdDeviationsFixture :: IO (Either Text ())-testDocumentIdDeviationsFixture = do-  descriptorPath <- fixtureFilePath "profiles/decisions.dhall"-  loaded <- loadProfileFile descriptorPath-  root <- fixturePath "doc-id-deviations"-  concepts <- readBundle root-  pure $ case loaded of-    Left err -> Left ("failed to load document ID profile: " <> err)-    Right spec -> do-      firstId <- parseTestConceptId "decisions/first"-      secondId <- parseTestConceptId "decisions/second"-      thirdId <- parseTestConceptId "decisions/third"-      fourthId <- parseTestConceptId "decisions/fourth"-      assertEqual-        [ MissingDocumentId fourthId "Decision Record" "ADR",-          MalformedDocumentId thirdId "ADR" "ADR-007",-          DuplicateDocumentId "ADR-1" firstId secondId-        ]-        (validateProfile spec concepts)+import Data.Foldable (for_, toList)+import Data.List qualified as List+import Data.Text qualified as Text+import Data.Text.IO qualified as Text.IO+import Okf.Bundle+import Okf.ConceptId+import Okf.Discovery+import Okf.Document+import Okf.Graph+import Okf.Index+import Okf.Log+import Okf.Prelude hiding (List, setField, (.=))+import Okf.Profile+import Okf.Profile.Registry+import Okf.Validation+import System.Directory+  ( createDirectoryIfMissing,+    doesDirectoryExist,+    doesFileExist,+    getTemporaryDirectory,+    removeDirectoryRecursive,+  )+import System.Exit (exitFailure)+import System.FilePath (normalise, takeDirectory, (</>))+import System.IO.Temp (createTempDirectory)+import "generic-lens" Data.Generics.Labels ()++main :: IO ()+main = do+  results <-+    sequence+      [ test "parse valid document with YAML frontmatter" testParseValidDocument,+        test "parse document with no frontmatter as empty-frontmatter body" testParseNoFrontmatter,+        test "reject unterminated frontmatter" testRejectUnterminatedFrontmatter,+        test "reject frontmatter that is not a YAML mapping" testRejectNonMappingFrontmatter,+        test "validate permissive profile with only type" testPermissiveValidation,+        test "validate strict profile requiring title description timestamp" testStrictValidation,+        test "validate rejects tags that are not a string list" testRejectInvalidTags,+        test "round-trip preserves semantic frontmatter and body" testRoundTrip,+        test "reject invalid concept id segment" testRejectInvalidConceptId,+        test "convert concept id tables/users to tables/users.md" testConceptIdToFilePath,+        testIO "walkBundle reports a structured IO error for a missing root" testWalkBundleMissingRoot,+        testIO "walkBundle skips index.md and log.md" testWalkBundleSkipsReserved,+        testIO "walkBundle discovers nested concept IDs" testWalkBundleDiscoversNestedConceptIds,+        testIO "discoverBundleRoots finds a directory holding index.md" testDiscoverIndexMd,+        testIO "discoverBundleRoots finds a directory holding a typed concept" testDiscoverTypedConcept,+        testIO "discoverBundleRoots ignores markdown without a type field" testDiscoverIgnoresPlainMarkdown,+        testIO "discoverBundleRoots does not descend into a bundle it found" testDiscoverPrunesNestedBundles,+        testIO "discoverBundleRoots skips hidden and build directories" testDiscoverSkipsNoise,+        testIO "discoverBundleRoots honours maxDepth" testDiscoverHonoursMaxDepth,+        testIO "discoverBundleRoots reports a fixture bundle as its own root" testDiscoverFixtureBundle,+        test "parseLog/serializeLog round-trips a canonical log" testLogRoundTrip,+        test "validateLog flags a non-ISO date heading" testValidateLogNonIsoDate,+        test "validateLog flags an empty date group" testValidateLogEmptyDay,+        test "validateLog flags out-of-order days" testValidateLogOutOfOrder,+        testIO "walkLogs discovers nested log.md files" testWalkLogsDiscoversNested,+        test "logStaleness flags a concept newer than its nearest log" testLogStalenessFlagsNewerConcept,+        test "logStaleness prefers the deepest enclosing log" testLogStalenessPrefersDeepestLog,+        test "appendLogEntry inserts newest-first and prepends within a day" testAppendLogEntry,+        testIO "generateIndex groups documents by frontmatter type" testGenerateIndexGroupsByType,+        testIO "extractLinks resolves relative and absolute bundle links" testExtractLinksResolveBundleLinks,+        testIO "extractLinks ignores external markdown URLs" testExtractLinksIgnoresExternalUrls,+        testIO "buildGraph includes only edges to existing concepts" testBuildGraphIncludesKnownEdges,+        testIO "writeBundleIndexes is deterministic" testWriteBundleIndexesDeterministic,+        testIO "fixture valid bundle validates and graphs expected edges" testFixtureValidBundle,+        testIO "fixture graph JSON shape is stable" testFixtureGraphJsonShape,+        testIO "fixture unterminated frontmatter reports parse error" testFixtureUnterminatedFrontmatter,+        testIO "fixture missing type reports validation error" testFixtureMissingType,+        test "frontmatter builder round-trips through serialize and parse" testFrontmatterBuilderRoundTrip,+        test "serializeDocument emits deterministic key order" testSerializeDeterministicKeyOrder,+        test "rendered concept link round-trips through extractConceptLinks" testConceptLinkRoundTrip,+        test "over-escaping relative links do not resolve inside bundle" testRejectOverEscapingRelativeLink,+        test "validateBundle reports a dangling reference" testValidateBundleDanglingReference,+        test "validateBundle accepts a bundle whose links all resolve" testValidateBundleAcceptsResolved,+        test "duplicateConceptIds finds repeated ids" testDuplicateConceptIds,+        test "conceptFromDocument derives typed fields from frontmatter" testConceptFromDocumentDerivesFields,+        testIO "writeBundle then walkBundle round-trips" testWriteBundleRoundTrip,+        testIO "fixture dangling link reports a bundle validation error" testFixtureDanglingLink,+        testIO "loadProfileFile decodes the postgresql fixture" testLoadProfileFixture,+        testIO "loadProfileFile decodes record-completed document ID rules" testLoadDocumentIdProfileFixture,+        testIO "loadProfileFile accepts the pre-type-frontmatter described schema" testLoadDescribedProfileFixture,+        testIO "loadProfileFile accepts the frozen EP-1 type-aware schema" testLoadTypeAwareCompatibilityFixture,+        testIO "loadProfileFile accepts the frozen EP-2 vocabulary schema" testLoadVocabularyCompatibilityFixture,+        testIO "loadProfileFile accepts the frozen EP-3 cardinality schema" testLoadCardinalityCompatibilityFixture,+        testIO "loadProfileFile accepts the frozen EP-4 format schema" testLoadFormatCompatibilityFixture,+        testIO "loadProfileFile decodes bounded nested review rules" testLoadNestedReviewsProfileFixture,+        testIO "loadProfileFile preserves the frozen bounded-nested schema" testLoadNestedCompatibilityFixture,+        testIO "loadProfileFile decodes same-scope conditions" testLoadConditionalFieldsProfileFixture,+        testIO "loadProfileFile preserves the frozen condition-aware schema" testLoadConditionalCompatibilityFixture,+        testIO "loadProfileFile still accepts an okf 0.2.x descriptor" testLoadLegacyProfileFixture,+        testIO "profileFieldDescription finds required and recommended prose" testProfileFieldDescription,+        testIO "profile JSON encoding emits type, not type_" testProfileJsonShape,+        test "field condition JSON encoding is stable" testFieldConditionJsonShape,+        test "handle reference JSON encoding is stable" testHandleReferenceJsonShape,+        test "field format JSON encoding is stable" testFieldFormatJsonShape,+        testIO "loadRegistry enumerates nested profiles and skips non-profiles" testRegistryEnumeratesProfiles,+        testIO "loadRegistry reports a bare profile as a root entry" testRegistryRootProfile,+        testIO "resolveRegistryRef prefers package.dhall inside a directory" testResolveRegistryRef,+        testIO "loadRegistry reports a missing registry as Left" testRegistryLoadFailure,+        test "parseDocumentId accepts only canonical handles" testParseDocumentId,+        testIO "documentIdsInBundle sorts handles by prefix and number" testDocumentIdsInBundle,+        test "nextDocumentId skips gaps and starts unused prefixes at one" testNextDocumentId,+        testIO "findConceptsByDocumentId resolves and reports duplicate handles" testFindConceptsByDocumentId,+        test "compileProfile rejects ambiguous definitions deterministically" testCompileProfileDefinitionErrors,+        test "compiled rules merge profile and type requirements" testCompiledProfileMerge,+        test "compiled vocabularies intersect in profile declaration order" testCompiledVocabularyIntersection,+        test "compileProfile rejects disjoint vocabularies" testUnsatisfiableVocabulary,+        test "compiled cardinality uses Any as identity and rejects contradictions" testCompiledCardinality,+        test "profile vocabularies validate strings, lists, and shapes" testVocabularyValidation,+        test "profile cardinality validates all JSON shapes and presence" testCardinalityValidation,+        test "cardinality suppresses redundant vocabulary shape errors" testCardinalityVocabularyInteraction,+        test "compiled formats refine Uri and reject contradictions" testCompiledFieldFormats,+        test "compileProfile rejects invalid format parameters" testInvalidFormatParameters,+        test "named formats validate parser boundaries, lists, and shapes" testNamedFormatValidation,+        test "compiled nested rules merge and reject impossible outer cardinality" testCompiledNestedRules,+        test "nested record validation reports indexed paths and strict recommendations" testNestedRecordValidation,+        test "compileProfile rejects invalid same-scope field conditions" testConditionDefinitionErrors,+        test "top-level conditions gate presence without gating value checks" testTopLevelConditionalPresence,+        test "nested conditions use siblings and avoid cascading diagnostics" testNestedConditionalPresence,+        test "compileProfile rejects invalid document reference policies" testReferenceDefinitionErrors,+        test "document references resolve local handles and explicit external URIs" testDocumentReferenceValidation,+        test "closed profiles reject unknown fields and isolate type fields" testClosedFieldValidation,+        test "profile rules apply to unknown concept types" testProfileRulesApplyToUnknownTypes,+        test "strict profile validation checks recommendations" testStrictProfileRecommendations,+        test "validateProfile accepts a conforming table concept" testProfileConformingTable,+        test "validateProfile flags a type not in the vocabulary" testProfileUnknownType,+        test "validateProfile flags a missing required field" testProfileMissingField,+        test "validateProfile flags a resource scheme mismatch" testProfileResourceMismatch,+        test "validateProfile flags a path pattern mismatch" testProfilePathMismatch,+        test "validateProfile flags a missing # Schema section" testProfileMissingSchema,+        test "validateProfile flags mismatched # Schema columns" testProfileSchemaColumnsMismatch,+        test "validateProfile accepts a conforming document ID" testProfileConformingDocumentId,+        test "validateProfile flags a missing document ID" testProfileMissingDocumentId,+        test "validateProfile flags malformed document IDs" testProfileMalformedDocumentIds,+        test "validateProfile flags duplicate document IDs" testProfileDuplicateDocumentIds,+        test "validateProfile document ID checks are off by default" testProfileDocumentIdsOffByDefault,+        test "schemaSectionColumns reads the header row of the Schema table" testSchemaSectionColumns,+        testIO "validateProfile reports the expected deviations for the fixture bundle" testProfileDeviationsFixture,+        testIO "validateProfile reports document ID fixture deviations" testDocumentIdDeviationsFixture,+        testIO "type-aware fixture is permissive but reports one strict recommendation" testTypeAwareProfileFixture,+        testIO "closed-field fixture reports missing and misspelled fields" testClosedFieldsFixture,+        testIO "cardinality fixture reports scalar and list mismatches" testCardinalityFixture,+        testIO "format fixture reports parser-backed mismatches" testFormatsFixture,+        testIO "nested review fixture validates records with indexed diagnostics" testNestedReviewsFixture,+        testIO "conditional fixture covers ADR, PostgreSQL, and review scopes" testConditionalFieldsFixture,+        testIO "document reference fixture covers local, external, self, and duplicate targets" testDocumentReferencesFixture+      ]+  unless (and results) exitFailure++test :: Text -> Either Text () -> IO Bool+test name assertion =+  case assertion of+    Right () -> do+      putStrLn ("PASS " <> Text.unpack name)+      pure True+    Left message -> do+      putStrLn ("FAIL " <> Text.unpack name <> ": " <> Text.unpack message)+      pure False++testIO :: Text -> IO (Either Text ()) -> IO Bool+testIO name assertion = do+  result <- assertion+  test name result++testParseValidDocument :: Either Text ()+testParseValidDocument = do+  document <- firstShow (parseDocument sampleDocument)+  assertEqual (Just (String "BigQuery Table")) (frontmatterLookup "type" (document ^. #frontmatter))+  assertEqual "# Schema\n\nBody text.\n" (body document)++testParseNoFrontmatter :: Either Text ()+testParseNoFrontmatter = do+  document <- firstShow (parseDocument "# Draft\n")+  assertEqual Nothing (frontmatterLookup "type" (document ^. #frontmatter))+  assertEqual "# Draft\n" (body document)++testRejectUnterminatedFrontmatter :: Either Text ()+testRejectUnterminatedFrontmatter =+  assertEqual (Left UnterminatedFrontmatter) (parseDocument "---\ntype: BigQuery Table\n")++testRejectNonMappingFrontmatter :: Either Text ()+testRejectNonMappingFrontmatter =+  assertEqual (Left FrontmatterNotMapping) (parseDocument "---\n- one\n- two\n---\nBody\n")++testPermissiveValidation :: Either Text ()+testPermissiveValidation = do+  document <- firstShow (parseDocument "---\ntype: BigQuery Table\n---\nBody\n")+  assertEqual [] (validateDocument PermissiveConformance document)++testStrictValidation :: Either Text ()+testStrictValidation = do+  document <- firstShow (parseDocument "---\ntype: BigQuery Table\n---\nBody\n")+  let errors = validateDocument StrictAuthoring document+  assertBool "missing title" (MissingRecommendedField "title" `List.elem` errors)+  assertBool "missing description" (MissingRecommendedField "description" `List.elem` errors)+  assertBool "missing timestamp" (MissingRecommendedField "timestamp" `List.elem` errors)++testRejectInvalidTags :: Either Text ()+testRejectInvalidTags = do+  document <- firstShow (parseDocument "---\ntype: BigQuery Table\ntags: orders\n---\nBody\n")+  assertEqual [FieldMustBeListOfText "tags"] (validateDocument PermissiveConformance document)++testRoundTrip :: Either Text ()+testRoundTrip = do+  document <- firstShow (parseDocument sampleDocument)+  assertEqual [] (validateDocument PermissiveConformance document)+  assertEqual [] (validateDocument StrictAuthoring document)+  reparsed <- firstShow (parseDocument (serializeDocument document))+  assertEqual (document ^. #frontmatter) (reparsed ^. #frontmatter)+  assertEqual (body document) (body reparsed)++testRejectInvalidConceptId :: Either Text ()+testRejectInvalidConceptId =+  assertEqual (Left (InvalidConceptIdSegment "-users")) (parseConceptId "tables/-users")++testConceptIdToFilePath :: Either Text ()+testConceptIdToFilePath = do+  conceptId <- firstShow (parseConceptId "tables/users")+  assertEqual "tables/users.md" (conceptIdToFilePath conceptId)++testWalkBundleMissingRoot :: IO (Either Text ())+testWalkBundleMissingRoot = do+  temporaryDirectory <- getTemporaryDirectory+  root <- createTempDirectory temporaryDirectory "okf-core-missing-parent"+  let missingRoot = root </> "missing"+  result <- walkBundle missingRoot+  removeDirectoryRecursive root+  pure+    ( case result of+        Left (BundleIoError path message)+          | path == missingRoot && "does not exist" `Text.isInfixOf` message -> Right ()+        other -> Left ("expected missing-root BundleIoError, got " <> Text.pack (show other))+    )++testWalkBundleSkipsReserved :: IO (Either Text ())+testWalkBundleSkipsReserved =+  withFixtureBundle+    ( \root -> do+        concepts <- readBundle root+        pure (assertEqual ["datasets/sales", "tables/customers", "tables/orders"] (renderConceptId . conceptIdOf <$> concepts))+    )++testWalkBundleDiscoversNestedConceptIds :: IO (Either Text ())+testWalkBundleDiscoversNestedConceptIds =+  withFixtureBundle+    ( \root -> do+        concepts <- readBundle root+        pure+          ( do+              expected <- firstShow (parseConceptId "tables/orders")+              assertBool "nested concept exists" (isJust (findConcept expected concepts))+          )+    )++-- | Build a throwaway directory tree, run an action on it, and clean up.+withDiscoveryTree :: String -> [(FilePath, Text)] -> (FilePath -> IO a) -> IO a+withDiscoveryTree label files action = do+  temporaryDirectory <- getTemporaryDirectory+  root <- createTempDirectory temporaryDirectory label+  for_ files $ \(relativePath, content) -> do+    createDirectoryIfMissing True (root </> takeDirectory relativePath)+    Text.IO.writeFile (root </> relativePath) content+  result <- action root+  removeDirectoryRecursive root+  pure result++typedConcept :: Text -> Text+typedConcept titleText =+  Text.unlines ["---", "type: Table", "title: " <> titleText, "---", "", "# " <> titleText]++plainMarkdown :: Text+plainMarkdown = "# Just prose\n\nNo frontmatter here.\n"++testDiscoverIndexMd :: IO (Either Text ())+testDiscoverIndexMd =+  withDiscoveryTree "okf-discovery-index" [("kb/index.md", "# Index\n")] $ \root -> do+    found <- discoverBundleRoots defaultDiscoveryOptions root+    pure (assertEqual [normalise (root </> "kb")] found)++testDiscoverTypedConcept :: IO (Either Text ())+testDiscoverTypedConcept =+  withDiscoveryTree "okf-discovery-typed" [("kb/tables/orders.md", typedConcept "Orders")] $ \root -> do+    found <- discoverBundleRoots defaultDiscoveryOptions root+    pure (assertEqual [normalise (root </> "kb" </> "tables")] found)++testDiscoverIgnoresPlainMarkdown :: IO (Either Text ())+testDiscoverIgnoresPlainMarkdown =+  withDiscoveryTree+    "okf-discovery-plain"+    [("notes/README.md", plainMarkdown), ("notes/CHANGELOG.md", plainMarkdown)]+    $ \root -> do+      found <- discoverBundleRoots defaultDiscoveryOptions root+      pure (assertEqual [] found)++testDiscoverPrunesNestedBundles :: IO (Either Text ())+testDiscoverPrunesNestedBundles =+  withDiscoveryTree+    "okf-discovery-prune"+    [ ("kb/index.md", "# Index\n"),+      ("kb/tables/index.md", "# Tables\n"),+      ("kb/tables/orders.md", typedConcept "Orders")+    ]+    $ \root -> do+      found <- discoverBundleRoots defaultDiscoveryOptions root+      pure (assertEqual [normalise (root </> "kb")] found)++testDiscoverSkipsNoise :: IO (Either Text ())+testDiscoverSkipsNoise =+  withDiscoveryTree+    "okf-discovery-noise"+    [ (".hidden/index.md", "# Hidden\n"),+      ("dist-newstyle/index.md", "# Build output\n"),+      ("kb/index.md", "# Index\n")+    ]+    $ \root -> do+      found <- discoverBundleRoots defaultDiscoveryOptions root+      pure (assertEqual [normalise (root </> "kb")] found)++testDiscoverHonoursMaxDepth :: IO (Either Text ())+testDiscoverHonoursMaxDepth =+  withDiscoveryTree "okf-discovery-depth" [("a/b/c/index.md", "# Deep\n")] $ \root -> do+    shallow <- discoverBundleRoots defaultDiscoveryOptions {maxDepth = 2} root+    deep <- discoverBundleRoots defaultDiscoveryOptions {maxDepth = 3} root+    pure (assertEqual [] shallow >> assertEqual [normalise (root </> "a" </> "b" </> "c")] deep)++testDiscoverFixtureBundle :: IO (Either Text ())+testDiscoverFixtureBundle = do+  bundle <- fixturePath "valid-bundle"+  found <- discoverBundleRoots defaultDiscoveryOptions bundle+  pure (assertEqual [normalise bundle] found)++testLogRoundTrip :: Either Text ()+testLogRoundTrip = do+  let canonicalLog =+        Text.unlines+          [ "# Directory Update Log",+            "",+            "## 2026-06-23",+            "* **Update**: Refreshed [orders](tables/orders.md).",+            "* **Creation**: Added customers.",+            "",+            "## 2026-06-01",+            "* Deprecated a stale note."+          ]+      parsed = parseLog canonicalLog+      reparsed = parseLog (serializeLog parsed)+  assertEqual+    ( Log+        { logTitle = "Directory Update Log",+          logDays =+            [ LogDay+                { logDate = "2026-06-23",+                  logEntries =+                    [ LogEntry (Just "Update") "Refreshed [orders](tables/orders.md).",+                      LogEntry (Just "Creation") "Added customers."+                    ]+                },+              LogDay+                { logDate = "2026-06-01",+                  logEntries = [LogEntry Nothing "Deprecated a stale note."]+                }+            ]+        }+    )+    parsed+  assertEqual parsed reparsed++testValidateLogNonIsoDate :: Either Text ()+testValidateLogNonIsoDate =+  assertBool+    "expected LogDateNotIso"+    (LogDateNotIso "not-a-date" `List.elem` validateLog (parseLog "# Log\n\n## not-a-date\n* **Update**: oops\n"))++testValidateLogEmptyDay :: Either Text ()+testValidateLogEmptyDay =+  assertBool+    "expected LogEmptyDay"+    (LogEmptyDay "2026-06-23" `List.elem` validateLog (parseLog "# Log\n\n## 2026-06-23\n"))++testValidateLogOutOfOrder :: Either Text ()+testValidateLogOutOfOrder =+  assertBool+    "expected LogDaysOutOfOrder"+    ( LogDaysOutOfOrder "2026-01-01" "2026-06-23"+        `List.elem` validateLog (parseLog "# Log\n\n## 2026-01-01\n* Old.\n\n## 2026-06-23\n* New.\n")+    )++testWalkLogsDiscoversNested :: IO (Either Text ())+testWalkLogsDiscoversNested = do+  temporaryDirectory <- getTemporaryDirectory+  root <- createTempDirectory temporaryDirectory "okf-core-logs"+  createDirectoryIfMissing True (root </> "tables")+  Text.IO.writeFile (root </> "log.md") "# Root Log\n\n## 2026-06-23\n* Root entry.\n"+  Text.IO.writeFile (root </> "tables" </> "log.md") "# Tables Log\n\n## 2026-06-22\n* Tables entry.\n"+  result <- walkLogs root+  removeDirectoryRecursive root+  pure+    ( case result of+        Right logs -> assertEqual ["log.md", "tables/log.md"] (logSourcePath <$> logs)+        Left bundleError -> Left ("expected logs, got " <> Text.pack (show bundleError))+    )++testLogStalenessFlagsNewerConcept :: Either Text ()+testLogStalenessFlagsNewerConcept = do+  staleId <- parseTestConceptId "stale"+  staleConcept <- testConceptWithTimestamp "stale" "2026-06-23T00:00:00Z"+  currentConcept <- testConceptWithTimestamp "current" "2026-01-01T00:00:00Z"+  let logs = [LogFile "log.md" (parseLog "# Log\n\n## 2026-06-01\n* **Update**: logged.\n")]+  assertEqual+    [ LogStaleness+        { staleConcept = staleId,+          staleConceptDate = "2026-06-23",+          staleLogPath = Just "log.md",+          staleLogDate = Just "2026-06-01"+        }+    ]+    (logStaleness [staleConcept, currentConcept] logs)++testLogStalenessPrefersDeepestLog :: Either Text ()+testLogStalenessPrefersDeepestLog = do+  usersId <- parseTestConceptId "tables/users"+  usersConcept <- testConceptWithTimestamp "tables/users" "2026-06-21T00:00:00Z"+  let logs =+        [ LogFile "log.md" (parseLog "# Root Log\n\n## 2026-06-01\n* **Update**: root.\n"),+          LogFile "tables/log.md" (parseLog "# Tables Log\n\n## 2026-06-20\n* **Update**: tables.\n")+        ]+  assertEqual+    [ LogStaleness+        { staleConcept = usersId,+          staleConceptDate = "2026-06-21",+          staleLogPath = Just "tables/log.md",+          staleLogDate = Just "2026-06-20"+        }+    ]+    (logStaleness [usersConcept] logs)++testAppendLogEntry :: Either Text ()+testAppendLogEntry =+  assertEqual+    ( Log+        { logTitle = "Log",+          logDays =+            [ LogDay "2026-06-23" [LogEntry (Just "Update") "new"],+              LogDay "2026-06-01" [LogEntry (Just "Update") "prepended", LogEntry (Just "Creation") "old"]+            ]+        }+    )+    ( appendLogEntry+        "2026-06-01"+        (LogEntry (Just "Update") "prepended")+        ( appendLogEntry+            "2026-06-23"+            (LogEntry (Just "Update") "new")+            (Log "Log" [LogDay "2026-06-01" [LogEntry (Just "Creation") "old"]])+        )+    )++testGenerateIndexGroupsByType :: IO (Either Text ())+testGenerateIndexGroupsByType =+  withFixtureBundle+    ( \root -> do+        concepts <- readBundle root+        pure+          ( do+              orders <- requireConcept "tables/orders" concepts+              customers <- requireConcept "tables/customers" concepts+              let rendered = renderIndex [] [orders, customers]+              assertBool "has type heading" ("# BigQuery Table" `Text.isInfixOf` rendered)+              assertBool "has orders bullet" ("[Orders](orders.md) - Order records." `Text.isInfixOf` rendered)+              assertBool "has customers bullet" ("[Customers](customers.md) - Customer records." `Text.isInfixOf` rendered)+          )+    )++testExtractLinksResolveBundleLinks :: IO (Either Text ())+testExtractLinksResolveBundleLinks =+  withFixtureBundle+    ( \root -> do+        concepts <- readBundle root+        pure+          ( do+              orders <- requireConcept "tables/orders" concepts+              customers <- firstShow (parseConceptId "tables/customers")+              sales <- firstShow (parseConceptId "datasets/sales")+              let links = extractConceptLinks orders+              assertBool "absolute or ./ customers link" (customers `List.elem` links)+              assertBool "../ sales link" (sales `List.elem` links)+          )+    )++testExtractLinksIgnoresExternalUrls :: IO (Either Text ())+testExtractLinksIgnoresExternalUrls =+  withFixtureBundle+    ( \root -> do+        concepts <- readBundle root+        pure+          ( do+              orders <- requireConcept "tables/orders" concepts+              assertEqual 4 (length (extractConceptLinks orders))+          )+    )++testBuildGraphIncludesKnownEdges :: IO (Either Text ())+testBuildGraphIncludesKnownEdges =+  withFixtureBundle+    ( \root -> do+        concepts <- readBundle root+        pure+          ( do+              orders <- firstShow (parseConceptId "tables/orders")+              customers <- firstShow (parseConceptId "tables/customers")+              missing <- firstShow (parseConceptId "missing")+              let graph = buildGraph concepts+              assertEqual 3 (length (nodes graph))+              assertBool "known edge exists" (Edge {source = orders, target = customers} `List.elem` edges graph)+              assertBool "broken edge excluded" (Edge {source = orders, target = missing} `notElem` edges graph)+          )+    )++testWriteBundleIndexesDeterministic :: IO (Either Text ())+testWriteBundleIndexesDeterministic =+  withFixtureBundle+    ( \root -> do+        firstResult <- writeBundleIndexes root+        firstIndex <- Text.IO.readFile (root </> "tables" </> "index.md")+        secondResult <- writeBundleIndexes root+        secondIndex <- Text.IO.readFile (root </> "tables" </> "index.md")+        pure+          ( do+              firstShow firstResult+              firstShow secondResult+              assertEqual firstIndex secondIndex+              assertBool "tables index has BigQuery Table section" ("# BigQuery Table" `Text.isInfixOf` secondIndex)+          )+    )++testFixtureValidBundle :: IO (Either Text ())+testFixtureValidBundle = do+  root <- fixturePath "valid-bundle"+  concepts <- readBundle root+  pure+    ( do+        orders <- firstShow (parseConceptId "tables/orders")+        customers <- firstShow (parseConceptId "tables/customers")+        sales <- firstShow (parseConceptId "datasets/sales")+        assertEqual 4 (length concepts)+        assertEqual [] (foldMap (validateDocument PermissiveConformance . conceptDocument) concepts)+        let graph = buildGraph concepts+        assertBool "orders to customers" (Edge {source = orders, target = customers} `List.elem` edges graph)+        assertBool "orders to sales" (Edge {source = orders, target = sales} `List.elem` edges graph)+    )++testFixtureGraphJsonShape :: IO (Either Text ())+testFixtureGraphJsonShape = do+  root <- fixturePath "valid-bundle"+  concepts <- readBundle root+  orders <- requireConceptIO "tables/orders" concepts+  pure+    ( case filter (\Node {id = nodeId} -> nodeId == conceptIdOf orders) (nodes (buildGraph concepts)) of+        [ordersNode] ->+          assertEqual+            ( object+                [ "id" .= ("tables/orders" :: Text),+                  "label" .= ("Orders" :: Text),+                  "type" .= ("BigQuery Table" :: Text),+                  "description" .= Just ("Order fact table." :: Text),+                  "resource" .= Just ("bigquery://analytics.tables.orders" :: Text),+                  "tags" .= ["orders" :: Text, "sales"]+                ]+            )+            (toJSON ordersNode)+        other -> Left ("expected one orders node, got " <> Text.pack (show (length other)))+    )++testFixtureUnterminatedFrontmatter :: IO (Either Text ())+testFixtureUnterminatedFrontmatter = do+  root <- fixturePath "invalid-unterminated-frontmatter"+  result <- walkBundle root+  pure+    ( case result of+        Left (InvalidConceptDocument "broken.md" UnterminatedFrontmatter) -> Right ()+        other -> Left ("expected unterminated frontmatter error, got " <> Text.pack (show other))+    )++testFixtureMissingType :: IO (Either Text ())+testFixtureMissingType = do+  root <- fixturePath "invalid-missing-type"+  concepts <- readBundle root+  pure+    ( do+        assertEqual 1 (length concepts)+        case foldMap (validateDocument PermissiveConformance . conceptDocument) concepts of+          [MissingRequiredField "type"] -> Right ()+          other -> Left ("expected missing type error, got " <> Text.pack (show other))+    )++testFrontmatterBuilderRoundTrip :: Either Text ()+testFrontmatterBuilderRoundTrip = do+  let frontmatterValue =+        setField "version" (String "0.2.0")+          . setTags ["orders", "sales"]+          . setResource "bigquery://analytics.tables.orders"+          $ okfCommon+            OkfCommon+              { commonType = "BigQuery Table",+                commonTitle = Just "Orders",+                commonDescription = Just "Order fact table.",+                commonTimestamp = Just "2026-06-16T00:00:00Z"+              }+      original = OKFDocument frontmatterValue "# Orders\n\nBody text.\n"+  reparsed <- firstShow (parseDocument (serializeDocument original))+  assertEqual (original ^. #frontmatter) (reparsed ^. #frontmatter)+  assertEqual (body original) (body reparsed)++testSerializeDeterministicKeyOrder :: Either Text ()+testSerializeDeterministicKeyOrder = do+  let frontmatterValue =+        setField "zeta" (String "z")+          . setField "alpha" (String "a")+          . setTags ["t"]+          . setResource "res://x"+          . setType "Recipe"+          . setTimestamp "2026-06-16T00:00:00Z"+          . setDescription "Desc"+          . setTitle "Demo"+          $ emptyFrontmatter+      rendered = serializeDocument (OKFDocument frontmatterValue "# Demo\n")+      expectedOrder =+        ["type:", "title:", "description:", "timestamp:", "resource:", "tags:", "alpha:", "zeta:"]+  keyIndices <- traverse (\key -> maybe (Left ("missing key " <> key)) Right (substringIndex key rendered)) expectedOrder+  assertBool ("keys not in deterministic order: " <> Text.pack (show keyIndices)) (strictlyIncreasing keyIndices)++testConceptLinkRoundTrip :: Either Text ()+testConceptLinkRoundTrip = do+  sourceId <- parseTestConceptId "recipes/haskell-library-repo"+  let targetStrings = ["orders", "modules/nix-haskell-flake", "refs/source-system.v1"]+  mapM_+    ( \rawTarget -> do+        targetId <- parseTestConceptId rawTarget+        let extracted = extractFromBodyLinkingTo sourceId targetId+        assertEqual [targetId] extracted+    )+    targetStrings++parseTestConceptId :: Text -> Either Text ConceptId+parseTestConceptId rawId =+  first (\err -> "bad concept id " <> rawId <> ": " <> Text.pack (show err)) (parseConceptId rawId)++extractFromBodyLinkingTo :: ConceptId -> ConceptId -> [ConceptId]+extractFromBodyLinkingTo sourceId targetId =+  extractConceptLinks+    (conceptFromDocument sourceId (OKFDocument (setType "Test" emptyFrontmatter) ("See " <> renderConceptLink targetId "link" <> ".\n")))++testRejectOverEscapingRelativeLink :: Either Text ()+testRejectOverEscapingRelativeLink = do+  sourceId <- parseTestConceptId "a/b/source"+  targetId <- parseTestConceptId "tables/orders"+  let concept =+        conceptFromDocument+          sourceId+          (OKFDocument (setType "Test" emptyFrontmatter) "[Escapes](../../../tables/orders.md)\n")+  assertEqual [] (extractConceptLinks concept)+  assertEqual [] (validateBundle PermissiveConformance [concept, targetConcept targetId])+  where+    targetConcept targetId =+      conceptFromDocument+        targetId+        (OKFDocument (setType "Test" emptyFrontmatter) "# Orders\n")++testValidateBundleDanglingReference :: Either Text ()+testValidateBundleDanglingReference = do+  aId <- parseTestConceptId "a"+  bId <- parseTestConceptId "b"+  conceptA <- testConcept "a" ("See " <> renderConceptLink bId "b" <> ".\n")+  assertEqual [DanglingReference aId bId] (validateBundle StrictAuthoring [conceptA])++testValidateBundleAcceptsResolved :: Either Text ()+testValidateBundleAcceptsResolved = do+  bId <- parseTestConceptId "b"+  conceptA <- testConcept "a" ("See " <> renderConceptLink bId "b" <> ".\n")+  conceptB <- testConcept "b" "Standalone.\n"+  assertEqual [] (validateBundle StrictAuthoring [conceptA, conceptB])++testDuplicateConceptIds :: Either Text ()+testDuplicateConceptIds = do+  aId <- parseTestConceptId "a"+  conceptA <- testConcept "a" "First.\n"+  conceptAAgain <- testConcept "a" "Second.\n"+  assertEqual [aId] (duplicateConceptIds [conceptA, conceptAAgain])++-- | Build an in-memory concept via the public 'conceptFromDocument' constructor,+-- so its typed fields are derived from the frontmatter and cannot diverge.+-- Includes all StrictAuthoring fields so per-document validation passes and+-- bundle-level checks can be isolated.+testConcept :: Text -> Text -> Either Text Concept+testConcept rawId bodyText = do+  conceptId <- parseTestConceptId rawId+  let frontmatterValue =+        okfCommon+          OkfCommon+            { commonType = "Test",+              commonTitle = Just "Title",+              commonDescription = Just "Description",+              commonTimestamp = Just "2026-06-16T00:00:00Z"+            }+  pure (conceptFromDocument conceptId (OKFDocument frontmatterValue bodyText))++testConceptWithTimestamp :: Text -> Text -> Either Text Concept+testConceptWithTimestamp rawId timestamp = do+  conceptId <- parseTestConceptId rawId+  let frontmatterValue =+        okfCommon+          OkfCommon+            { commonType = "Test",+              commonTitle = Just "Title",+              commonDescription = Just "Description",+              commonTimestamp = Just timestamp+            }+  pure (conceptFromDocument conceptId (OKFDocument frontmatterValue "# Test\n"))++testConceptFromDocumentDerivesFields :: Either Text ()+testConceptFromDocumentDerivesFields = do+  conceptId <- parseTestConceptId "tables/orders"+  let frontmatterValue =+        okfCommon+          OkfCommon+            { commonType = "BigQuery Table",+              commonTitle = Just "Orders",+              commonDescription = Nothing,+              commonTimestamp = Nothing+            }+      concept = conceptFromDocument conceptId (OKFDocument frontmatterValue "# Orders\n")+  assertEqual "BigQuery Table" (conceptType concept)+  assertEqual (Just "Orders") (conceptTitle concept)+  assertEqual "tables/orders.md" (conceptSourcePath concept)++testWriteBundleRoundTrip :: IO (Either Text ())+testWriteBundleRoundTrip = do+  temporaryDirectory <- getTemporaryDirectory+  root <- createTempDirectory temporaryDirectory "okf-core-writebundle"+  let buildConcepts = do+        orders <- testConcept "tables/orders" "# Orders\n\nOrder records.\n"+        customers <- testConcept "tables/customers" "# Customers\n\nCustomer records.\n"+        pure [orders, customers]+  case buildConcepts of+    Left message -> do+      removeDirectoryRecursive root+      pure (Left message)+    Right concepts -> do+      writeBundle root concepts+      recovered <- readBundle root+      removeDirectoryRecursive root+      pure+        ( do+            assertEqual+              (List.sort (renderConceptId . conceptIdOf <$> concepts))+              (List.sort (renderConceptId . conceptIdOf <$> recovered))+            assertEqual+              (List.sort ((body . conceptDocument) <$> concepts))+              (List.sort ((body . conceptDocument) <$> recovered))+        )++testFixtureDanglingLink :: IO (Either Text ())+testFixtureDanglingLink = do+  root <- fixturePath "invalid-dangling-link"+  concepts <- readBundle root+  pure+    ( case validateBundle PermissiveConformance concepts of+        errs+          | any isDangling errs -> Right ()+          | otherwise -> Left ("expected a DanglingReference, got: " <> Text.pack (show errs))+    )+  where+    isDangling DanglingReference {} = True+    isDangling _ = False++-- | Resolve a fixture file path regardless of whether tests run from the repo+-- root or the package directory (mirrors 'fixturePath' for files).+fixtureFilePath :: FilePath -> IO FilePath+fixtureFilePath name = findExisting candidates+  where+    candidates =+      [ "okf-core" </> "test" </> "fixtures" </> name,+        "test" </> "fixtures" </> name+      ]+    findExisting [] = fail ("fixture file not found: " <> name)+    findExisting (candidate : rest) = do+      exists <- doesFileExist candidate+      if exists then pure candidate else findExisting rest++-- | Milestone 1: the Dhall descriptor round-trips into a 'ProfileSpec'.+testLoadProfileFixture :: IO (Either Text ())+testLoadProfileFixture = do+  path <- fixtureFilePath "profiles/postgresql.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load profile: " <> err)+    Right spec -> do+      assertEqual "shinzui-postgresql" (spec ^. #name)+      assertEqual+        (Just "Conventions for documenting a PostgreSQL database as an OKF bundle.")+        (spec ^. #description)+      assertEqual False (spec ^. #allowUnknownTypes)+      assertEqual ["type", "title"] (map (^. #field) (spec ^. #frontmatter . #required))+      assertEqual+        [ Just "The OKF concept type; must be one of the type rules below.",+          Just "Human-readable name of the object, as a reader would say it."+        ]+        (map (^. #description) (spec ^. #frontmatter . #required))+      -- `timestamp` is written with bare record completion, so it carries no prose.+      assertEqual+        [ Just "One or two sentences on what this object is for.",+          Nothing,+          Just "postgresql:// URI locating the live object."+        ]+        (map (^. #description) (spec ^. #frontmatter . #recommended))+      assertEqual+        ["PostgreSQL Schema", "PostgreSQL Table", "PostgreSQL View"]+        (map (^. #type_) (spec ^. #types))+      assertEqual+        (Just "One physical table in a schema, including its column list.")+        (spec ^. #types . to (!! 1) . #description)++testLoadDocumentIdProfileFixture :: IO (Either Text ())+testLoadDocumentIdProfileFixture = do+  path <- fixtureFilePath "profiles/decisions.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load document ID profile: " <> err)+    Right spec -> do+      assertEqual (Just "docId") (spec ^. #idField)+      assertEqual [Just "ADR"] (map (^. #idPrefix) (spec ^. #types))+      -- Written with the mk/FieldRule.dhall constructors, which normalize to+      -- exactly what record completion produces.+      assertEqual ["type", "title"] (map (^. #field) (spec ^. #frontmatter . #required))+      assertEqual+        [Just "The OKF concept type; must be a type rule below.", Nothing]+        (map (^. #description) (spec ^. #frontmatter . #required))++testLoadDescribedProfileFixture :: IO (Either Text ())+testLoadDescribedProfileFixture = do+  path <- fixtureFilePath "profiles/described.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load described profile: " <> err)+    Right spec -> do+      assertEqual "described" (spec ^. #name)+      assertEqual ["Described Concept"] (map (^. #type_) (spec ^. #types))+      assertEqual [emptyTestFrontmatterRules] (map (^. #frontmatter) (spec ^. #types))+      assertEqual True (spec ^. #allowUnknownFields)+      assertEqual [[]] (map (^. #allowedValues) (spec ^. #frontmatter . #required))+      assertEqual [Any] (map (^. #cardinality) (spec ^. #frontmatter . #required))++testLoadTypeAwareCompatibilityFixture :: IO (Either Text ())+testLoadTypeAwareCompatibilityFixture = do+  path <- fixtureFilePath "profiles/type-aware-ep1.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load EP-1 profile: " <> err)+    Right spec -> do+      assertEqual "type-aware-ep1" (spec ^. #name)+      assertEqual True (spec ^. #allowUnknownFields)+      assertEqual [[]] (map (^. #allowedValues) (spec ^. #frontmatter . #required))+      assertEqual [[[]]] (map (map (^. #allowedValues) . (^. #frontmatter . #required)) (spec ^. #types))+      assertEqual [Any] (map (^. #cardinality) (spec ^. #frontmatter . #required))++testLoadVocabularyCompatibilityFixture :: IO (Either Text ())+testLoadVocabularyCompatibilityFixture = do+  path <- fixtureFilePath "profiles/vocabulary-ep2.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load EP-2 profile: " <> err)+    Right spec -> do+      assertEqual "vocabulary-ep2" (spec ^. #name)+      assertEqual False (spec ^. #allowUnknownFields)+      assertEqual [[], ["draft", "accepted"]] (map (^. #allowedValues) (spec ^. #frontmatter . #required))+      assertEqual [Any, Any] (map (^. #cardinality) (spec ^. #frontmatter . #required))+      assertEqual [Nothing, Nothing] (map (^. #format) (spec ^. #frontmatter . #required))++testLoadCardinalityCompatibilityFixture :: IO (Either Text ())+testLoadCardinalityCompatibilityFixture = do+  path <- fixtureFilePath "profiles/cardinality-ep3.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load EP-3 profile: " <> err)+    Right spec -> do+      assertEqual "cardinality-ep3" (spec ^. #name)+      assertEqual False (spec ^. #allowUnknownFields)+      assertEqual [Any, Scalar] (map (^. #cardinality) (spec ^. #frontmatter . #required))+      assertEqual [Nothing, Nothing] (map (^. #format) (spec ^. #frontmatter . #required))++testLoadFormatCompatibilityFixture :: IO (Either Text ())+testLoadFormatCompatibilityFixture = do+  path <- fixtureFilePath "profiles/formats-ep4.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load EP-4 profile: " <> err)+    Right spec -> do+      assertEqual "formats-ep4" (spec ^. #name)+      assertEqual [Any, Scalar] (map (^. #cardinality) (spec ^. #frontmatter . #required))+      assertEqual [Nothing, Just Rfc3339Utc] (map (^. #format) (spec ^. #frontmatter . #required))+      assertEqual [Nothing, Nothing] (map (^. #elementFields) (spec ^. #frontmatter . #required))++testLoadNestedReviewsProfileFixture :: IO (Either Text ())+testLoadNestedReviewsProfileFixture = do+  path <- fixtureFilePath "profiles/nested-reviews.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load nested review profile: " <> err)+    Right spec ->+      case [rules | rule <- spec ^. #frontmatter . #required, rule ^. #field == "reviews", Just rules <- [rule ^. #elementFields]] of+        [NestedRules {required, recommended}] -> do+          assertEqual ["kind", "reviewer", "reviewed_at", "document_timestamp", "scope", "outcome", "context"] (map (^. #field) required)+          assertEqual ["notes"] (map (^. #field) recommended)+        _ -> Left "expected exactly one reviews rule with elementFields"++testLoadNestedCompatibilityFixture :: IO (Either Text ())+testLoadNestedCompatibilityFixture = do+  path <- fixtureFilePath "profiles/nested-reviews-ep1.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load frozen nested profile: " <> err)+    Right spec ->+      case spec ^. #frontmatter . #required of+        [rule] -> do+          assertEqual Nothing (rule ^. #when)+          case rule ^. #elementFields of+            Just NestedRules {required = [nestedRule]} -> do+              assertEqual "kind" (nestedRule ^. #field)+              assertEqual Nothing (nestedRule ^. #when)+            _ -> Left "expected the frozen nested rule to survive the compatibility upgrade"+        _ -> Left "expected one frozen top-level rule"++testLoadConditionalFieldsProfileFixture :: IO (Either Text ())+testLoadConditionalFieldsProfileFixture = do+  path <- fixtureFilePath "profiles/conditional-fields.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load conditional profile: " <> err)+    Right spec -> do+      assertEqual "conditional-fields" (spec ^. #name)+      compiled <- firstShow (compileProfile spec)+      assertEqual spec (compiledProfileSpec compiled)++testLoadConditionalCompatibilityFixture :: IO (Either Text ())+testLoadConditionalCompatibilityFixture = do+  path <- fixtureFilePath "profiles/conditional-fields-ep2.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load frozen condition-aware profile: " <> err)+    Right spec ->+      case spec ^. #frontmatter . #required of+        [sourceRule, targetRule, reviewsRule] -> do+          assertEqual Nothing (sourceRule ^. #reference)+          assertEqual (Just (FieldCondition "status" ["superseded"])) (targetRule ^. #when)+          assertEqual Nothing (targetRule ^. #reference)+          case reviewsRule ^. #elementFields of+            Just NestedRules {required = [_kindRule, providerRule]} ->+              assertEqual (Just (FieldCondition "kind" ["model"])) (providerRule ^. #when)+            _ -> Left "expected frozen nested conditions to survive the compatibility upgrade"+        _ -> Left "expected three frozen condition-aware top-level rules"++-- | The backwards-compatibility guarantee: a descriptor frozen in the okf 0.2.x+-- shape — bare-string frontmatter keys, no descriptions anywhere — still loads,+-- via the legacy fallback decoder, with every description absent.+testLoadLegacyProfileFixture :: IO (Either Text ())+testLoadLegacyProfileFixture = do+  path <- fixtureFilePath "profiles/legacy-0.2.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load legacy profile: " <> err)+    Right spec -> do+      assertEqual "legacy" (spec ^. #name)+      assertEqual Nothing (spec ^. #description)+      assertEqual ["type", "title"] (map (^. #field) (spec ^. #frontmatter . #required))+      assertEqual [Nothing, Nothing] (map (^. #description) (spec ^. #frontmatter . #required))+      assertEqual ["Legacy Concept"] (map (^. #type_) (spec ^. #types))+      assertEqual [Nothing] (map (^. #description) (spec ^. #types))+      assertEqual True (spec ^. #allowUnknownFields)+      assertEqual [[], []] (map (^. #allowedValues) (spec ^. #frontmatter . #required))+      assertEqual [Any, Any] (map (^. #cardinality) (spec ^. #frontmatter . #required))++testProfileFieldDescription :: IO (Either Text ())+testProfileFieldDescription = do+  path <- fixtureFilePath "profiles/postgresql.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load profile: " <> err)+    Right spec -> do+      assertEqual+        (Just "Human-readable name of the object, as a reader would say it.")+        (profileFieldDescription spec "title")+      assertEqual+        (Just "postgresql:// URI locating the live object.")+        (profileFieldDescription spec "resource")+      assertEqual Nothing (profileFieldDescription spec "timestamp")+      assertEqual Nothing (profileFieldDescription spec "nope")++-- | The JSON encoding is pinned field by field, so a future refactor cannot+-- silently rename a key. The @type@ key matters most: the Haskell field is+-- @type_@, and consumers must never see that.+testProfileJsonShape :: IO (Either Text ())+testProfileJsonShape = do+  path <- fixtureFilePath "profiles/decisions.dhall"+  result <- loadProfileFile path+  pure $ case result of+    Left err -> Left ("failed to load document ID profile: " <> err)+    Right spec ->+      assertEqual+        ( object+            [ "name" .= ("decisions" :: Text),+              "description" .= ("How this team records architectural decisions." :: Text),+              "okfVersion" .= ("0.1" :: Text),+              "allowUnknownTypes" .= False,+              "allowUnknownFields" .= True,+              "idField" .= ("docId" :: Text),+              "frontmatter"+                .= object+                  [ "required"+                      .= [ object+                             [ "field" .= ("type" :: Text),+                               "description"+                                 .= ("The OKF concept type; must be a type rule below." :: Text),+                               "allowedValues" .= ([] :: [Text]),+                               "cardinality" .= ("any" :: Text),+                               "format" .= (Nothing :: Maybe Text),+                               "elementFields" .= (Nothing :: Maybe Value),+                               "reference" .= (Nothing :: Maybe HandleReferenceRule),+                               "when" .= (Nothing :: Maybe FieldCondition)+                             ],+                           object+                             [ "field" .= ("title" :: Text),+                               "description" .= (Nothing :: Maybe Text),+                               "allowedValues" .= ([] :: [Text]),+                               "cardinality" .= ("any" :: Text),+                               "format" .= (Nothing :: Maybe Text),+                               "elementFields" .= (Nothing :: Maybe Value),+                               "reference" .= (Nothing :: Maybe HandleReferenceRule),+                               "when" .= (Nothing :: Maybe FieldCondition)+                             ]+                         ],+                    "recommended"+                      .= [ object+                             [ "field" .= ("status" :: Text),+                               "description"+                                 .= ("One of: proposed, accepted, superseded." :: Text),+                               "allowedValues" .= ([] :: [Text]),+                               "cardinality" .= ("any" :: Text),+                               "format" .= (Nothing :: Maybe Text),+                               "elementFields" .= (Nothing :: Maybe Value),+                               "reference" .= (Nothing :: Maybe HandleReferenceRule),+                               "when" .= (Nothing :: Maybe FieldCondition)+                             ]+                         ]+                  ],+              "types"+                .= [ object+                       [ "type" .= ("Decision Record" :: Text),+                         "description"+                           .= ("One accepted decision, never edited after acceptance." :: Text),+                         "frontmatter"+                           .= object+                             [ "required" .= ([] :: [FieldRule]),+                               "recommended" .= ([] :: [FieldRule])+                             ],+                         "pathPattern" .= ("decisions/*" :: Text),+                         "resourceScheme" .= (Nothing :: Maybe Text),+                         "requireSchemaSection" .= False,+                         "schemaColumns" .= ([] :: [Text]),+                         "idPrefix" .= ("ADR" :: Text)+                       ]+                   ]+            ]+        )+        (toJSON spec)++testFieldFormatJsonShape :: Either Text ()+testFieldFormatJsonShape =+  assertEqual+    [ String "rfc3339-utc",+      String "date",+      String "uri",+      object ["uriWithScheme" .= ("mori" :: Text)],+      object ["documentHandle" .= ("ADR" :: Text)]+    ]+    (map toJSON [Rfc3339Utc, Date, Uri, UriWithScheme "mori", DocumentHandle "ADR"])++testFieldConditionJsonShape :: Either Text ()+testFieldConditionJsonShape =+  assertEqual+    (object ["field" .= ("status" :: Text), "hasValue" .= (["superseded"] :: [Text])])+    (toJSON (FieldCondition "status" ["superseded"]))++testHandleReferenceJsonShape :: Either Text ()+testHandleReferenceJsonShape =+  assertEqual+    ( object+        [ "localPrefix" .= ("ADR" :: Text),+          "externalUriSchemes" .= (["mori", "https"] :: [Text]),+          "allowSelf" .= False+        ]+    )+    (toJSON (HandleReferenceRule "ADR" ["mori", "https"] False))++-- | A registry record enumerates every field that decodes as a profile, one+-- level down as well as at the top, sorted by export path. The @Profile@ schema+-- record and the @note@ string contribute nothing.+testRegistryEnumeratesProfiles :: IO (Either Text ())+testRegistryEnumeratesProfiles = do+  path <- fixtureFilePath "registry/package.dhall"+  loaded <- loadRegistry (RegistryFile path)+  pure $ case loaded of+    Left err -> Left ("failed to load fixture registry: " <> err)+    Right entries -> do+      -- `legacy` is a frozen okf 0.2.x descriptor: it enumerates only because+      -- the registry walk falls back to the legacy decoder.+      assertEqual ["legacy", "nested.decisions", "postgresql"] (map (^. #export) entries)+      case findRegistryEntry "legacy" entries of+        Nothing -> Left "expected an entry at export path legacy"+        Just entry -> do+          assertEqual "legacy" (entry ^. #spec . #name)+          assertEqual Nothing (entry ^. #spec . #description)+      case findRegistryEntry "postgresql" entries of+        Nothing -> Left "expected an entry at export path postgresql"+        Just entry -> assertEqual "shinzui-postgresql" (entry ^. #spec . #name)+      assertEqual Nothing (findRegistryEntry "nope" entries)+      assertBool+        "expected findRegistryEntry to resolve the nested export"+        (isJust (findRegistryEntry "nested.decisions" entries))++-- | A registry reference that is itself a profile yields one entry whose export+-- path is empty.+testRegistryRootProfile :: IO (Either Text ())+testRegistryRootProfile = do+  path <- fixtureFilePath "profiles/decisions.dhall"+  loaded <- loadRegistry (RegistryFile path)+  pure $ case loaded of+    Left err -> Left ("failed to load root profile registry: " <> err)+    Right entries -> do+      assertEqual [""] (map (^. #export) entries)+      assertEqual ["decisions"] (map (^. #spec . #name) entries)++-- | A directory holding @package.dhall@ resolves to that file; anything else+-- is handed to Dhall verbatim.+testResolveRegistryRef :: IO (Either Text ())+testResolveRegistryRef = do+  directory <- fixturePath "registry"+  resolvedDirectory <- resolveRegistryRef (Text.pack directory)+  filePath <- fixtureFilePath "profiles/decisions.dhall"+  resolvedFile <- resolveRegistryRef (Text.pack filePath)+  resolvedExpression <- resolveRegistryRef "./nowhere/at/all.dhall"+  pure $ do+    assertEqual (RegistryFile (directory </> "package.dhall")) resolvedDirectory+    assertEqual (RegistryFile filePath) resolvedFile+    assertEqual (RegistryExpression "./nowhere/at/all.dhall") resolvedExpression++-- | A reference that cannot be evaluated reports an error rather than throwing.+testRegistryLoadFailure :: IO (Either Text ())+testRegistryLoadFailure = do+  loaded <- loadRegistry (RegistryFile "/nonexistent/registry.dhall")+  pure $ case loaded of+    Right entries -> Left ("expected a load failure, got " <> Text.pack (show (length entries)) <> " entries")+    Left message -> assertBool "expected a non-empty error message" (not (Text.null message))++testParseDocumentId :: Either Text ()+testParseDocumentId = do+  assertEqual+    (Just (DocumentId {prefix = "ADR", number = 7}))+    (parseDocumentId "ADR-7")+  mapM_+    (\invalid -> assertEqual Nothing (parseDocumentId invalid))+    ["ADR-007", "ADR-0", "ADR-", "-7", "ADR 7", "ADR-7-extra"]+  assertEqual (Just "ADR-7") (renderDocumentId <$> parseDocumentId "ADR-7")++testDocumentIdsInBundle :: IO (Either Text ())+testDocumentIdsInBundle = do+  descriptorPath <- fixtureFilePath "profiles/decisions.dhall"+  loaded <- loadProfileFile descriptorPath+  root <- fixturePath "doc-ids"+  concepts <- readBundle root+  pure $ case loaded of+    Left err -> Left ("failed to load document ID profile: " <> err)+    Right spec -> do+      useMarkdown <- parseTestConceptId "decisions/use-markdown"+      usePostgres <- parseTestConceptId "decisions/use-postgres"+      adoptOkf <- parseTestConceptId "decisions/adopt-okf"+      assertEqual+        [ (DocumentId "ADR" 1, useMarkdown),+          (DocumentId "ADR" 2, usePostgres),+          (DocumentId "ADR" 3, adoptOkf)+        ]+        (documentIdsInBundle spec concepts)++testNextDocumentId :: Either Text ()+testNextDocumentId = do+  firstConcept <-+    profileConcept+      "decisions/first"+      [("type", String "Decision Record"), ("title", String "First"), ("docId", String "ADR-1")]+      "# First\n"+  thirdConcept <-+    profileConcept+      "decisions/third"+      [("type", String "Decision Record"), ("title", String "Third"), ("docId", String "ADR-3")]+      "# Third\n"+  let concepts = [firstConcept, thirdConcept]+  assertEqual (DocumentId "ADR" 4) (nextDocumentId testDocumentIdProfileSpec concepts "ADR")+  assertEqual (DocumentId "RFC" 1) (nextDocumentId testDocumentIdProfileSpec concepts "RFC")++testFindConceptsByDocumentId :: IO (Either Text ())+testFindConceptsByDocumentId = do+  validRoot <- fixturePath "doc-ids"+  validConcepts <- readBundle validRoot+  deviationRoot <- fixturePath "doc-id-deviations"+  deviationConcepts <- readBundle deviationRoot+  pure $ do+    usePostgres <- parseTestConceptId "decisions/use-postgres"+    firstId <- parseTestConceptId "decisions/first"+    secondId <- parseTestConceptId "decisions/second"+    assertEqual+      [usePostgres]+      (conceptIdOf <$> findConceptsByDocumentId Nothing "ADR-2" validConcepts)+    assertEqual+      [firstId, secondId]+      (conceptIdOf <$> findConceptsByDocumentId (Just "docId") "ADR-1" deviationConcepts)++-- | An undocumented frontmatter key: the validation tests care about names, not+-- prose, and descriptions never affect validation.+requiredField :: Text -> FieldRule+requiredField key = FieldRule {field = key, description = Nothing, allowedValues = [], cardinality = Any, format = Nothing, elementFields = Nothing, reference = Nothing, when = Nothing}++-- | A standalone profile literal so the validation tests do not depend on the+-- Dhall fixture. One rule: PostgreSQL Table, fully constrained.+testProfileSpec :: ProfileSpec+testProfileSpec =+  ProfileSpec+    { name = "test-postgresql",+      description = Nothing,+      okfVersion = "0.1",+      frontmatter =+        FrontmatterRules+          { required = [requiredField "type", requiredField "title"],+            recommended = []+          },+      allowUnknownTypes = False,+      allowUnknownFields = True,+      idField = Nothing,+      types =+        [ TypeRule+            { type_ = "PostgreSQL Table",+              description = Nothing,+              frontmatter = emptyTestFrontmatterRules,+              pathPattern = Just "schemas/*/tables/*",+              resourceScheme = Just "postgresql",+              requireSchemaSection = True,+              schemaColumns = ["Column", "Type", "Nullable", "Description"],+              idPrefix = Nothing+            }+        ]+    }++testDocumentIdProfileSpec :: ProfileSpec+testDocumentIdProfileSpec =+  ProfileSpec+    { name = "test-decisions",+      description = Nothing,+      okfVersion = "0.1",+      frontmatter =+        FrontmatterRules+          { required = [requiredField "type", requiredField "title"],+            recommended = []+          },+      allowUnknownTypes = False,+      allowUnknownFields = True,+      idField = Just "docId",+      types =+        [ TypeRule+            { type_ = "Decision Record",+              description = Nothing,+              frontmatter = emptyTestFrontmatterRules,+              pathPattern = Just "decisions/*",+              resourceScheme = Nothing,+              requireSchemaSection = False,+              schemaColumns = [],+              idPrefix = Just "ADR"+            }+        ]+    }++emptyTestFrontmatterRules :: FrontmatterRules+emptyTestFrontmatterRules = FrontmatterRules {required = [], recommended = []}++typeAwareProfileSpec :: ProfileSpec+typeAwareProfileSpec =+  ProfileSpec+    { name = "type-aware",+      description = Nothing,+      okfVersion = "0.1",+      frontmatter =+        FrontmatterRules+          { required = [FieldRule "type" Nothing [] Any Nothing Nothing Nothing Nothing, FieldRule "title" (Just "Global title.") [] Any Nothing Nothing Nothing Nothing],+            recommended = [FieldRule "owner" (Just "Profile-level owner.") [] Any Nothing Nothing Nothing Nothing]+          },+      allowUnknownTypes = True,+      allowUnknownFields = True,+      idField = Nothing,+      types =+        [ TypeRule+            { type_ = "Owned Concept",+              description = Nothing,+              frontmatter =+                FrontmatterRules+                  { required = [FieldRule "owner" (Just "Responsible person.") [] Any Nothing Nothing Nothing Nothing],+                    recommended = [FieldRule "reviewer" (Just "Second pair of eyes.") [] Any Nothing Nothing Nothing Nothing, FieldRule "title" (Just "Type title.") [] Any Nothing Nothing Nothing Nothing]+                  },+              pathPattern = Nothing,+              resourceScheme = Nothing,+              requireSchemaSection = False,+              schemaColumns = [],+              idPrefix = Nothing+            }+        ]+    }++testCompileProfileDefinitionErrors :: Either Text ()+testCompileProfileDefinitionErrors = do+  let duplicateField = FieldRule "title" Nothing [] Any Nothing Nothing Nothing Nothing+      invalid =+        typeAwareProfileSpec+          { frontmatter =+              FrontmatterRules+                { required = [duplicateField, duplicateField],+                  recommended = [duplicateField]+                },+            types = (typeAwareProfileSpec ^. #types) <> (typeAwareProfileSpec ^. #types)+          }+  case compileProfile invalid of+    Right _ -> Left "expected invalid profile definition"+    Left errors ->+      assertEqual+        [ DuplicateFieldRule Nothing "required" "title",+          ConflictingFieldRequirement Nothing "title",+          DuplicateTypeRule "Owned Concept"+        ]+        (toList errors)++testCompiledProfileMerge :: Either Text ()+testCompiledProfileMerge = do+  compiled <- firstShow (compileProfile typeAwareProfileSpec)+  assertEqual (Just "Type title.") (profileFieldDescriptionForType compiled "Owned Concept" "title")+  assertEqual (Just "Responsible person.") (profileFieldDescriptionForType compiled "Owned Concept" "owner")+  assertEqual (Just "Global title.") (profileFieldDescriptionForType compiled "Unknown Concept" "title")+  concept <- profileConcept "owned/one" [("type", String "Owned Concept")] "# One\n"+  cid <- parseTestConceptId "owned/one"+  assertEqual+    [MissingProfileField cid "owner" Nothing, MissingProfileField cid "title" Nothing]+    (validateProfile PermissiveConformance compiled [concept])++vocabularyProfileSpec :: ProfileSpec+vocabularyProfileSpec =+  typeAwareProfileSpec+    { frontmatter =+        FrontmatterRules+          { required = [FieldRule "type" Nothing [] Any Nothing Nothing Nothing Nothing],+            recommended = [FieldRule "status" Nothing ["draft", "approved", "approved"] Any Nothing Nothing Nothing Nothing]+          },+      types =+        [ withTypeFrontmatter+            FrontmatterRules+              { required = [FieldRule "status" Nothing ["approved", "archived"] Any Nothing Nothing Nothing Nothing],+                recommended = []+              }+            (firstTypeRule typeAwareProfileSpec)+        ]+    }++fieldPath :: Text -> FieldPath+fieldPath key = FieldPath (FieldName key :| [])++testCompiledVocabularyIntersection :: Either Text ()+testCompiledVocabularyIntersection = do+  compiled <- firstShow (compileProfile vocabularyProfileSpec)+  concept <- profileConcept "owned/one" [("type", String "Owned Concept"), ("status", String "draft")] "# One\n"+  cid <- parseTestConceptId "owned/one"+  assertEqual+    [ValueNotInVocabulary cid (fieldPath "status") ["approved"] (String "draft")]+    (validateProfile PermissiveConformance compiled [concept])++testUnsatisfiableVocabulary :: Either Text ()+testUnsatisfiableVocabulary = do+  let disjoint =+        vocabularyProfileSpec+          { types =+              [ withTypeFrontmatter+                  FrontmatterRules+                    { required = [FieldRule "status" Nothing ["closed"] Any Nothing Nothing Nothing Nothing],+                      recommended = []+                    }+                  (firstTypeRule vocabularyProfileSpec)+              ]+          }+  assertEqual+    (Left (UnsatisfiableVocabulary (Just "Owned Concept") "status" ["draft", "approved"] ["closed"] :| []))+    (compileProfile disjoint)++testCompiledCardinality :: Either Text ()+testCompiledCardinality = do+  let profileRules =+        FrontmatterRules+          { required = [FieldRule "type" Nothing [] Any Nothing Nothing Nothing Nothing],+            recommended = [FieldRule "status" Nothing [] Scalar Nothing Nothing Nothing Nothing]+          }+      typeRules cardinality =+        FrontmatterRules+          { required = [FieldRule "status" Nothing [] cardinality Nothing Nothing Nothing Nothing],+            recommended = []+          }+      baseType = firstTypeRule typeAwareProfileSpec+      compatible =+        typeAwareProfileSpec+          { frontmatter = profileRules,+            types = [withTypeFrontmatter (typeRules Any) baseType]+          }+      contradictory = compatible {types = [withTypeFrontmatter (typeRules List) baseType]}+  compiled <- firstShow (compileProfile compatible)+  valid <- profileConcept "owned/cardinality" [("type", String "Owned Concept"), ("status", Number 3)] "# Valid\n"+  invalid <- profileConcept "owned/cardinality" [("type", String "Owned Concept"), ("status", toJSON (["draft"] :: [Text]))] "# Invalid\n"+  cid <- parseTestConceptId "owned/cardinality"+  assertEqual [] (validateProfile PermissiveConformance compiled [valid])+  assertEqual+    [CardinalityMismatch cid (fieldPath "status") Scalar (toJSON (["draft"] :: [Text]))]+    (validateProfile PermissiveConformance compiled [invalid])+  assertEqual+    (Left (ConflictingCardinality (Just "Owned Concept") "status" Scalar List :| []))+    (compileProfile contradictory)++testVocabularyValidation :: Either Text ()+testVocabularyValidation = do+  let openVocabulary =+        vocabularyProfileSpec+          { frontmatter =+              FrontmatterRules+                { required = [FieldRule "type" Nothing [] Any Nothing Nothing Nothing Nothing],+                  recommended = [FieldRule "status" Nothing ["draft", "approved"] Any Nothing Nothing Nothing Nothing]+                },+            types = []+          }+  compiled <- firstShow (compileProfile openVocabulary)+  validString <- profileConcept "valid-string" [("type", String "Extension"), ("status", String "draft")] "# Valid\n"+  validList <- profileConcept "valid-list" [("type", String "Extension"), ("status", toJSON (["draft", "approved"] :: [Text]))] "# Valid\n"+  absent <- profileConcept "absent" [("type", String "Extension")] "# Absent\n"+  invalidString <- profileConcept "invalid-string" [("type", String "Extension"), ("status", String "banana")] "# Invalid\n"+  invalidList <- profileConcept "invalid-list" [("type", String "Extension"), ("status", toJSON (["draft", "banana"] :: [Text]))] "# Invalid\n"+  invalidShape <- profileConcept "invalid-shape" [("type", String "Extension"), ("status", toJSON (1 :: Int))] "# Invalid\n"+  invalidStringId <- parseTestConceptId "invalid-string"+  invalidListId <- parseTestConceptId "invalid-list"+  invalidShapeId <- parseTestConceptId "invalid-shape"+  assertEqual [] (validateProfile PermissiveConformance compiled [validString, validList, absent])+  assertEqual+    [ValueNotInVocabulary invalidStringId (fieldPath "status") ["draft", "approved"] (String "banana")]+    (validateProfile PermissiveConformance compiled [invalidString])+  assertEqual+    [ValueNotInVocabulary invalidListId (fieldPath "status") ["draft", "approved"] (toJSON (["draft", "banana"] :: [Text]))]+    (validateProfile PermissiveConformance compiled [invalidList])+  assertEqual+    [ValueNotInVocabulary invalidShapeId (fieldPath "status") ["draft", "approved"] (toJSON (1 :: Int))]+    (validateProfile PermissiveConformance compiled [invalidShape])++testCardinalityValidation :: Either Text ()+testCardinalityValidation = do+  cid <- parseTestConceptId "cardinality"+  let check cardinality actual = do+        compiled <- firstShow (compileProfile (singleCardinalityProfile True cardinality []))+        concept <- profileConcept "cardinality" [("type", String "Extension"), ("value", actual)] "# Cardinality\n"+        pure (validateProfile PermissiveConformance compiled [concept])+      mismatch cardinality actual = [CardinalityMismatch cid (fieldPath "value") cardinality actual]+      objectValue = object ["nested" .= (True :: Bool)]+      textList = toJSON (["one"] :: [Text])+      emptyList = toJSON ([] :: [Text])+  for_ [String "one", Number 0, Bool False] $ \actual ->+    check Scalar actual >>= assertEqual []+  for_ [textList, objectValue, Null] $ \actual ->+    check Scalar actual >>= assertEqual (mismatch Scalar actual)+  check List textList >>= assertEqual []+  for_ [String "one", Number 0, Bool False, objectValue, Null] $ \actual ->+    check List actual >>= assertEqual (mismatch List actual)+  check Any (String "one") >>= assertEqual []+  check Any textList >>= assertEqual []+  check Any (Bool False) >>= assertEqual [MissingProfileField cid "value" Nothing]+  check Scalar (String "   ") >>= assertEqual [MissingProfileField cid "value" Nothing]+  check List emptyList >>= assertEqual [MissingProfileField cid "value" Nothing]+  optionalCompiled <- firstShow (compileProfile (singleCardinalityProfile False Scalar []))+  optionalConcept <- profileConcept "cardinality" [("type", String "Extension"), ("value", textList)] "# Optional\n"+  assertEqual+    (mismatch Scalar textList)+    (validateProfile PermissiveConformance optionalCompiled [optionalConcept])++testCardinalityVocabularyInteraction :: Either Text ()+testCardinalityVocabularyInteraction = do+  cid <- parseTestConceptId "cardinality"+  scalarCompiled <- firstShow (compileProfile (singleCardinalityProfile True Scalar ["draft"]))+  let objectValue = object ["status" .= ("draft" :: Text)]+  objectConcept <- profileConcept "cardinality" [("type", String "Extension"), ("value", objectValue)] "# Object\n"+  assertEqual+    [CardinalityMismatch cid (fieldPath "value") Scalar objectValue]+    (validateProfile PermissiveConformance scalarCompiled [objectConcept])+  listCompiled <- firstShow (compileProfile (singleCardinalityProfile True List ["draft"]))+  let mixedList = toJSON ([String "draft", Number 1] :: [Value])+  listConcept <- profileConcept "cardinality" [("type", String "Extension"), ("value", mixedList)] "# List\n"+  assertEqual+    [ValueNotInVocabulary cid (fieldPath "value") ["draft"] mixedList]+    (validateProfile PermissiveConformance listCompiled [listConcept])++testCompiledFieldFormats :: Either Text ()+testCompiledFieldFormats = do+  let baseType = firstTypeRule typeAwareProfileSpec+      profileWith profileFormat typeFormat =+        typeAwareProfileSpec+          { frontmatter =+              FrontmatterRules+                { required = [FieldRule "type" Nothing [] Any Nothing Nothing Nothing Nothing, FieldRule "homepage" Nothing [] Any (Just profileFormat) Nothing Nothing Nothing],+                  recommended = []+                },+            types =+              [ withTypeFrontmatter+                  FrontmatterRules+                    { required = [FieldRule "homepage" Nothing [] Any (Just typeFormat) Nothing Nothing Nothing],+                      recommended = []+                    }+                  baseType+              ]+          }+  refined <- firstShow (compileProfile (profileWith Uri (UriWithScheme "https")))+  valid <- profileConcept "format-refinement" [("type", String "Owned Concept"), ("homepage", String "HTTPS://example.test/path")] "# Valid\n"+  invalid <- profileConcept "format-refinement" [("type", String "Owned Concept"), ("homepage", String "http://example.test/path")] "# Invalid\n"+  cid <- parseTestConceptId "format-refinement"+  assertEqual [] (validateProfile PermissiveConformance refined [valid])+  assertEqual+    [ValueFormatMismatch cid (fieldPath "homepage") (UriWithScheme "https") (String "http://example.test/path")]+    (validateProfile PermissiveConformance refined [invalid])+  assertEqual+    (Left (ConflictingFieldFormat (fieldPath "homepage") Date Rfc3339Utc :| []))+    (compileProfile (profileWith Date Rfc3339Utc))++testInvalidFormatParameters :: Either Text ()+testInvalidFormatParameters = do+  let invalid =+        typeAwareProfileSpec+          { frontmatter =+              FrontmatterRules+                { required =+                    [ FieldRule "type" Nothing [] Any Nothing Nothing Nothing Nothing,+                      FieldRule "handle" Nothing [] Any (Just (DocumentHandle "1ADR")) Nothing Nothing Nothing,+                      FieldRule "source" Nothing [] Any (Just (UriWithScheme "https_")) Nothing Nothing Nothing+                    ],+                  recommended = []+                },+            types = []+          }+  assertEqual+    ( Left+        ( InvalidFormatParameter (fieldPath "handle") (DocumentHandle "1ADR") "1ADR"+            :| [InvalidFormatParameter (fieldPath "source") (UriWithScheme "https_") "https_"]+        )+    )+    (compileProfile invalid)++testNamedFormatValidation :: Either Text ()+testNamedFormatValidation = do+  cid <- parseTestConceptId "format"+  let check fieldFormat cardinality actual = do+        compiled <- firstShow (compileProfile (singleFormatProfile cardinality fieldFormat))+        concept <-+          profileConcept+            "format"+            ([("type", String "Extension")] <> maybe [] (\value -> [("value", value)]) actual)+            "# Format\n"+        pure (validateProfile PermissiveConformance compiled [concept])+      mismatch fieldFormat actual = [ValueFormatMismatch cid (fieldPath "value") fieldFormat actual]+  for_ ["2024-02-29T23:59:59Z", "2026-07-29T17:00:00.125Z"] $ \value ->+    check Rfc3339Utc Any (Just (String value)) >>= assertEqual []+  for_ ["2026-13-45T99:99:99Z", "2026-07-29T17:00:00+01:00", "2026-07-29 17:00:00Z"] $ \value ->+    check Rfc3339Utc Any (Just (String value)) >>= assertEqual (mismatch Rfc3339Utc (String value))+  check Date Any (Just (String "2024-02-29")) >>= assertEqual []+  for_ ["2023-02-29", "2026-13-01", "2026-07-29T00:00:00Z"] $ \value ->+    check Date Any (Just (String value)) >>= assertEqual (mismatch Date (String value))+  for_ ["https://example.test/path", "urn:example:item"] $ \value ->+    check Uri Any (Just (String value)) >>= assertEqual []+  for_ ["relative/path", "https://example.test/bad%ZZ"] $ \value ->+    check Uri Any (Just (String value)) >>= assertEqual (mismatch Uri (String value))+  check (UriWithScheme "mori") Any (Just (String "MORI://haskell/time")) >>= assertEqual []+  check (UriWithScheme "mori") Any (Just (String "https://example.test"))+    >>= assertEqual (mismatch (UriWithScheme "mori") (String "https://example.test"))+  check (DocumentHandle "ADR") Any (Just (String "ADR-7")) >>= assertEqual []+  for_ ["ADR-007", "IR-7"] $ \value ->+    check (DocumentHandle "ADR") Any (Just (String value))+      >>= assertEqual (mismatch (DocumentHandle "ADR") (String value))+  let validUris = toJSON (["https://example.test", "urn:example:item"] :: [Text])+      mixedUris = toJSON ([String "https://example.test", Number 1] :: [Value])+  check Uri List (Just validUris) >>= assertEqual []+  check Uri List (Just mixedUris) >>= assertEqual (mismatch Uri mixedUris)+  check Uri Scalar (Just validUris)+    >>= assertEqual [CardinalityMismatch cid (fieldPath "value") Scalar validUris]+  check Uri Any (Just (Number 1)) >>= assertEqual (mismatch Uri (Number 1))+  check Uri Any Nothing >>= assertEqual []++singleFormatProfile :: Cardinality -> FieldFormat -> ProfileSpec+singleFormatProfile cardinality fieldFormat =+  typeAwareProfileSpec+    { frontmatter =+        FrontmatterRules+          { required = [FieldRule "type" Nothing [] Any Nothing Nothing Nothing Nothing],+            recommended = [FieldRule "value" Nothing [] cardinality (Just fieldFormat) Nothing Nothing Nothing]+          },+      allowUnknownTypes = True,+      types = []+    }++singleCardinalityProfile :: Bool -> Cardinality -> [Text] -> ProfileSpec+singleCardinalityProfile isRequired cardinality allowed =+  typeAwareProfileSpec+    { frontmatter =+        FrontmatterRules+          { required = [FieldRule "type" Nothing [] Any Nothing Nothing Nothing Nothing] <> [rule | isRequired],+            recommended = [rule | not isRequired]+          },+      allowUnknownTypes = True,+      types = []+    }+  where+    rule = FieldRule "value" Nothing allowed cardinality Nothing Nothing Nothing Nothing++testCompiledNestedRules :: Either Text ()+testCompiledNestedRules = do+  let profileRules =+        NestedRules+          { required = [NestedFieldRule "kind" Nothing ["decision", "implementation"] Any Nothing Nothing],+            recommended = [NestedFieldRule "notes" Nothing [] Scalar Nothing Nothing]+          }+      typeRules =+        NestedRules+          { required =+              [ NestedFieldRule "kind" Nothing ["implementation", "operations"] Any Nothing Nothing,+                NestedFieldRule "outcome" Nothing ["approved", "rejected"] Any Nothing Nothing+              ],+            recommended = []+          }+      base = nestedProfileWithRules Any profileRules (Just typeRules)+  compiled <- firstShow (compileProfile base)+  concept <-+    profileConcept+      "reviewed/merge"+      [ ("type", String "Reviewed Concept"),+        ( "reviews",+          toJSON+            [ object+                [ "kind" .= ("decision" :: Text),+                  "outcome" .= ("approved" :: Text)+                ]+            ]+        )+      ]+      "# Merge\n"+  cid <- parseTestConceptId "reviewed/merge"+  assertEqual+    [ ValueNotInVocabulary+        cid+        (nestedTestPath 0 "kind")+        ["implementation"]+        (String "decision")+    ]+    (validateProfile PermissiveConformance compiled [concept])+  let impossible = nestedProfileWithRules Scalar profileRules Nothing+  assertEqual+    (Left (ElementFieldsRequireList Nothing (fieldPath "reviews") Scalar :| []))+    (compileProfile impossible)++testNestedRecordValidation :: Either Text ()+testNestedRecordValidation = do+  compiled <- firstShow (compileProfile nestedReviewProfileSpec)+  let firstReview =+        object+          [ "kind" .= ("human" :: Text),+            "reviewer" .= ("Ari" :: Text),+            "reviewed_at" .= ("2026-07-29T16:00:00Z" :: Text),+            "document_timestamp" .= ("2026-07-29T17:00:00Z" :: Text),+            "scope" .= ("content" :: Text),+            "outcome" .= ("approved" :: Text),+            "context" .= ("Complete" :: Text),+            "notes" .= ("No blockers" :: Text),+            "provider" .= ("allowed-extra-key" :: Text)+          ]+      thirdReview =+        object+          [ "kind" .= ("model" :: Text),+            "reviewer" .= ("Bo" :: Text),+            "reviewed_at" .= ("2026-13-45T99:99:99Z" :: Text),+            "document_timestamp" .= ("2026-07-29T17:00:00Z" :: Text),+            "scope" .= ("invalid" :: Text),+            "context" .= (["wrong"] :: [Text])+          ]+      reviewValues = toJSON [firstReview, String "not-a-record", thirdReview]+  concept <-+    profileConcept+      "reviewed/bad"+      [("type", String "Reviewed Concept"), ("reviews", reviewValues)]+      "# Bad\n"+  cid <- parseTestConceptId "reviewed/bad"+  let permissiveExpected =+        [ NestedElementNotRecord cid (FieldPath (FieldName "reviews" :| [ArrayIndex 1])) (String "not-a-record"),+          CardinalityMismatch cid (nestedTestPath 2 "context") Scalar (toJSON (["wrong"] :: [Text])),+          MissingNestedProfileField cid (nestedTestPath 2 "outcome") Nothing,+          ValueFormatMismatch cid (nestedTestPath 2 "reviewed_at") Rfc3339Utc (String "2026-13-45T99:99:99Z"),+          ValueNotInVocabulary cid (nestedTestPath 2 "scope") reviewScopes (String "invalid")+        ]+  assertEqual permissiveExpected (validateProfile PermissiveConformance compiled [concept])+  assertEqual+    [ NestedElementNotRecord cid (FieldPath (FieldName "reviews" :| [ArrayIndex 1])) (String "not-a-record"),+      CardinalityMismatch cid (nestedTestPath 2 "context") Scalar (toJSON (["wrong"] :: [Text])),+      MissingRecommendedNestedProfileField cid (nestedTestPath 2 "notes") Nothing,+      MissingNestedProfileField cid (nestedTestPath 2 "outcome") Nothing,+      ValueFormatMismatch cid (nestedTestPath 2 "reviewed_at") Rfc3339Utc (String "2026-13-45T99:99:99Z"),+      ValueNotInVocabulary cid (nestedTestPath 2 "scope") reviewScopes (String "invalid")+    ]+    (validateProfile StrictAuthoring compiled [concept])++nestedProfileWithRules :: Cardinality -> NestedRules -> Maybe NestedRules -> ProfileSpec+nestedProfileWithRules outerCardinality profileNested typeNested =+  ProfileSpec+    { name = "nested-merge",+      description = Nothing,+      okfVersion = "0.1",+      frontmatter =+        FrontmatterRules+          { required =+              [ requiredField "type",+                FieldRule "reviews" Nothing [] outerCardinality Nothing (Just profileNested) Nothing Nothing+              ],+            recommended = []+          },+      allowUnknownTypes = False,+      allowUnknownFields = True,+      idField = Nothing,+      types =+        [ TypeRule+            { type_ = "Reviewed Concept",+              description = Nothing,+              frontmatter =+                FrontmatterRules+                  { required = maybe [] (\rules -> [FieldRule "reviews" Nothing [] Any Nothing (Just rules) Nothing Nothing]) typeNested,+                    recommended = []+                  },+              pathPattern = Nothing,+              resourceScheme = Nothing,+              requireSchemaSection = False,+              schemaColumns = [],+              idPrefix = Nothing+            }+        ]+    }++nestedReviewProfileSpec :: ProfileSpec+nestedReviewProfileSpec =+  nestedProfileWithRules Any nestedRules Nothing+  where+    nestedRules =+      NestedRules+        { required =+            [ NestedFieldRule "kind" Nothing ["human", "model"] Any Nothing Nothing,+              NestedFieldRule "reviewer" Nothing [] Scalar Nothing Nothing,+              NestedFieldRule "reviewed_at" Nothing [] Any (Just Rfc3339Utc) Nothing,+              NestedFieldRule "document_timestamp" Nothing [] Any (Just Rfc3339Utc) Nothing,+              NestedFieldRule "scope" Nothing reviewScopes Any Nothing Nothing,+              NestedFieldRule "outcome" Nothing ["approved", "changes-requested", "commented"] Any Nothing Nothing,+              NestedFieldRule "context" Nothing [] Scalar Nothing Nothing+            ],+          recommended = [NestedFieldRule "notes" Nothing [] Scalar Nothing Nothing]+        }++nestedTestPath :: Int -> Text -> FieldPath+nestedTestPath elementIndex key =+  FieldPath (FieldName "reviews" :| [ArrayIndex elementIndex, FieldName key])++reviewScopes :: [Text]+reviewScopes = ["content", "technical-accuracy", "editorial", "catalog-metadata", "content-and-metadata"]++testConditionDefinitionErrors :: Either Text ()+testConditionDefinitionErrors = do+  let source key values sourceCardinality =+        FieldRule key Nothing values sourceCardinality Nothing Nothing Nothing Nothing+      target key sourceKey values =+        FieldRule key Nothing [] Any Nothing Nothing Nothing (Just (FieldCondition sourceKey values))+      compileWith rules =+        compileProfile+          typeAwareProfileSpec+            { frontmatter = FrontmatterRules {required = rules, recommended = []},+              allowUnknownTypes = True,+              types = []+            }+      targetPath key = fieldPath key+  assertEqual+    (Left (EmptyConditionValues Nothing (targetPath "target") (targetPath "status") :| []))+    (compileWith [source "status" ["active"] Scalar, target "target" "status" []])+  assertEqual+    (Left (ConditionFieldNotDeclared Nothing (targetPath "target") (targetPath "missing") :| []))+    (compileWith [target "target" "missing" ["active"]])+  assertEqual+    (Left (ConditionFieldNotScalar Nothing (targetPath "target") (targetPath "status") List :| []))+    (compileWith [source "status" ["active"] List, target "target" "status" ["active"]])+  assertEqual+    (Left (ConditionFieldOpenVocabulary Nothing (targetPath "target") (targetPath "status") :| []))+    (compileWith [source "status" [] Scalar, target "target" "status" ["active"]])+  assertEqual+    (Left (ConditionFieldHasUnreachableValues Nothing (targetPath "target") (targetPath "status") ["superseded"] ["active"] :| []))+    (compileWith [source "status" ["active"] Scalar, target "target" "status" ["superseded"]])+  assertEqual+    (Left (SelfConditionalField Nothing (targetPath "status") :| []))+    (compileWith [FieldRule "status" Nothing ["active"] Scalar Nothing Nothing Nothing (Just (FieldCondition "status" ["active"]))])+  let nestedCrossScope =+        NestedRules+          { required =+              [ NestedFieldRule "kind" Nothing ["human", "model"] Scalar Nothing Nothing,+                NestedFieldRule "provider" Nothing [] Scalar Nothing (Just (FieldCondition "status" ["active"]))+              ],+            recommended = []+          }+      crossScopeProfile =+        typeAwareProfileSpec+          { frontmatter =+              FrontmatterRules+                { required =+                    [ source "status" ["active"] Scalar,+                      FieldRule "reviews" Nothing [] List Nothing (Just nestedCrossScope) Nothing Nothing+                    ],+                  recommended = []+                },+            allowUnknownTypes = True,+            types = []+          }+  assertEqual+    (Left (ConditionFieldNotDeclared Nothing (nestedDefinitionTestPath "reviews" "provider") (nestedDefinitionTestPath "reviews" "status") :| []))+    (compileProfile crossScopeProfile)+  where+    nestedDefinitionTestPath parent child =+      FieldPath (FieldName parent :| [FieldName child])++testTopLevelConditionalPresence :: Either Text ()+testTopLevelConditionalPresence = do+  let statusRule = FieldRule "status" Nothing ["active", "superseded"] Scalar Nothing Nothing Nothing Nothing+      recommendedTarget =+        FieldRule "supersededBy" Nothing ["ADR-1"] Scalar Nothing Nothing Nothing (Just (FieldCondition "status" ["active"]))+      requiredTarget =+        FieldRule "supersededBy" Nothing ["ADR-1"] Scalar Nothing Nothing Nothing (Just (FieldCondition "status" ["superseded"]))+      base =+        typeAwareProfileSpec+          { frontmatter = FrontmatterRules {required = [requiredField "type", statusRule], recommended = [recommendedTarget]},+            allowUnknownTypes = True,+            types =+              [ withTypeFrontmatter+                  FrontmatterRules {required = [requiredTarget], recommended = []}+                  (firstTypeRule typeAwareProfileSpec)+              ]+          }+  compiled <- firstShow (compileProfile base)+  active <- profileConcept "active" [("type", String "Owned Concept"), ("status", String "active")] "# Active\n"+  superseded <- profileConcept "superseded" [("type", String "Owned Concept"), ("status", String "superseded")] "# Superseded\n"+  invalidPresent <- profileConcept "invalid-present" [("type", String "Owned Concept"), ("status", String "active"), ("supersededBy", String "ADR-2")] "# Invalid\n"+  missingSource <- profileConcept "missing-source" [("type", String "Owned Concept")] "# Missing source\n"+  invalidSource <- profileConcept "invalid-source" [("type", String "Owned Concept"), ("status", String "unknown")] "# Invalid source\n"+  wrongShapeSource <- profileConcept "wrong-shape-source" [("type", String "Owned Concept"), ("status", toJSON (["active"] :: [Text]))] "# Wrong shape\n"+  activeId <- parseTestConceptId "active"+  supersededId <- parseTestConceptId "superseded"+  invalidId <- parseTestConceptId "invalid-present"+  missingSourceId <- parseTestConceptId "missing-source"+  invalidSourceId <- parseTestConceptId "invalid-source"+  wrongShapeSourceId <- parseTestConceptId "wrong-shape-source"+  assertEqual [] (validateProfile PermissiveConformance compiled [active])+  assertEqual+    [MissingRecommendedProfileField activeId "supersededBy" (Just (FieldCondition "status" ["active"]))]+    (validateProfile StrictAuthoring compiled [active])+  assertEqual+    [MissingProfileField supersededId "supersededBy" (Just (FieldCondition "status" ["superseded"]))]+    (validateProfile PermissiveConformance compiled [superseded])+  assertEqual+    [ValueNotInVocabulary invalidId (fieldPath "supersededBy") ["ADR-1"] (String "ADR-2")]+    (validateProfile PermissiveConformance compiled [invalidPresent])+  assertEqual+    [MissingProfileField missingSourceId "status" Nothing]+    (validateProfile PermissiveConformance compiled [missingSource])+  assertEqual+    [ValueNotInVocabulary invalidSourceId (fieldPath "status") ["active", "superseded"] (String "unknown")]+    (validateProfile PermissiveConformance compiled [invalidSource])+  assertEqual+    [CardinalityMismatch wrongShapeSourceId (fieldPath "status") Scalar (toJSON (["active"] :: [Text]))]+    (validateProfile PermissiveConformance compiled [wrongShapeSource])++testNestedConditionalPresence :: Either Text ()+testNestedConditionalPresence = do+  let nestedRules =+        NestedRules+          { required =+              [ NestedFieldRule "kind" Nothing ["human", "model"] Scalar Nothing Nothing,+                NestedFieldRule "provider" Nothing [] Scalar Nothing (Just (FieldCondition "kind" ["model"]))+              ],+            recommended =+              [NestedFieldRule "notes" Nothing [] Scalar Nothing (Just (FieldCondition "kind" ["human"]))]+          }+      spec = nestedProfileWithRules List nestedRules Nothing+  compiled <- firstShow (compileProfile spec)+  concept <-+    profileConcept+      "conditional-reviews"+      [ ("type", String "Reviewed Concept"),+        ("reviews", toJSON [object ["kind" .= ("model" :: Text)], object ["kind" .= ("human" :: Text)], object []])+      ]+      "# Conditional reviews\n"+  cid <- parseTestConceptId "conditional-reviews"+  assertEqual+    [MissingNestedProfileField cid (nestedTestPath 0 "provider") (Just (FieldCondition "kind" ["model"])), MissingNestedProfileField cid (nestedTestPath 2 "kind") Nothing]+    (validateProfile PermissiveConformance compiled [concept])+  assertEqual+    [ MissingNestedProfileField cid (nestedTestPath 0 "provider") (Just (FieldCondition "kind" ["model"])),+      MissingRecommendedNestedProfileField cid (nestedTestPath 1 "notes") (Just (FieldCondition "kind" ["human"])),+      MissingNestedProfileField cid (nestedTestPath 2 "kind") Nothing+    ]+    (validateProfile StrictAuthoring compiled [concept])++testReferenceDefinitionErrors :: Either Text ()+testReferenceDefinitionErrors = do+  let referenceRule key prefix schemes fieldFormat =+        FieldRule+          key+          Nothing+          []+          Scalar+          fieldFormat+          Nothing+          (Just (HandleReferenceRule prefix schemes False))+          Nothing+      baseType = firstTypeRule testDocumentIdProfileSpec+      specWith profileIdField typeRules profileRules =+        testDocumentIdProfileSpec+          { frontmatter = FrontmatterRules {required = profileRules, recommended = []},+            idField = profileIdField,+            types = typeRules+          }+      path = fieldPath "supersedes"+      invalidPrefixType = baseType {idPrefix = Just "1ADR"}+      invalidPrefixSpec = specWith (Just "docId") [invalidPrefixType] [referenceRule "supersedes" "1ADR" [] Nothing]+      undeclaredPrefixSpec = specWith (Just "docId") [baseType] [referenceRule "supersedes" "PAT" [] Nothing]+      missingIdFieldSpec = specWith Nothing [baseType] [referenceRule "supersedes" "ADR" [] Nothing]+      invalidSchemeSpec = specWith (Just "docId") [baseType] [referenceRule "supersedes" "ADR" ["mori_", "MORI_"] Nothing]+      formatSpec = specWith (Just "docId") [baseType] [referenceRule "supersedes" "ADR" [] (Just (DocumentHandle "ADR"))]+      typeReference = referenceRule "supersedes" "RFC" [] Nothing+      conflictingType :: TypeRule+      conflictingType = baseType & #frontmatter .~ FrontmatterRules {required = [typeReference], recommended = []}+      rfcType = baseType {type_ = "RFC", idPrefix = Just "RFC", pathPattern = Nothing}+      conflictSpec = specWith (Just "docId") [conflictingType, rfcType] [referenceRule "supersedes" "ADR" [] Nothing]+  assertEqual+    (Left (InvalidReferencePrefix Nothing path "1ADR" :| []))+    (compileProfile invalidPrefixSpec)+  assertEqual+    (Left (ReferencePrefixNotDeclared Nothing path "PAT" :| []))+    (compileProfile undeclaredPrefixSpec)+  assertEqual+    (Left (ReferenceRequiresIdField Nothing path :| []))+    (compileProfile missingIdFieldSpec)+  assertEqual+    (Left (InvalidExternalReferenceScheme Nothing path "mori_" :| []))+    (compileProfile invalidSchemeSpec)+  assertEqual+    (Left (ReferenceWithFormat Nothing path (DocumentHandle "ADR") :| []))+    (compileProfile formatSpec)+  assertEqual+    (Left (ConflictingReferencePrefix "Decision Record" path "ADR" "RFC" :| []))+    (compileProfile conflictSpec)++testDocumentReferenceValidation :: Either Text ()+testDocumentReferenceValidation = do+  let referencePolicy = HandleReferenceRule "ADR" ["mori", "MORI"] False+      selfPolicy = HandleReferenceRule "ADR" [] True+      referenceRules =+        [ FieldRule "references" Nothing [] List Nothing Nothing (Just referencePolicy) Nothing,+          FieldRule "selfReference" Nothing [] Scalar Nothing Nothing (Just selfPolicy) Nothing+        ]+      spec :: ProfileSpec+      spec =+        testDocumentIdProfileSpec+          & #frontmatter+          .~ FrontmatterRules+            { required = [requiredField "type", requiredField "title"],+              recommended = referenceRules+            }+  compiled <- firstShow (compileProfile spec)+  duplicateA <- decisionConcept "decisions/duplicate-a" "Duplicate A" "ADR-3" []+  duplicateB <- decisionConcept "decisions/duplicate-b" "Duplicate B" "ADR-3" []+  source <-+    decisionConcept+      "decisions/source"+      "Source"+      "ADR-1"+      [ ( "references",+          toJSON+            [ String "ADR-2",+              String "ADR-99",+              String "PAT-3",+              String "not a reference",+              String "https://example.test/external",+              String "MORI://shinzui/okf/docs/one",+              String "ADR-1",+              Number 7,+              String "ADR-3"+            ]+        ),+        ("selfReference", String "ADR-1")+      ]+  target <- decisionConcept "decisions/target" "Target" "ADR-2" []+  duplicateAId <- parseTestConceptId "decisions/duplicate-a"+  duplicateBId <- parseTestConceptId "decisions/duplicate-b"+  sourceId <- parseTestConceptId "decisions/source"+  assertEqual+    [ DanglingHandleReference sourceId (indexedPath "references" 1) "ADR-99",+      ReferenceHandlePrefixMismatch sourceId (indexedPath "references" 2) "PAT-3" "ADR",+      MalformedDocumentReference sourceId (indexedPath "references" 3) (String "not a reference"),+      ExternalReferenceSchemeNotAllowed sourceId (indexedPath "references" 4) "https" ["mori"],+      SelfDocumentReference sourceId (indexedPath "references" 6) "ADR-1",+      MalformedDocumentReference sourceId (indexedPath "references" 7) (Number 7),+      DuplicateDocumentId "ADR-3" duplicateAId duplicateBId+    ]+    (validateProfile PermissiveConformance compiled [target, source, duplicateB, duplicateA])+  where+    decisionConcept cid title documentId extraFields =+      profileConcept+        cid+        ([("type", String "Decision Record"), ("title", String title), ("docId", String documentId)] <> extraFields)+        ("# " <> title <> "\n")+    indexedPath key elementIndex = FieldPath (FieldName key :| [ArrayIndex elementIndex])++testClosedFieldValidation :: Either Text ()+testClosedFieldValidation = do+  let ownedRule :: TypeRule+      ownedRule =+        withTypeFrontmatter+          FrontmatterRules {required = [requiredField "owner"], recommended = []}+          (firstTypeRule typeAwareProfileSpec)+      reviewRule =+        withTypeName+          "Review"+          (withTypeFrontmatter FrontmatterRules {required = [requiredField "reviewer"], recommended = []} ownedRule)+      closed =+        typeAwareProfileSpec+          { frontmatter = FrontmatterRules {required = [requiredField "type", requiredField "status"], recommended = []},+            allowUnknownFields = False,+            idField = Just "requestId",+            types = [ownedRule, reviewRule]+          }+  compiled <- firstShow (compileProfile closed)+  typo <-+    profileConcept+      "owned/typo"+      [ ("type", String "Owned Concept"),+        ("title", String "Typo"),+        ("description", String "Core"),+        ("timestamp", String "2026-07-29T00:00:00Z"),+        ("resource", String "https://example.test/typo"),+        ("tags", toJSON (["profiles"] :: [Text])),+        ("requestId", String "IR-1"),+        ("owner", String "Ari"),+        ("reviewer", String "Bo"),+        ("stauts", String "draft")+      ]+      "# Typo\n"+  cid <- parseTestConceptId "owned/typo"+  assertEqual+    [ MissingProfileField cid "status" Nothing,+      FieldNotInProfile cid "reviewer",+      FieldNotInProfile cid "stauts"+    ]+    (validateProfile PermissiveConformance compiled [typo])+  let reopened = closed {allowUnknownFields = True}+  reopenedCompiled <- firstShow (compileProfile reopened)+  assertEqual+    [MissingProfileField cid "status" Nothing]+    (validateProfile PermissiveConformance reopenedCompiled [typo])++firstTypeRule :: ProfileSpec -> TypeRule+firstTypeRule spec =+  case spec ^. #types of+    rule : _ -> rule+    [] -> error "test profile unexpectedly has no type rules"++withTypeFrontmatter :: FrontmatterRules -> TypeRule -> TypeRule+withTypeFrontmatter+  replacement+  TypeRule+    { type_,+      description,+      pathPattern,+      resourceScheme,+      requireSchemaSection,+      schemaColumns,+      idPrefix+    } =+    TypeRule+      { type_,+        description,+        frontmatter = replacement,+        pathPattern,+        resourceScheme,+        requireSchemaSection,+        schemaColumns,+        idPrefix+      }++withTypeName :: Text -> TypeRule -> TypeRule+withTypeName+  replacement+  TypeRule+    { description,+      frontmatter,+      pathPattern,+      resourceScheme,+      requireSchemaSection,+      schemaColumns,+      idPrefix+    } =+    TypeRule+      { type_ = replacement,+        description,+        frontmatter,+        pathPattern,+        resourceScheme,+        requireSchemaSection,+        schemaColumns,+        idPrefix+      }++testProfileRulesApplyToUnknownTypes :: Either Text ()+testProfileRulesApplyToUnknownTypes = do+  compiled <- firstShow (compileProfile typeAwareProfileSpec)+  concept <- profileConcept "extensions/one" [("type", String "Extension Concept")] "# One\n"+  cid <- parseTestConceptId "extensions/one"+  assertEqual+    [MissingProfileField cid "title" Nothing]+    (validateProfile PermissiveConformance compiled [concept])++testStrictProfileRecommendations :: Either Text ()+testStrictProfileRecommendations = do+  compiled <- firstShow (compileProfile typeAwareProfileSpec)+  concept <-+    profileConcept+      "owned/one"+      [("type", String "Owned Concept"), ("title", String "One"), ("owner", String "Ari")]+      "# One\n"+  cid <- parseTestConceptId "owned/one"+  assertEqual [] (validateProfile PermissiveConformance compiled [concept])+  assertEqual+    [MissingRecommendedProfileField cid "reviewer" Nothing]+    (validateProfile StrictAuthoring compiled [concept])++-- | Build an in-memory concept from a raw ID, frontmatter pairs, and a body.+profileConcept :: Text -> [(Text, Value)] -> Text -> Either Text Concept+profileConcept rawId fieldPairs bodyText = do+  conceptId <- parseTestConceptId rawId+  pure (conceptFromDocument conceptId (OKFDocument (frontmatterFromFields fieldPairs) bodyText))++-- | A well-formed @# Schema@ section matching the profile's required columns.+schemaSectionBody :: Text+schemaSectionBody =+  Text.unlines+    [ "# Schema",+      "",+      "| Column | Type   | Nullable | Description |",+      "|--------|--------|----------|-------------|",+      "| id     | bigint | no       | Primary key |"+    ]++testProfileConformingTable :: Either Text ()+testProfileConformingTable = do+  concept <-+    profileConcept+      "schemas/sales/tables/orders"+      [ ("type", String "PostgreSQL Table"),+        ("title", String "Orders"),+        ("resource", String "postgresql://warehouse/sales/orders")+      ]+      schemaSectionBody+  assertEqual [] (validateTestProfile testProfileSpec [concept])++testProfileUnknownType :: Either Text ()+testProfileUnknownType = do+  concept <-+    profileConcept+      "schemas/sales/tables/bad"+      [("type", String "pg table"), ("resource", String "postgresql://x")]+      schemaSectionBody+  cid <- parseTestConceptId "schemas/sales/tables/bad"+  assertEqual+    [TypeNotInProfile cid "pg table", MissingProfileField cid "title" Nothing]+    (validateTestProfile testProfileSpec [concept])++testProfileMissingField :: Either Text ()+testProfileMissingField = do+  concept <-+    profileConcept+      "schemas/sales/tables/orders"+      [("type", String "PostgreSQL Table"), ("resource", String "postgresql://x")]+      schemaSectionBody+  cid <- parseTestConceptId "schemas/sales/tables/orders"+  assertEqual [MissingProfileField cid "title" Nothing] (validateTestProfile testProfileSpec [concept])++testProfileResourceMismatch :: Either Text ()+testProfileResourceMismatch = do+  concept <-+    profileConcept+      "schemas/sales/tables/orders"+      [("type", String "PostgreSQL Table"), ("title", String "Orders"), ("resource", String "mysql://x")]+      schemaSectionBody+  cid <- parseTestConceptId "schemas/sales/tables/orders"+  assertEqual+    [ResourceSchemeMismatch cid "postgresql" "mysql://x"]+    (validateTestProfile testProfileSpec [concept])++testProfilePathMismatch :: Either Text ()+testProfilePathMismatch = do+  concept <-+    profileConcept+      "tables/orders"+      [("type", String "PostgreSQL Table"), ("title", String "Orders"), ("resource", String "postgresql://x")]+      schemaSectionBody+  cid <- parseTestConceptId "tables/orders"+  assertEqual+    [PathPatternMismatch cid "PostgreSQL Table" "schemas/*/tables/*"]+    (validateTestProfile testProfileSpec [concept])++testProfileMissingSchema :: Either Text ()+testProfileMissingSchema = do+  concept <-+    profileConcept+      "schemas/sales/tables/orders"+      [("type", String "PostgreSQL Table"), ("title", String "Orders"), ("resource", String "postgresql://x")]+      "# Overview\n\nNo schema section here.\n"+  cid <- parseTestConceptId "schemas/sales/tables/orders"+  assertEqual+    [MissingSchemaSection cid "PostgreSQL Table"]+    (validateTestProfile testProfileSpec [concept])++testProfileSchemaColumnsMismatch :: Either Text ()+testProfileSchemaColumnsMismatch = do+  let mismatchBody =+        Text.unlines+          ["# Schema", "", "| Col | Type |", "|-----|------|", "| id  | bigint |"]+  concept <-+    profileConcept+      "schemas/sales/tables/orders"+      [("type", String "PostgreSQL Table"), ("title", String "Orders"), ("resource", String "postgresql://x")]+      mismatchBody+  cid <- parseTestConceptId "schemas/sales/tables/orders"+  assertEqual+    [SchemaColumnsMismatch cid "PostgreSQL Table" ["Column", "Type", "Nullable", "Description"] ["Col", "Type"]]+    (validateTestProfile testProfileSpec [concept])++testProfileConformingDocumentId :: Either Text ()+testProfileConformingDocumentId = do+  concept <-+    profileConcept+      "decisions/one"+      [("type", String "Decision Record"), ("title", String "One"), ("docId", String "ADR-1")]+      "# One\n"+  assertEqual [] (validateTestProfile testDocumentIdProfileSpec [concept])++testProfileMissingDocumentId :: Either Text ()+testProfileMissingDocumentId = do+  concept <-+    profileConcept+      "decisions/one"+      [("type", String "Decision Record"), ("title", String "One")]+      "# One\n"+  cid <- parseTestConceptId "decisions/one"+  assertEqual+    [MissingDocumentId cid "Decision Record" "ADR"]+    (validateTestProfile testDocumentIdProfileSpec [concept])++testProfileMalformedDocumentIds :: Either Text ()+testProfileMalformedDocumentIds = do+  leadingZero <-+    profileConcept+      "decisions/leading-zero"+      [("type", String "Decision Record"), ("title", String "Leading zero"), ("docId", String "ADR-007")]+      "# Leading zero\n"+  wrongPrefix <-+    profileConcept+      "decisions/wrong-prefix"+      [("type", String "Decision Record"), ("title", String "Wrong prefix"), ("docId", String "RFC-1")]+      "# Wrong prefix\n"+  leadingZeroId <- parseTestConceptId "decisions/leading-zero"+  wrongPrefixId <- parseTestConceptId "decisions/wrong-prefix"+  assertEqual+    [ MalformedDocumentId leadingZeroId "ADR" "ADR-007",+      MalformedDocumentId wrongPrefixId "ADR" "RFC-1"+    ]+    (validateTestProfile testDocumentIdProfileSpec [leadingZero, wrongPrefix])++testProfileDuplicateDocumentIds :: Either Text ()+testProfileDuplicateDocumentIds = do+  second <-+    profileConcept+      "decisions/second"+      [("type", String "Decision Record"), ("title", String "Second"), ("docId", String "ADR-1")]+      "# Second\n"+  firstConcept <-+    profileConcept+      "decisions/first"+      [("type", String "Decision Record"), ("title", String "First"), ("docId", String "ADR-1")]+      "# First\n"+  firstId <- parseTestConceptId "decisions/first"+  secondId <- parseTestConceptId "decisions/second"+  assertEqual+    [DuplicateDocumentId "ADR-1" firstId secondId]+    (validateTestProfile testDocumentIdProfileSpec [second, firstConcept])++testProfileDocumentIdsOffByDefault :: Either Text ()+testProfileDocumentIdsOffByDefault = do+  concept <-+    profileConcept+      "schemas/sales/tables/orders"+      [ ("type", String "PostgreSQL Table"),+        ("title", String "Orders"),+        ("resource", String "postgresql://warehouse/sales/orders"),+        ("docId", String "not-a-handle")+      ]+      schemaSectionBody+  assertEqual [] (validateTestProfile testProfileSpec [concept])++testSchemaSectionColumns :: Either Text ()+testSchemaSectionColumns =+  assertEqual+    (Just ["Column", "Type", "Nullable", "Description"])+    (schemaSectionColumns schemaSectionBody)++-- | Milestone 5: walking the deviating fixture and validating it against the+-- shipped descriptor produces exactly the expected advisory deviations.+testProfileDeviationsFixture :: IO (Either Text ())+testProfileDeviationsFixture = do+  descriptorPath <- fixtureFilePath "profiles/postgresql.dhall"+  loaded <- loadProfileFile descriptorPath+  root <- fixturePath "profile-deviations"+  concepts <- readBundle root+  pure $ case loaded of+    Left err -> Left ("failed to load profile: " <> err)+    Right spec -> do+      badId <- parseTestConceptId "schemas/sales/tables/bad"+      ordersId <- parseTestConceptId "schemas/sales/tables/orders"+      assertEqual+        [TypeNotInProfile badId "pg table", MissingProfileField ordersId "title" Nothing]+        (validateTestProfile spec concepts)++testDocumentIdDeviationsFixture :: IO (Either Text ())+testDocumentIdDeviationsFixture = do+  descriptorPath <- fixtureFilePath "profiles/decisions.dhall"+  loaded <- loadProfileFile descriptorPath+  root <- fixturePath "doc-id-deviations"+  concepts <- readBundle root+  pure $ case loaded of+    Left err -> Left ("failed to load document ID profile: " <> err)+    Right spec -> do+      firstId <- parseTestConceptId "decisions/first"+      secondId <- parseTestConceptId "decisions/second"+      thirdId <- parseTestConceptId "decisions/third"+      fourthId <- parseTestConceptId "decisions/fourth"+      assertEqual+        [ MissingDocumentId fourthId "Decision Record" "ADR",+          MalformedDocumentId thirdId "ADR" "ADR-007",+          DuplicateDocumentId "ADR-1" firstId secondId+        ]+        (validateTestProfile spec concepts)++testTypeAwareProfileFixture :: IO (Either Text ())+testTypeAwareProfileFixture = do+  descriptorPath <- fixtureFilePath "profiles/type-frontmatter.dhall"+  loaded <- loadProfileFile descriptorPath+  root <- fixturePath "profile-type-frontmatter"+  concepts <- readBundle root+  pure $ case loaded of+    Left err -> Left ("failed to load type-aware profile: " <> err)+    Right spec -> do+      compiled <- firstShow (compileProfile spec)+      ownedId <- parseTestConceptId "owned"+      assertEqual [] (validateProfile PermissiveConformance compiled concepts)+      assertEqual+        [MissingRecommendedProfileField ownedId "reviewer" Nothing]+        (validateProfile StrictAuthoring compiled concepts)++testClosedFieldsFixture :: IO (Either Text ())+testClosedFieldsFixture = do+  descriptorPath <- fixtureFilePath "profiles/closed-fields.dhall"+  loaded <- loadProfileFile descriptorPath+  root <- fixturePath "profile-closed-fields"+  concepts <- readBundle root+  pure $ case loaded of+    Left err -> Left ("failed to load closed-field profile: " <> err)+    Right spec -> do+      compiled <- firstShow (compileProfile spec)+      typoId <- parseTestConceptId "requests/typo"+      assertEqual+        [MissingProfileField typoId "status" Nothing, FieldNotInProfile typoId "stauts"]+        (validateProfile PermissiveConformance compiled concepts)++testCardinalityFixture :: IO (Either Text ())+testCardinalityFixture = do+  descriptorPath <- fixtureFilePath "profiles/cardinality.dhall"+  loaded <- loadProfileFile descriptorPath+  root <- fixturePath "profile-cardinality"+  concepts <- readBundle root+  pure $ case loaded of+    Left err -> Left ("failed to load cardinality profile: " <> err)+    Right spec -> do+      compiled <- firstShow (compileProfile spec)+      badId <- parseTestConceptId "bad"+      assertEqual+        [ CardinalityMismatch badId (fieldPath "tags") List (String "one"),+          CardinalityMismatch badId (fieldPath "title") Scalar (toJSON (["One", "Two"] :: [Text]))+        ]+        (validateProfile PermissiveConformance compiled concepts)++testFormatsFixture :: IO (Either Text ())+testFormatsFixture = do+  descriptorPath <- fixtureFilePath "profiles/formats.dhall"+  loaded <- loadProfileFile descriptorPath+  root <- fixturePath "profile-formats"+  concepts <- readBundle root+  pure $ case loaded of+    Left err -> Left ("failed to load format profile: " <> err)+    Right spec -> do+      compiled <- firstShow (compileProfile spec)+      badId <- parseTestConceptId "bad"+      assertEqual+        [ ValueFormatMismatch badId (fieldPath "docId") (DocumentHandle "ADR") (String "ADR-007"),+          ValueFormatMismatch badId (fieldPath "homepage") (UriWithScheme "https") (String "mailto:owner@example.test"),+          ValueFormatMismatch badId (fieldPath "links") Uri (toJSON (["https://example.test/good", "https://example.test/bad%ZZ"] :: [Text])),+          ValueFormatMismatch badId (fieldPath "published") Date (String "2026-13-45"),+          ValueFormatMismatch badId (fieldPath "timestamp") Rfc3339Utc (String "2026-07-29T17:00:00+01:00")+        ]+        (validateProfile PermissiveConformance compiled concepts)++testNestedReviewsFixture :: IO (Either Text ())+testNestedReviewsFixture = do+  descriptorPath <- fixtureFilePath "profiles/nested-reviews.dhall"+  loaded <- loadProfileFile descriptorPath+  root <- fixturePath "profile-nested-reviews"+  concepts <- readBundle root+  pure $ case loaded of+    Left err -> Left ("failed to load nested review profile: " <> err)+    Right spec -> do+      compiled <- firstShow (compileProfile spec)+      badId <- parseTestConceptId "bad"+      let permissiveExpected =+            [ NestedElementNotRecord badId (FieldPath (FieldName "reviews" :| [ArrayIndex 1])) (String "not-a-record"),+              CardinalityMismatch badId (nestedTestPath 2 "context") Scalar (toJSON (["wrong"] :: [Text])),+              MissingNestedProfileField badId (nestedTestPath 2 "outcome") Nothing,+              ValueFormatMismatch badId (nestedTestPath 2 "reviewed_at") Rfc3339Utc (String "2026-13-45T99:99:99Z"),+              ValueNotInVocabulary badId (nestedTestPath 2 "scope") reviewScopes (String "invalid")+            ]+      assertEqual permissiveExpected (validateProfile PermissiveConformance compiled concepts)+      assertEqual+        [ NestedElementNotRecord badId (FieldPath (FieldName "reviews" :| [ArrayIndex 1])) (String "not-a-record"),+          CardinalityMismatch badId (nestedTestPath 2 "context") Scalar (toJSON (["wrong"] :: [Text])),+          MissingRecommendedNestedProfileField badId (nestedTestPath 2 "notes") Nothing,+          MissingNestedProfileField badId (nestedTestPath 2 "outcome") Nothing,+          ValueFormatMismatch badId (nestedTestPath 2 "reviewed_at") Rfc3339Utc (String "2026-13-45T99:99:99Z"),+          ValueNotInVocabulary badId (nestedTestPath 2 "scope") reviewScopes (String "invalid")+        ]+        (validateProfile StrictAuthoring compiled concepts)++testConditionalFieldsFixture :: IO (Either Text ())+testConditionalFieldsFixture = do+  descriptorPath <- fixtureFilePath "profiles/conditional-fields.dhall"+  invalidDescriptorPath <- fixtureFilePath "profiles/conditional-fields-invalid.dhall"+  loaded <- loadProfileFile descriptorPath+  invalidLoaded <- loadProfileFile invalidDescriptorPath+  root <- fixturePath "profile-conditions"+  concepts <- readBundle root+  pure $ do+    spec <- first ("failed to load conditional profile: " <>) loaded+    compiled <- firstShow (compileProfile spec)+    invalidSpec <- first ("failed to load invalid conditional profile: " <>) invalidLoaded+    decisionsMissingStatus <- parseTestConceptId "decisions/missing-status"+    decisionsSuperseded <- parseTestConceptId "decisions/superseded"+    postgresqlOperational <- parseTestConceptId "postgresql/operational"+    postgresqlProjection <- parseTestConceptId "postgresql/projection"+    reviewsMixed <- parseTestConceptId "reviews/mixed"+    assertEqual+      ( Left+          ( ConditionFieldHasUnreachableValues+              Nothing+              (fieldPath "supersededBy")+              (fieldPath "status")+              ["superseded"]+              ["active"]+              :| []+          )+      )+      (compileProfile invalidSpec)+    assertEqual+      [ MissingProfileField decisionsMissingStatus "status" Nothing,+        MissingProfileField decisionsSuperseded "supersededBy" (Just (FieldCondition "status" ["superseded"])),+        MissingProfileField postgresqlProjection "sourceQuery" (Just (FieldCondition "derivationKind" ["projection"])),+        MissingNestedProfileField reviewsMixed (nestedReviewPath 0 "effort") (Just (FieldCondition "kind" ["model"])),+        MissingNestedProfileField reviewsMixed (nestedReviewPath 0 "model") (Just (FieldCondition "kind" ["model"])),+        MissingNestedProfileField reviewsMixed (nestedReviewPath 0 "provider") (Just (FieldCondition "kind" ["model"]))+      ]+      (validateProfile PermissiveConformance compiled concepts)+    assertEqual+      [ MissingProfileField decisionsMissingStatus "status" Nothing,+        MissingProfileField decisionsSuperseded "supersededBy" (Just (FieldCondition "status" ["superseded"])),+        MissingRecommendedProfileField postgresqlOperational "runbook" (Just (FieldCondition "derivationKind" ["operational"])),+        MissingProfileField postgresqlProjection "sourceQuery" (Just (FieldCondition "derivationKind" ["projection"])),+        MissingNestedProfileField reviewsMixed (nestedReviewPath 0 "effort") (Just (FieldCondition "kind" ["model"])),+        MissingNestedProfileField reviewsMixed (nestedReviewPath 0 "model") (Just (FieldCondition "kind" ["model"])),+        MissingNestedProfileField reviewsMixed (nestedReviewPath 0 "provider") (Just (FieldCondition "kind" ["model"]))+      ]+      (validateProfile StrictAuthoring compiled concepts)+  where+    nestedReviewPath elementIndex key =+      FieldPath (FieldName "reviews" :| [ArrayIndex elementIndex, FieldName key])++testDocumentReferencesFixture :: IO (Either Text ())+testDocumentReferencesFixture = do+  descriptorPath <- fixtureFilePath "profiles/document-references.dhall"+  invalidDescriptorPath <- fixtureFilePath "profiles/document-references-invalid.dhall"+  loaded <- loadProfileFile descriptorPath+  invalidLoaded <- loadProfileFile invalidDescriptorPath+  root <- fixturePath "profile-document-references"+  concepts <- readBundle root+  pure $ do+    spec <- first ("failed to load document-reference profile: " <>) loaded+    compiled <- firstShow (compileProfile spec)+    invalidSpec <- first ("failed to load invalid document-reference profile: " <>) invalidLoaded+    case compileProfile invalidSpec of+      Left _ -> Right ()+      Right _ -> Left "expected invalid document-reference descriptor to fail compilation"+    duplicateAId <- parseTestConceptId "decisions/duplicate-a"+    duplicateBId <- parseTestConceptId "decisions/duplicate-b"+    sourceId <- parseTestConceptId "decisions/source"+    assertEqual+      [ DanglingHandleReference sourceId (indexedPath 1) "ADR-99",+        ReferenceHandlePrefixMismatch sourceId (indexedPath 2) "PAT-3" "ADR",+        MalformedDocumentReference sourceId (indexedPath 3) (String "not a reference"),+        ExternalReferenceSchemeNotAllowed sourceId (indexedPath 4) "https" ["mori"],+        SelfDocumentReference sourceId (indexedPath 6) "ADR-1",+        MalformedDocumentReference sourceId (indexedPath 7) (Number 7),+        DuplicateDocumentId "ADR-3" duplicateAId duplicateBId+      ]+      (validateProfile PermissiveConformance compiled concepts)+  where+    indexedPath elementIndex = FieldPath (FieldName "references" :| [ArrayIndex elementIndex])++validateTestProfile :: ProfileSpec -> [Concept] -> [ProfileViolation]+validateTestProfile spec concepts =+  case compileProfile spec of+    Left errors -> error ("test profile failed to compile: " <> show errors)+    Right compiled -> validateProfile PermissiveConformance compiled concepts  substringIndex :: Text -> Text -> Maybe Int substringIndex needle haystack =

@@ -0,0 +1,9 @@+---+type: Cardinality Concept+title: [One, Two]+tags: one+domain: false+score: 3+---++# Bad cardinality

@@ -0,0 +1,9 @@+---+type: Cardinality Concept+title: One+tags: [one, two]+domain: false+score: 3+---++# Good cardinality

@@ -0,0 +1,4 @@+# Bundle Update Log++## 2026-07-29+* **Add**: Created the cardinality validation fixture.

@@ -0,0 +1,4 @@+# Bundle Update Log++## 2026-07-29+* **Add**: Created the closed-profile typo fixture.

@@ -0,0 +1,13 @@+---+type: Improvement Request+title: Close field names+description: Exercises a misspelled required field.+timestamp: 2026-07-29T00:00:00Z+resource: https://example.test/requests/IR-1+tags: [profiles]+requestId: IR-1+owner: Ari+stauts: proposed+---++# Close field names

@@ -0,0 +1,6 @@+---+type: Decision Record+status: active+---++# Active decision

@@ -0,0 +1,5 @@+---+type: Decision Record+---++# Decision without status

@@ -0,0 +1,6 @@+---+type: Decision Record+status: superseded+---++# Superseded decision

@@ -0,0 +1,5 @@+# Log++## 2026-07-29++- Added conditional profile acceptance fixtures.

@@ -0,0 +1,6 @@+---+type: PostgreSQL Derivation+derivationKind: operational+---++# Operational derivation

@@ -0,0 +1,6 @@+---+type: PostgreSQL Derivation+derivationKind: projection+---++# Projection derivation

@@ -0,0 +1,10 @@+---+type: Reviewed Concept+reviews:+  - kind: model+    reviewer: Codex+  - kind: human+    reviewer: Ari+---++# Mixed reviews

@@ -0,0 +1,7 @@+---+type: Decision Record+title: Duplicate A+docId: ADR-3+---++# Duplicate A

@@ -0,0 +1,7 @@+---+type: Decision Record+title: Duplicate B+docId: ADR-3+---++# Duplicate B

@@ -0,0 +1,18 @@+---+type: Decision Record+title: Source+docId: ADR-1+references:+  - ADR-2+  - ADR-99+  - PAT-3+  - not a reference+  - https://example.test/external+  - MORI://shinzui/okf/docs/one+  - ADR-1+  - 7+  - ADR-3+selfReference: ADR-1+---++# Source

@@ -0,0 +1,7 @@+---+type: Decision Record+title: Target+docId: ADR-2+---++# Target

@@ -0,0 +1,13 @@+---+type: Format Concept+title: Bad formats+timestamp: 2026-07-29T17:00:00+01:00+published: 2026-13-45+homepage: mailto:owner@example.test+docId: ADR-007+links:+  - https://example.test/good+  - https://example.test/bad%ZZ+---++# Bad formats

@@ -0,0 +1,13 @@+---+type: Format Concept+title: Good formats+timestamp: 2026-07-29T17:00:00Z+published: 2024-02-29+homepage: HTTPS://example.test/good+docId: ADR-7+links:+  - https://example.test/one+  - urn:example:two+---++# Good formats

@@ -0,0 +1,4 @@+# Bundle Update Log++## 2026-07-29+* **Add**: Created the named-format validation fixture.

@@ -0,0 +1,20 @@+---+type: Reviewed Concept+title: Good review+description: A complete nested review record.+timestamp: 2026-07-29T17:00:00Z+reviews:+  - kind: model+    reviewer: Ari+    reviewed_at: 2026-07-29T16:00:00Z+    document_timestamp: 2026-07-29T17:00:00Z+    scope: technical-accuracy+    outcome: approved+    context: Complete review+    notes: No blockers+    provider: openai+    model: gpt-5.6-sol+    effort: xhigh+---++# Good review

@@ -0,0 +1,5 @@+# Log++## 2026-07-29++- Added a valid nested review fixture.

@@ -0,0 +1,25 @@+---+type: Reviewed Concept+title: Bad reviews+description: Exercises indexed nested review diagnostics.+timestamp: 2026-07-29T17:00:00Z+reviews:+  - kind: human+    reviewer: Ari+    reviewed_at: 2026-07-29T16:00:00Z+    document_timestamp: 2026-07-29T17:00:00Z+    scope: content+    outcome: approved+    context: Baseline+    notes: Present+  - not-a-record+  - kind: model+    reviewer: Bo+    reviewed_at: 2026-13-45T99:99:99Z+    document_timestamp: 2026-07-29T17:00:00Z+    scope: invalid+    context:+      - wrong+---++# Bad reviews

@@ -0,0 +1,20 @@+---+type: Reviewed Concept+title: Good review+description: A complete nested review record.+timestamp: 2026-07-29T17:00:00Z+reviews:+  - kind: model+    reviewer: Ari+    reviewed_at: 2026-07-29T16:00:00Z+    document_timestamp: 2026-07-29T17:00:00Z+    scope: technical-accuracy+    outcome: approved+    context: Complete review+    notes: No blockers+    provider: openai+    model: gpt-5.6-sol+    effort: xhigh+---++# Good review

@@ -0,0 +1,5 @@+# Log++## 2026-07-29++- Added nested review validation fixtures.

@@ -0,0 +1,4 @@+# Bundle Update Log++## 2026-07-29+* **Add**: Created the type-aware profile validation fixture.

@@ -0,0 +1,8 @@+---+type: Open Concept+title: Open+description: An open concept.+timestamp: 2026-07-29T00:00:00Z+---++# Open

@@ -0,0 +1,9 @@+---+type: Owned Concept+title: Owned+description: An owned concept.+timestamp: 2026-07-29T00:00:00Z+owner: Ari+---++# Owned

@@ -0,0 +1,47 @@+-- Frozen EP-3 shape, before named formats were added. Keep this descriptor+-- unannotated and unchanged so it exercises the dedicated compatibility decoder.+let Cardinality = ../../../dhall/Cardinality.dhall++let FieldRule =+      { field : Text+      , description : Optional Text+      , allowedValues : List Text+      , cardinality : Cardinality+      }++in  { name = "cardinality-ep3"+    , description = Some "A profile from the EP-3 schema generation."+    , okfVersion = "0.1"+    , frontmatter =+      { required =+        [ { field = "type"+          , description = None Text+          , allowedValues = [] : List Text+          , cardinality = Cardinality.Any+          }+        , { field = "score"+          , description = Some "A scalar score."+          , allowedValues = [] : List Text+          , cardinality = Cardinality.Scalar+          }+        ]+      , recommended = [] : List FieldRule+      }+    , allowUnknownTypes = False+    , allowUnknownFields = False+    , idField = None Text+    , types =+      [ { type = "EP-3 Concept"+        , description = None Text+        , frontmatter =+          { required = [] : List FieldRule+          , recommended = [] : List FieldRule+          }+        , pathPattern = None Text+        , resourceScheme = None Text+        , requireSchemaSection = False+        , schemaColumns = [] : List Text+        , idPrefix = None Text+        }+      ]+    }