seihou-okf-extension 0.7.0.0 → 0.8.0.0

raw patch · 10 files changed

+2008/−123 lines, 10 filesdep +file-embeddep ~okf-coredep ~seihou-core

Dependencies added: file-embed

Dependency ranges changed: okf-core, seihou-core

Files

• profile/seihou-registry-docs.dhall +239/−0
• seihou-okf-extension.cabal +27/−6
• src/Seihou/OKF/Docs/Model.hs +56/−10
• src/Seihou/OKF/Docs/Render.hs +649/−61
• src/Seihou/OKF/Extension.hs +30/−2
• src/Seihou/OKF/Extension/Docs.hs +262/−8
• src/Seihou/OKF/Extension/Version.hs +23/−0
• test/Seihou/OKF/Docs/ModelSpec.hs +82/−2
• test/Seihou/OKF/Docs/RenderSpec.hs +543/−24
• test/Seihou/OKF/Extension/DocsSpec.hs +97/−10

@@ -0,0 +1,239 @@+--| House profile for an OKF documentation bundle generated from a Seihou registry.+--+-- A profile is a house convention, not part of the OKF standard: a bundle that+-- deviates from this descriptor is still fully OKF-conformant. What this one+-- says is what `seihou-okf-extension docs` promises about the bundles it emits,+-- so that a consumer can check a bundle it did not generate itself.+--+-- `pathPattern` is matched against a concept ID (`modules/haskell-library`),+-- not a file path, so it carries no `.md` suffix; `*` matches exactly one+-- segment.+--+-- The descriptor is deliberately standalone -- every type is spelled out here+-- rather than imported -- because it is embedded in the generator and written+-- into the bundle root, where a relative import out of the bundle would not+-- resolve.+let Cardinality = < Any | Scalar | List >++let FieldFormat =+      < Rfc3339Utc+      | Date+      | Uri+      | UriWithScheme : Text+      | DocumentHandle : Text+      | Actor+      | HumanActor+      | Integer+      | NonNegativeInteger+      | Boolean+      >++let FieldCondition = { field : Text, hasValue : List Text }++let HandleReferenceRule =+      { localPrefix : Text+      , externalUriSchemes : List Text+      , allowSelf : Bool+      , allowLocal : Bool+      , externalUriPattern : Optional Text+      }++let PathReferenceRule = { externalUriSchemes : List Text, allowSelf : Bool }++let NestedFieldRule =+      { field : Text+      , description : Optional Text+      , allowedValues : List Text+      , cardinality : Cardinality+      , format : Optional FieldFormat+      , path : Optional PathReferenceRule+      , when : Optional FieldCondition+      , reference : Optional HandleReferenceRule+      }++let NestedRules =+      { required : List NestedFieldRule+      , recommended : List NestedFieldRule+      , optional : List NestedFieldRule+      }++let FieldRule =+      { field : Text+      , description : Optional Text+      , allowedValues : List Text+      , cardinality : Cardinality+      , format : Optional FieldFormat+      , elementFields : Optional NestedRules+      , objectFields : Optional NestedRules+      , reference : Optional HandleReferenceRule+      , path : Optional PathReferenceRule+      , when : Optional FieldCondition+      , uniqueBy : Optional Text+      }++let FrontmatterRules =+      { required : List FieldRule+      , recommended : List FieldRule+      , optional : List FieldRule+      }++let TypeRule =+      { type : Text+      , description : Optional Text+      , frontmatter : FrontmatterRules+      , pathPattern : Optional Text+      , resourceScheme : Optional Text+      , requireSchemaSection : Bool+      , schemaColumns : List Text+      , idPrefix : Optional Text+      }++let emptyRules+    : FrontmatterRules+    = { required = [] : List FieldRule+      , recommended = [] : List FieldRule+      , optional = [] : List FieldRule+      }++let nestedScalar =+      \(name : Text) ->+      \(description : Text) ->+        { field = name+        , description = Some description+        , allowedValues = [] : List Text+        , cardinality = Cardinality.Scalar+        , format = None FieldFormat+        , path = None PathReferenceRule+        , when = None FieldCondition+        , reference = None HandleReferenceRule+        }++let field =+      \(name : Text) ->+      \(description : Text) ->+      \(cardinality : Cardinality) ->+      \(format : Optional FieldFormat) ->+      \(objectFields : Optional NestedRules) ->+        { field = name+        , description = Some description+        , allowedValues = [] : List Text+        , cardinality+        , format+        , elementFields = None NestedRules+        , objectFields+        , reference = None HandleReferenceRule+        , path = None PathReferenceRule+        , when = None FieldCondition+        , uniqueBy = None Text+        }++let scalar =+      \(name : Text) ->+      \(description : Text) ->+        field name description Cardinality.Scalar (None FieldFormat) (None NestedRules)++let versionRule =+      scalar+        "version"+        "The version the registry catalog records for this artifact. Optional rather than required, because `seihou-registry.dhall` itself declares `version : Optional Text`; a profile that demanded it would refuse a valid registry."++let artifactType =+      \(name : Text) ->+      \(description : Text) ->+      \(directory : Text) ->+        { type = name+        , description = Some description+        , frontmatter = emptyRules // { optional = [ versionRule ] }+        , pathPattern = Some "${directory}/*"+        , resourceScheme = Some "seihou"+        , requireSchemaSection = False+        , schemaColumns = [] : List Text+        , idPrefix = None Text+        }++in  { name = "seihou-registry-docs"+    , description = Some+        "Generated documentation for a Seihou registry: one concept per published module, recipe, blueprint and agent prompt, plus one describing the registry itself. Every concept names the registry artifact it was derived from through a `seihou://` resource and records the generator that produced it, so a reader can tell derived documentation from hand-written prose and can find the `.dhall` source it came from."+    , okfVersion = "0.2"+    , frontmatter =+            emptyRules+        //  { required =+              [ scalar "type" "Which kind of Seihou artifact this concept documents."+              , scalar "title" "The artifact's name, exactly as the registry publishes it."+              , scalar+                  "description"+                  "What the artifact is for. Taken from the registry catalog entry, else the artifact's own description, else synthesized."+              , field+                  "resource"+                  "A `seihou://<registry>/<path>` pointer to the artifact this concept was derived from."+                  Cardinality.Scalar+                  (Some (FieldFormat.UriWithScheme "seihou"))+                  (None NestedRules)+              , field+                  "generated"+                  "Which producer generated this concept, per OKF specification section 5.2. Always present, because this documentation is derived rather than written."+                  Cardinality.Any+                  (None FieldFormat)+                  ( Some+                      (     emptyRules+                        //  { required =+                              [     nestedScalar+                                      "by"+                                      "The producer actor, `seihou-okf-extension/<version>`."+                                //  { format = Some FieldFormat.Actor }+                              ]+                            , optional =+                              [ nestedScalar+                                  "at"+                                  "The generation time, present only when the operator passed --generated-at."+                              ]+                            , recommended = [] : List NestedFieldRule+                            }+                      )+                  )+              ]+            , recommended =+              [ field+                  "tags"+                  "The tags the registry catalog records for this artifact."+                  Cardinality.List+                  (None FieldFormat)+                  (None NestedRules)+              ]+            , optional =+              [ field+                  "status"+                  "The concept's lifecycle status, per OKF specification section 5.4."+                  Cardinality.Scalar+                  (None FieldFormat)+                  (None NestedRules)+              ]+            }+    , allowUnknownTypes = False+    , allowUnknownFields = True+    , idField = None Text+    , requireBundleVersion = Some "0.2"+    , types =+      [ artifactType+          "SeihouModule"+          "A deterministic file-generation template: variables, generation steps, shell commands, dependencies, an optional removal procedure and optional migration edges."+          "modules"+      , artifactType+          "SeihouRecipe"+          "A named composition of modules with preset variable bindings."+          "recipes"+      , artifactType+          "SeihouBlueprint"+          "An agent-driven scaffold: a prompt, optional base modules, reference files and optional agent-guided migration edges."+          "blueprints"+      , artifactType+          "SeihouPrompt"+          "A reusable agent-session template."+          "prompts"+      ,     artifactType+              "SeihouRegistry"+              "The registry itself: the repository publishing these artifacts, linking each of them."+              "registry"+        //  { frontmatter = emptyRules }+      ]+    }

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-okf-extension-version: 0.7.0.0+version: 0.8.0.0 synopsis: OKF documentation extension for Seihou registries description:   External Seihou extension executable for generating OKF documentation bundles@@ -16,6 +16,9 @@ copyright: (c) 2026 Nadeem Bitar category: Development build-type: Simple+-- The house profile descriptor is embedded in the library with file-embed and+-- written into every generated bundle, so it must ship in the sdist.+extra-source-files: profile/seihou-registry-docs.dhall  source-repository head   type: git@@ -23,6 +26,10 @@  library seihou-okf-extension-internal   default-language: GHC2024+  ghc-options:+    -Wall+    -Werror=incomplete-patterns+   default-extensions:     DeriveAnyClass     DuplicateRecordFields@@ -38,22 +45,32 @@     Seihou.OKF.Docs.Render     Seihou.OKF.Extension     Seihou.OKF.Extension.Docs+    Seihou.OKF.Extension.Version +  other-modules: Paths_seihou_okf_extension+  autogen-modules: Paths_seihou_okf_extension   build-depends:     aeson >=2.1 && <3,     base >=4.18 && <5,+    containers >=0.6 && <1,     directory >=1.3 && <2,+    file-embed >=0.0.15 && <0.1,     filepath >=1.4 && <2,     generic-lens >=2.2 && <3,     lens >=5.2 && <6,-    okf-core ^>=0.1.2.0,+    okf-core ^>=0.8.0.0,     optparse-applicative >=0.18 && <1,-    seihou-core ^>=0.7.0.0,+    seihou-core ^>=0.8.0.0,+    temporary >=1.3 && <2,     text >=2.0 && <3,  executable seihou-okf-extension   default-language: GHC2024-  ghc-options: -threaded+  ghc-options:+    -threaded+    -Wall+    -Werror=incomplete-patterns+   default-extensions:     DeriveAnyClass     DuplicateRecordFields@@ -73,6 +90,10 @@ test-suite seihou-okf-extension-test   type: exitcode-stdio-1.0   default-language: GHC2024+  ghc-options:+    -Wall+    -Werror=incomplete-patterns+   default-extensions:     DeriveAnyClass     DuplicateRecordFields@@ -96,8 +117,8 @@     generic-lens >=2.2 && <3,     hspec >=2.11 && <3,     lens >=5.2 && <6,-    okf-core ^>=0.1.2.0,-    seihou-core ^>=0.7.0.0,+    okf-core ^>=0.8.0.0,+    seihou-core ^>=0.8.0.0,     seihou-okf-extension-internal,     tasty >=1.4 && <2,     tasty-hspec >=1.2 && <2,

@@ -3,6 +3,7 @@     DocArtifact (..),     DocEntry (..),     ModuleRef (..),+    EntailedRef (..),     DocModel (..),     DocLoadError (..),     loadDocModel,@@ -13,6 +14,7 @@ import Data.Generics.Labels () import Data.Text qualified as T import GHC.Generics (Generic)+import Seihou.Core.Migration (BlueprintMigration (..)) import Seihou.Core.Registry (Registry (..), RegistryEntry (..)) import Seihou.Core.Types   ( AgentPrompt,@@ -20,9 +22,7 @@     Dependency,     Module (..),     ModuleLoadError,-    ModuleName (..),     Recipe (..),-    RecipeName (..),     depModuleNames,   ) import Seihou.Dhall.Eval@@ -35,11 +35,15 @@ import System.Directory (doesFileExist) import System.FilePath ((</>)) +-- | The kinds of concept this bundle emits. The first four are registry entry+-- kinds; 'DocRegistryKind' belongs to the single overview concept describing the+-- registry itself, and never appears as a 'DocEntry' kind. data DocKind   = DocModuleKind   | DocRecipeKind   | DocBlueprintKind   | DocPromptKind+  | DocRegistryKind   deriving stock (Eq, Show)  data DocArtifact@@ -57,7 +61,11 @@     tags :: ![T.Text],     path :: !FilePath,     artifact :: !DocArtifact,-    moduleRefs :: ![ModuleRef]+    moduleRefs :: ![ModuleRef],+    -- | Every edge this entry\'s migrations entail, flattened across the+    -- entry\'s migration edges in declaration order. Empty for every kind but+    -- a blueprint, which is the only artifact that can declare entailment.+    entailedRefs :: ![EntailedRef]   }   deriving stock (Eq, Generic, Show) @@ -67,6 +75,22 @@   }   deriving stock (Eq, Generic, Show) +-- | One edge of another blueprint that crossing this entry\'s edge entails.+--+-- @resolved@ says whether the named blueprint is listed in the /same/ registry,+-- which is the only thing this bundle can link to. An entailed edge naming a+-- blueprint in another repository is normal and expected -- see+-- @docs\/adr\/0008-an-entailed-migration-edge-is-owned-by-the-blueprint-that-declares-it.md@+-- -- and is rendered as plain labelled text rather than as a cross-link that+-- bundle validation would report as dangling.+data EntailedRef = EntailedRef+  { blueprint :: !T.Text,+    from :: !T.Text,+    to :: !T.Text,+    resolved :: !Bool+  }+  deriving stock (Eq, Generic, Show)+ data DocModel = DocModel   { repoName :: !T.Text,     repoDescription :: !(Maybe T.Text),@@ -106,7 +130,8 @@   pure $ do     entries <- entriesResult     let moduleNames = [entry ^. #name | entry <- entries, entry ^. #kind == DocModuleKind]-        resolvedEntries = map (resolveEntryRefs moduleNames) entries+        blueprintNames = [entry ^. #name | entry <- entries, entry ^. #kind == DocBlueprintKind]+        resolvedEntries = map (resolveEntryRefs moduleNames blueprintNames) entries     Right       DocModel         { repoName = repoName,@@ -147,6 +172,7 @@           DocModuleKind           (DocModuleArtifact artifact)           (moduleRefs dependencies)+          []  loadRecipeEntry :: FilePath -> RegistryEntry -> IO (Either DocLoadError DocEntry) loadRecipeEntry registryDir entry = do@@ -161,6 +187,7 @@           DocRecipeKind           (DocRecipeArtifact artifact)           (moduleRefs recipeModules)+          []  loadBlueprintEntry :: FilePath -> RegistryEntry -> IO (Either DocLoadError DocEntry) loadBlueprintEntry registryDir entry = do@@ -168,13 +195,14 @@   result <- evalBlueprintFromFile artifactFile   pure $ case result of     Left err -> Left (ArtifactLoadFailed (entry ^. #name . #unModuleName) (renderModuleLoadError err))-    Right artifact@Blueprint {baseModules} ->+    Right artifact@Blueprint {baseModules, migrations} ->       Right $         docEntryFromRegistry           entry           DocBlueprintKind           (DocBlueprintArtifact artifact)           (moduleRefs baseModules)+          (entailedRefs migrations)  loadPromptEntry :: FilePath -> RegistryEntry -> IO (Either DocLoadError DocEntry) loadPromptEntry registryDir entry = do@@ -189,9 +217,10 @@           DocPromptKind           (DocPromptArtifact artifact)           []+          [] -docEntryFromRegistry :: RegistryEntry -> DocKind -> DocArtifact -> [ModuleRef] -> DocEntry-docEntryFromRegistry entry kind artifact refs =+docEntryFromRegistry :: RegistryEntry -> DocKind -> DocArtifact -> [ModuleRef] -> [EntailedRef] -> DocEntry+docEntryFromRegistry entry kind artifact refs entailed =   DocEntry     { name = entry ^. #name . #unModuleName,       kind = kind,@@ -200,7 +229,8 @@       tags = entry ^. #tags,       path = entry ^. #path,       artifact = artifact,-      moduleRefs = refs+      moduleRefs = refs,+      entailedRefs = entailed     }  moduleRefs :: [Dependency] -> [ModuleRef]@@ -209,10 +239,26 @@   | moduleName <- depModuleNames dependencies   ] -resolveEntryRefs :: [T.Text] -> DocEntry -> DocEntry-resolveEntryRefs moduleNames entry =+entailedRefs :: [BlueprintMigration] -> [EntailedRef]+entailedRefs migrations =+  [ EntailedRef+      { blueprint = edge ^. #blueprint,+        from = edge ^. #from,+        to = edge ^. #to,+        resolved = False+      }+  | BlueprintMigration {entails} <- migrations,+    edge <- entails+  ]++-- | The single place that decides whether a reference points inside this+-- registry. Module references resolve against the registry\'s module names,+-- entailed edges against its blueprint names.+resolveEntryRefs :: [T.Text] -> [T.Text] -> DocEntry -> DocEntry+resolveEntryRefs moduleNames blueprintNames entry =   entry     & #moduleRefs .~ [ref & #resolved .~ ((ref ^. #name) `elem` moduleNames) | ref <- entry ^. #moduleRefs]+    & #entailedRefs .~ [ref & #resolved .~ ((ref ^. #blueprint) `elem` blueprintNames) | ref <- entry ^. #entailedRefs]  renderModuleLoadError :: ModuleLoadError -> T.Text renderModuleLoadError = T.pack . show

@@ -1,8 +1,15 @@+{-# LANGUAGE TemplateHaskell #-}+ module Seihou.OKF.Docs.Render   ( conceptIdFor,+    RenderOptions (..),+    defaultRenderOptions,     DocRenderError (..),     DocBundleError (..),+    builtinProfileDescriptor,+    profileFileName,     renderDocBundle,+    checkDocProfile,     writeDocBundle,   ) where@@ -11,24 +18,98 @@ import Data.Aeson (Value (..)) import Data.Bifunctor (first) import Data.Either (partitionEithers)+import Data.FileEmbed (embedStringFile) import Data.Generics.Labels ()+import Data.List.NonEmpty (NonEmpty)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map import Data.Text qualified as T-import Okf.Bundle (Concept, conceptFromDocument, writeBundle)+import Data.Text.IO qualified as TIO+import GHC.Generics (Generic)+import Okf.Actor (Actor (..))+import Okf.Bundle (BundleError, Concept, bundleInventoryOfConcepts, conceptFromDocument, writeBundle) import Okf.ConceptId (ConceptId, parseConceptId, renderConceptLink) import Okf.Document qualified as Okf+import Okf.Index (VersionDeclaration (..), supportedOkfVersion, writeBundleIndexesWith)+import Okf.Profile+  ( ProfileDefinitionError,+    ProfileViolation,+    compileProfile,+    loadProfileFile,+    validateProfile,+    validateProfileVersion,+  ) import Okf.Validation (BundleValidationError, ValidationProfile (..), validateBundle)+import Seihou.Core.Expr (renderExpr)+import Seihou.Core.Migration+  ( BlueprintMigration (..),+    EntailedEdge (..),+    Migration (..),+    MigrationOp (..),+  ) import Seihou.Core.Types-  ( AgentPrompt (..),+  ( AgentLaunch (..),+    AgentPrompt (..),     Blueprint (..),     BlueprintFile (..),+    Command (..),+    CommandVar (..),+    Dependency (..),+    Expr,     Module (..),+    PatchOp (..),+    Prompt (..),+    PromptGuidance (..),     Recipe (..),+    Removal (..),+    RemovalAction (..),+    RemovalStep (..),+    Step (..),+    Strategy (..),+    Validation (..),     VarDecl (..),     VarExport (..),     VarName (..),+    VarType (..),+    VarValue (..),   ) import Seihou.OKF.Docs.Model+import Seihou.OKF.Extension.Version (producerActorName)+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory) +-- | Everything the renderer needs that is not in the model: who to name as the+-- producer, whether to stamp a generation date, and how strictly to validate.+--+-- 'generatedAt' is deliberately a value the operator supplies rather than a+-- clock reading. Nothing in the generator reads the clock, so regenerating an+-- unchanged registry produces byte-identical output.+data RenderOptions = RenderOptions+  { producerVersion :: !T.Text,+    generatedAt :: !(Maybe T.Text),+    validationProfile :: !ValidationProfile,+    -- | Where to read the house profile descriptor from. 'Nothing' means the+    -- descriptor embedded in this executable.+    profileSource :: !(Maybe FilePath),+    -- | Whether to check the rendered concepts against that descriptor before+    -- writing anything.+    enforceProfile :: !Bool+  }+  deriving stock (Eq, Generic, Show)++-- | Strict OKF validation and the built-in house profile enforced, with no+-- generation date, for the given producer version.+defaultRenderOptions :: T.Text -> RenderOptions+defaultRenderOptions version =+  RenderOptions+    { producerVersion = version,+      generatedAt = Nothing,+      validationProfile = StrictAuthoring,+      profileSource = Nothing,+      enforceProfile = True+    }+ data DocRenderError   = InvalidDocConceptId DocKind T.Text T.Text   deriving stock (Eq, Show)@@ -36,130 +117,632 @@ data DocBundleError   = DocBundleRenderError DocRenderError   | DocBundleValidationError BundleValidationError+  | -- | Writing the bundle\'s @index.md@ files failed after the concepts were+    -- written, so the bundle on disk is missing its version declaration and its+    -- per-kind section indexes.+    DocBundleIndexError BundleError+  | -- | The house profile descriptor could not be read as a profile at all.+    DocBundleProfileUnreadable T.Text+  | -- | The descriptor read but does not compile to a checkable profile.+    DocBundleProfileInvalid (NonEmpty ProfileDefinitionError)+  | -- | The rendered concepts deviate from the house profile.+    DocBundleProfileViolation ProfileViolation   deriving stock (Eq, Show) +-- | The house profile descriptor, embedded so the generator never depends on+-- its own source tree at run time. It is also written into every bundle, so a+-- downstream consumer can check a bundle it did not generate.+builtinProfileDescriptor :: T.Text+builtinProfileDescriptor = $(embedStringFile "profile/seihou-registry-docs.dhall")++-- | Where the descriptor is written inside a generated bundle. A Dhall file at+-- the bundle root is not a concept and does not disturb the bundle walk.+profileFileName :: FilePath+profileFileName = "profile.dhall"+ conceptIdFor :: DocKind -> T.Text -> Either T.Text ConceptId conceptIdFor kind name =   first (T.pack . show) (parseConceptId (conceptIdTextFor kind name)) -renderDocBundle :: DocModel -> Either [DocRenderError] ([Concept], [BundleValidationError])-renderDocBundle model =-  case partitionEithers (conceptFor (model ^. #repoName) <$> model ^. #entries) of+renderDocBundle :: RenderOptions -> DocModel -> Either [DocRenderError] ([Concept], [BundleValidationError])+renderDocBundle opts model =+  case partitionEithers (registryConceptFor opts model : (conceptFor opts (model ^. #repoName) <$> model ^. #entries)) of     ([], concepts) ->-      Right (concepts, validateBundle PermissiveConformance concepts)+      Right+        ( concepts,+          validateBundle+            (opts ^. #validationProfile)+            (VersionDeclared supportedOkfVersion)+            (bundleInventoryOfConcepts concepts)+            concepts+        )     (errors, _) ->       Left errors  -- | Write concepts into the output directory. This overwrites files it writes but does -- not clear unrelated files; callers that need pristine regeneration should clear the -- output directory before calling this function.-writeDocBundle :: FilePath -> DocModel -> IO (Either [DocBundleError] ())-writeDocBundle outDir model =-  case renderDocBundle model of+-- | Check rendered concepts against the house profile, before anything is+-- written. The descriptor is read from @--profile PATH@ when the operator+-- supplied one and otherwise from 'builtinProfileDescriptor', written to a+-- temporary file because okf reads a profile from a path.+--+-- Returns @[]@ when the profile is not being enforced.+checkDocProfile :: RenderOptions -> [Concept] -> IO [DocBundleError]+checkDocProfile opts concepts+  | not (opts ^. #enforceProfile) = pure []+  | otherwise =+      case opts ^. #profileSource of+        Just path -> checkAgainst path+        Nothing ->+          withSystemTempDirectory "seihou-okf-profile" $ \tmpDir -> do+            let path = tmpDir </> profileFileName+            TIO.writeFile path builtinProfileDescriptor+            checkAgainst path+  where+    checkAgainst path = do+      loaded <- loadProfileFile path+      pure $ case loaded of+        Left err -> [DocBundleProfileUnreadable err]+        Right spec ->+          case compileProfile spec of+            Left definitionErrors -> [DocBundleProfileInvalid definitionErrors]+            Right compiled ->+              DocBundleProfileViolation+                <$> ( validateProfileVersion (VersionDeclared supportedOkfVersion) compiled+                        <> validateProfile (opts ^. #validationProfile) compiled concepts+                    )++writeDocBundle :: RenderOptions -> FilePath -> DocModel -> IO (Either [DocBundleError] ())+writeDocBundle opts outDir model =+  case renderDocBundle opts model of     Left renderErrors ->       pure (Left (DocBundleRenderError <$> renderErrors))     Right (concepts, validationErrors)-      | null validationErrors -> Right <$> writeBundle outDir concepts-      | otherwise -> pure (Left (DocBundleValidationError <$> validationErrors))+      | not (null validationErrors) ->+          pure (Left (DocBundleValidationError <$> validationErrors))+      | otherwise -> do+          -- The profile is checked before a single file is written, so a bundle+          -- that violates the house convention never reaches disk at all.+          profileProblems <- checkDocProfile opts concepts+          if not (null profileProblems)+            then pure (Left profileProblems)+            else do+              writeBundle outDir concepts+              writeProfileDescriptor opts outDir+              -- Walk what was just written and lay down the root index (carrying+              -- the OKF version declaration, the one place a bundle states it)+              -- plus one index per subdirectory.+              indexResult <- writeBundleIndexesWith (Just supportedOkfVersion) outDir+              pure (first (pure . DocBundleIndexError) indexResult) -conceptFor :: T.Text -> DocEntry -> Either DocRenderError Concept-conceptFor repoName entry =+-- | Write the descriptor the bundle was checked against beside the bundle, so a+-- reader can re-run the same check with @okf validate --profile@.+writeProfileDescriptor :: RenderOptions -> FilePath -> IO ()+writeProfileDescriptor opts outDir = do+  createDirectoryIfMissing True outDir+  descriptor <- case opts ^. #profileSource of+    Nothing -> pure builtinProfileDescriptor+    Just path -> TIO.readFile path+  TIO.writeFile (outDir </> profileFileName) descriptor++conceptFor :: RenderOptions -> T.Text -> DocEntry -> Either DocRenderError Concept+conceptFor opts repoName entry =   case conceptIdFor (entry ^. #kind) (entry ^. #name) of     Left err ->       Left (InvalidDocConceptId (entry ^. #kind) (entry ^. #name) err)     Right conceptId ->-      Right (conceptFromDocument conceptId (documentFor repoName entry))+      Right (conceptFromDocument conceptId (documentFor opts repoName entry)) -documentFor :: T.Text -> DocEntry -> Okf.OKFDocument-documentFor repoName entry =+documentFor :: RenderOptions -> T.Text -> DocEntry -> Okf.OKFDocument+documentFor opts repoName entry =   Okf.OKFDocument-    (frontmatterFor repoName entry)-    (bodyFor entry)+    (frontmatterFor opts repoName entry)+    (bodyFor repoName entry) -frontmatterFor :: T.Text -> DocEntry -> Okf.Frontmatter-frontmatterFor repoName entry =+frontmatterFor :: RenderOptions -> T.Text -> DocEntry -> Okf.Frontmatter+frontmatterFor opts repoName entry =   maybeSetVersion-    . Okf.setTags (entry ^. #tags)-    . Okf.setResource (resourceFor repoName entry)+    ( baseFrontmatter+        opts+        (typeFor (entry ^. #kind))+        (entry ^. #name)+        (descriptionFor repoName entry)+        (resourceFor repoName entry)+        (entry ^. #tags)+    )+  where+    maybeSetVersion =+      maybe id (\version -> Okf.setField "version" (String version)) (entry ^. #version)++-- | The frontmatter every concept this generator emits carries: the OKF common+-- identity fields, the resource pointer back into the registry, the tags, the+-- lifecycle status, and the @generated@ provenance block that gives the concept+-- a trust tier.+baseFrontmatter :: RenderOptions -> T.Text -> T.Text -> T.Text -> T.Text -> [T.Text] -> Okf.Frontmatter+baseFrontmatter opts conceptType title description resource tags =+  Okf.setGenerated generated+    . Okf.setStatus Okf.Stable+    . Okf.setTags tags+    . Okf.setResource resource     $ Okf.okfCommon       Okf.OkfCommon-        { Okf.commonType = typeFor (entry ^. #kind),-          Okf.commonTitle = Just (entry ^. #name),-          Okf.commonDescription = entry ^. #description,+        { Okf.commonType = conceptType,+          Okf.commonTitle = Just title,+          Okf.commonDescription = Just description,           Okf.commonTimestamp = Nothing         }   where-    maybeSetVersion =-      maybe id (\version -> Okf.setField "version" (String version)) (entry ^. #version)+    generated =+      Okf.Generated+        { Okf.generatedBy = ProducerActor producerActorName (opts ^. #producerVersion),+          Okf.generatedAt = opts ^. #generatedAt+        } +-- | One concept describing the registry itself, so the bundle is a connected+-- graph from a single entry point rather than a flat set of artifact pages.+registryConceptFor :: RenderOptions -> DocModel -> Either DocRenderError Concept+registryConceptFor opts model =+  case conceptIdFor DocRegistryKind repoName of+    Left err -> Left (InvalidDocConceptId DocRegistryKind repoName err)+    Right conceptId ->+      Right (conceptFromDocument conceptId document)+  where+    repoName = model ^. #repoName+    description =+      case model ^. #repoDescription of+        Just described | not (T.null (T.strip described)) -> described+        _ -> "The `" <> repoName <> "` seihou registry."+    document =+      Okf.OKFDocument+        ( baseFrontmatter+            opts+            (typeFor DocRegistryKind)+            repoName+            description+            ("seihou://" <> repoName <> "/seihou-registry.dhall")+            ["registry", "seihou"]+        )+        (registryBody repoName description (model ^. #entries))++registryBody :: T.Text -> T.Text -> [DocEntry] -> T.Text+registryBody repoName description entries =+  T.intercalate+    "\n\n"+    ( [ "# " <> repoName,+        description,+        "Every artifact below is published by the `"+          <> repoName+          <> "` registry and documented in its own concept."+      ]+        <> foldMap (uncurry (registryKindSection entries)) kindHeadings+    )+    <> "\n"+  where+    kindHeadings =+      [ (DocModuleKind, "Modules"),+        (DocRecipeKind, "Recipes"),+        (DocBlueprintKind, "Blueprints"),+        (DocPromptKind, "Prompts")+      ]++registryKindSection :: [DocEntry] -> DocKind -> T.Text -> [T.Text]+registryKindSection entries kind heading =+  case [entry | entry <- entries, entry ^. #kind == kind] of+    [] -> []+    matching ->+      [ section heading (T.unlines (registryEntryLink <$> matching))+      ]++registryEntryLink :: DocEntry -> T.Text+registryEntryLink entry =+  case conceptIdFor (entry ^. #kind) (entry ^. #name) of+    Right conceptId -> "- " <> renderConceptLink conceptId (entry ^. #name)+    Left _ -> "- `" <> entry ^. #name <> "`"++-- | The description strict validation insists on, in three deterministic steps:+-- what the registry catalog says about the entry, then what the artifact says+-- about itself, then a synthesized sentence. Frontmatter and the body\'s opening+-- paragraph both use this, so the two can never disagree.+descriptionFor :: T.Text -> DocEntry -> T.Text+descriptionFor repoName entry =+  case nonEmpty (entry ^. #description) of+    Just described -> described+    Nothing ->+      case nonEmpty (artifactDescription (entry ^. #artifact)) of+        Just described -> described+        Nothing ->+          "Seihou "+            <> kindNoun (entry ^. #kind)+            <> " `"+            <> entry ^. #name+            <> "` published by the `"+            <> repoName+            <> "` registry."+  where+    nonEmpty = (>>= \text -> if T.null (T.strip text) then Nothing else Just text)++artifactDescription :: DocArtifact -> Maybe T.Text+artifactDescription (DocModuleArtifact Module {description}) = description+artifactDescription (DocRecipeArtifact Recipe {description}) = description+artifactDescription (DocBlueprintArtifact Blueprint {description}) = description+artifactDescription (DocPromptArtifact AgentPrompt {description}) = description++kindNoun :: DocKind -> T.Text+kindNoun DocModuleKind = "module"+kindNoun DocRecipeKind = "recipe"+kindNoun DocBlueprintKind = "blueprint"+kindNoun DocPromptKind = "agent prompt"+kindNoun DocRegistryKind = "registry"+ resourceFor :: T.Text -> DocEntry -> T.Text resourceFor repoName entry =   "seihou://" <> repoName <> "/" <> T.pack (entry ^. #path) -bodyFor :: DocEntry -> T.Text-bodyFor entry =+bodyFor :: T.Text -> DocEntry -> T.Text+bodyFor repoName entry =   T.intercalate     "\n\n"-    ( baseSections entry+    ( baseSections repoName entry         <> kindSections entry     )     <> "\n" -baseSections :: DocEntry -> [T.Text]-baseSections entry =+baseSections :: T.Text -> DocEntry -> [T.Text]+baseSections repoName entry =   [ "# " <> entry ^. #name,-    maybe "No description provided." id (entry ^. #description)+    descriptionFor repoName entry   ]     <> foldMap (\version -> ["**Version:** " <> version]) (entry ^. #version) +-- | The per-kind body sections.+--+-- A section that the artifact declares nothing for is omitted entirely, so a+-- reader never wades through a page of "none declared". The four sections that+-- predate this renderer -- Dependencies, Variables, Exports for a module,+-- Composes for a recipe, Base modules and Reference files for a blueprint,+-- Agent prompt, Reference files and Tools for a prompt -- keep their+-- "nothing declared" sentence instead, because a reader who has seen them+-- before would read their absence as a rendering bug.+--+-- Every helper below is total and deterministic: no clock, no filesystem, and+-- every 'Data.Map.Strict.Map' walked in key order. kindSections :: DocEntry -> [T.Text] kindSections entry =   case entry ^. #artifact of-    DocModuleArtifact Module {vars, exports} ->-      [ "## Dependencies\n\n" <> renderModuleRefs "This module has no dependencies." (entry ^. #moduleRefs),-        "## Variables\n\n" <> renderVarDecls vars,-        "## Exports\n\n" <> renderExports exports-      ]-    DocRecipeArtifact _ ->-      ["## Composes\n\n" <> renderModuleRefs "This recipe does not compose any modules." (entry ^. #moduleRefs)]-    DocBlueprintArtifact Blueprint {prompt, files} ->-      [ "## Base modules\n\n" <> renderModuleRefs "This blueprint declares no base modules." (entry ^. #moduleRefs),-        "## Agent prompt\n\n" <> firstParagraph prompt,-        "## Reference files\n\n" <> renderBlueprintFiles files+    DocModuleArtifact Module {vars, exports, prompts, steps, commands, dependencies, removal, migrations} ->+      [ section "Dependencies" (renderDependencies "This module has no dependencies." dependencies),+        section "Variables" (renderVarDecls vars),+        section "Exports" (renderExports exports)       ]-    DocPromptArtifact AgentPrompt {prompt, files, allowedTools} ->-      [ "## Agent prompt\n\n" <> firstParagraph prompt,-        "## Reference files\n\n" <> renderBlueprintFiles files,-        "## Tools\n\n" <> maybe "No tool restrictions declared." renderTextList allowedTools+        <> optionalSection "Prompts" (renderPrompts prompts)+        <> optionalSection "Generation steps" (renderSteps steps)+        <> optionalSection "Commands" (renderCommands commands)+        <> foldMap (optionalSection "Removal" . renderRemoval) removal+        <> optionalSection "Migrations" (renderMigrations migrations)+    DocRecipeArtifact Recipe {modules = recipeModules, vars, prompts} ->+      [section "Composes" (renderDependencies "This recipe does not compose any modules." recipeModules)]+        <> optionalSection "Variables" (renderVarDecls' vars)+        <> optionalSection "Prompts" (renderPrompts prompts)+    DocBlueprintArtifact Blueprint {prompt, vars, prompts, baseModules, files, allowedTools, migrations, launch, versionProbe} ->+      [ section "Base modules" (renderDependencies "This blueprint declares no base modules." baseModules),+        section "Agent prompt" (renderAgentPrompt prompt)       ]+        <> optionalSection "Variables" (renderVarDecls' vars)+        <> optionalSection "Prompts" (renderPrompts prompts)+        <> [section "Reference files" (renderBlueprintFiles files)]+        <> foldMap (optionalSection "Tools" . renderTextList') allowedTools+        <> foldMap (optionalSection "Agent launch" . renderAgentLaunch) launch+        <> foldMap (optionalSection "Version probe" . renderVersionProbe) versionProbe+        <> optionalSection+          "Migrations"+          (renderBlueprintMigrations (resolvedEntailedBlueprints entry) migrations)+    DocPromptArtifact AgentPrompt {prompt, vars, prompts, commandVars, guidance, files, allowedTools, launch} ->+      [section "Agent prompt" (renderAgentPrompt prompt)]+        <> optionalSection "Variables" (renderVarDecls' vars)+        <> optionalSection "Prompts" (renderPrompts prompts)+        <> optionalSection "Command variables" (renderCommandVars commandVars)+        <> optionalSection "Guidance" (renderGuidance guidance)+        <> [ section "Reference files" (renderBlueprintFiles files),+             section "Tools" (maybe "No tool restrictions declared." renderTextList allowedTools)+           ]+        <> foldMap (optionalSection "Agent launch" . renderAgentLaunch) launch -renderModuleRefs :: T.Text -> [ModuleRef] -> T.Text-renderModuleRefs emptyMessage refs =-  case refs of-    [] -> emptyMessage-    _ -> T.unlines ["- " <> moduleLink (ref ^. #name) | ref <- refs]+-- | Sections are joined with a blank line between them, so a body\'s own+-- trailing newline is stripped rather than left to open a second blank line.+section :: T.Text -> T.Text -> T.Text+section heading body = "## " <> heading <> "\n\n" <> T.stripEnd body +-- | A section that disappears when its renderer produced nothing.+optionalSection :: T.Text -> T.Text -> [T.Text]+optionalSection heading body+  | T.null (T.strip body) = []+  | otherwise = [section heading body]++-- | The blueprint names that this entry's entailed edges resolved to inside the+-- same registry. Resolution is decided once, in+-- 'Seihou.OKF.Docs.Model.resolveEntryRefs'; this only reads the answer.+resolvedEntailedBlueprints :: DocEntry -> [T.Text]+resolvedEntailedBlueprints entry =+  [ref ^. #blueprint | ref <- entry ^. #entailedRefs, ref ^. #resolved]++renderDependencies :: T.Text -> [Dependency] -> T.Text+renderDependencies emptyMessage [] = emptyMessage+renderDependencies _ dependencies =+  T.unlines+    [ "- " <> moduleLink (moduleName ^. #unModuleName) <> renderSuppliedVars vars+    | Dependency {module_ = moduleName, vars} <- dependencies+    ]++-- | The variable bindings the composing artifact supplies along this edge.+renderSuppliedVars :: Map VarName T.Text -> T.Text+renderSuppliedVars vars+  | Map.null vars = ""+  | otherwise =+      " (with "+        <> T.intercalate+          ", "+          [ "`" <> varName <> "` = `" <> value <> "`"+          | (VarName varName, value) <- Map.toAscList vars+          ]+        <> ")"+ moduleLink :: T.Text -> T.Text moduleLink name =   case conceptIdFor DocModuleKind name of     Right conceptId -> renderConceptLink conceptId name     Left _ -> "`" <> name <> "`" +-- | Variables, with the type, requiredness, default, validation rule and+-- description the declaration actually carries. renderVarDecls :: [VarDecl] -> T.Text renderVarDecls [] = "No variables declared."-renderVarDecls vars =-  T.unlines ["- `" <> varName <> "`" <> requiredLabel required | VarDecl {name = VarName varName, required} <- vars]+renderVarDecls vars = renderVarDecls' vars -requiredLabel :: Bool -> T.Text-requiredLabel required-  | required = " (required)"-  | otherwise = ""+-- | 'renderVarDecls' without the "none declared" fallback, for the kinds whose+-- Variables section is omitted when empty.+renderVarDecls' :: [VarDecl] -> T.Text+renderVarDecls' vars = T.unlines (renderVarDecl <$> vars) +renderVarDecl :: VarDecl -> T.Text+renderVarDecl VarDecl {name = VarName varName, type_, default_, description, required, validation} =+  "- `"+    <> varName+    <> "` — "+    <> T.intercalate+      ", "+      ( [renderVarType type_, if required then "required" else "optional"]+          <> foldMap (\value -> ["default `" <> renderValue value <> "`"]) default_+          <> foldMap (pure . renderValidation) validation+      )+    <> foldMap (". " <>) description++renderVarType :: VarType -> T.Text+renderVarType VTText = "text"+renderVarType VTBool = "boolean"+renderVarType VTInt = "integer"+renderVarType (VTList inner) = "list of " <> renderVarType inner+renderVarType (VTChoice choices) =+  "one of " <> T.intercalate ", " ["`" <> choice <> "`" | choice <- choices]++renderValidation :: Validation -> T.Text+renderValidation (ValPattern pattern_) = "matching `" <> pattern_ <> "`"+renderValidation (ValRange low high) =+  "between " <> T.pack (show low) <> " and " <> T.pack (show high)+renderValidation (ValMinLength n) = "at least " <> T.pack (show n) <> " characters"+renderValidation (ValMaxLength n) = "at most " <> T.pack (show n) <> " characters"++-- | A concrete value, in the plainest form a reader can act on. Distinct from+-- 'Seihou.Core.Expr.renderExpr', which renders values as expression syntax and+-- therefore quotes text.+renderValue :: VarValue -> T.Text+renderValue (VText text) = text+renderValue (VBool True) = "true"+renderValue (VBool False) = "false"+renderValue (VInt n) = T.pack (show n)+renderValue (VList values) = T.intercalate ", " (renderValue <$> values)+ renderExports :: [VarExport] -> T.Text renderExports [] = "No exports declared." renderExports exports =-  T.unlines ["- `" <> varName <> "`" | VarExport {var = VarName varName} <- exports]+  T.unlines+    [ "- `" <> varName <> "`" <> foldMap (\(VarName aliasName) -> " as `" <> aliasName <> "`") alias+    | VarExport {var = VarName varName, alias} <- exports+    ] +-- | Interactive prompts: which variable each fills, what it asks, the choices+-- it offers, and the condition that gates it.+renderPrompts :: [Prompt] -> T.Text+renderPrompts prompts = T.unlines (renderPrompt <$> prompts)++renderPrompt :: Prompt -> T.Text+renderPrompt Prompt {var = VarName varName, text, condition, choices} =+  "- `"+    <> varName+    <> "` — "+    <> T.strip text+    <> foldMap renderChoices choices+    <> renderCondition condition+  where+    renderChoices options =+      " (choices: " <> T.intercalate ", " ["`" <> option <> "`" | option <- options] <> ")"++renderCondition :: Maybe Expr -> T.Text+renderCondition = foldMap (\expr -> " — when `" <> renderExpr expr <> "`")++renderSteps :: [Step] -> T.Text+renderSteps steps = T.unlines (renderStep <$> steps)++renderStep :: Step -> T.Text+renderStep Step {strategy, src, dest, condition, patch} =+  "- `"+    <> renderStrategy strategy+    <> "` `"+    <> T.pack src+    <> "` → `"+    <> dest+    <> "`"+    <> foldMap (\op -> " (" <> renderPatchOp op <> ")") patch+    <> renderCondition condition++renderStrategy :: Strategy -> T.Text+renderStrategy Copy = "Copy"+renderStrategy Template = "Template"+renderStrategy DhallText = "DhallText"+renderStrategy Structured = "Structured"++renderPatchOp :: PatchOp -> T.Text+renderPatchOp AppendFile = "appends to a file another module owns"+renderPatchOp PrependFile = "prepends to a file another module owns"+renderPatchOp AppendSection = "appends a marked section to a file another module owns"+renderPatchOp AppendLineIfAbsent = "appends one line to a file another module owns, if absent"++renderCommands :: [Command] -> T.Text+renderCommands commands = T.unlines (renderCommand <$> commands)++renderCommand :: Command -> T.Text+renderCommand Command {run, workDir, condition} =+  "- `" <> run <> "`" <> renderWorkDir workDir <> renderCondition condition++renderWorkDir :: Maybe T.Text -> T.Text+renderWorkDir = foldMap (\dir -> " in `" <> dir <> "`")++renderRemoval :: Removal -> T.Text+renderRemoval Removal {steps, commands} =+  T.intercalate "\n" (filter (not . T.null) [renderRemovalSteps steps, renderRemovalCommands commands])+  where+    renderRemovalSteps [] = ""+    renderRemovalSteps removalSteps = T.unlines (renderRemovalStep <$> removalSteps)+    renderRemovalCommands [] = ""+    renderRemovalCommands removalCommands =+      "Then runs:\n\n" <> T.unlines (renderCommand <$> removalCommands)++renderRemovalStep :: RemovalStep -> T.Text+renderRemovalStep RemovalStep {action, dest, src} =+  "- " <> renderRemovalAction action <> " `" <> dest <> "`" <> foldMap (\path -> " using `" <> T.pack path <> "`") src++renderRemovalAction :: RemovalAction -> T.Text+renderRemovalAction RemoveFileAction = "delete"+renderRemovalAction RemoveSectionAction = "strip this module's section from"+renderRemovalAction RewriteFileAction = "rewrite"++renderMigrations :: [Migration] -> T.Text+renderMigrations migrations =+  T.intercalate "\n\n" (renderMigration <$> migrations)++renderMigration :: Migration -> T.Text+renderMigration Migration {from, to, ops} =+  "### " <> from <> " → " <> to <> "\n\n" <> renderMigrationOps ops++renderMigrationOps :: [MigrationOp] -> T.Text+renderMigrationOps [] = "This edge declares no operations; it advances the recorded version only."+renderMigrationOps ops = T.unlines (renderMigrationOp <$> ops)++renderMigrationOp :: MigrationOp -> T.Text+renderMigrationOp MoveFile {src, dest} = "- move `" <> T.pack src <> "` → `" <> T.pack dest <> "`"+renderMigrationOp MoveDir {src, dest} = "- move directory `" <> T.pack src <> "` → `" <> T.pack dest <> "`"+renderMigrationOp DeleteFile {path} = "- delete `" <> T.pack path <> "`"+renderMigrationOp DeleteDir {path} = "- delete directory `" <> T.pack path <> "`"+renderMigrationOp RunCommand {run, workDir} =+  "- run `" <> run <> "`" <> foldMap (\dir -> " in `" <> T.pack dir <> "`") workDir++-- | Blueprint migration edges, each with the guidance the agent is given and+-- the other blueprints' edges that crossing this one entails.+renderBlueprintMigrations :: [T.Text] -> [BlueprintMigration] -> T.Text+renderBlueprintMigrations resolvedBlueprints migrations =+  T.intercalate "\n\n" (renderBlueprintMigration resolvedBlueprints <$> migrations)++renderBlueprintMigration :: [T.Text] -> BlueprintMigration -> T.Text+renderBlueprintMigration resolvedBlueprints BlueprintMigration {from, to, prompt, entails} =+  T.intercalate+    "\n\n"+    ( ["### " <> from <> " → " <> to, T.strip prompt]+        <> renderEntails resolvedBlueprints entails+    )++renderEntails :: [T.Text] -> [EntailedEdge] -> [T.Text]+renderEntails _ [] = []+renderEntails resolvedBlueprints entails =+  [ "Entails:\n\n"+      <> T.unlines (renderEntailedEdge resolvedBlueprints <$> entails)+  ]++-- | An entailed edge naming a blueprint in this registry becomes a cross-link;+-- one naming a blueprint elsewhere becomes labelled text.+--+-- The distinction is not cosmetic. An entailed edge is owned by the blueprint+-- that declares it and may legitimately name a blueprint in another repository+-- entirely (ADR 0008 in the seihou repository), and okf reports a link to a+-- concept that is not in the bundle as a dangling reference, which this+-- generator treats as fatal.+renderEntailedEdge :: [T.Text] -> EntailedEdge -> T.Text+renderEntailedEdge resolvedBlueprints EntailedEdge {blueprint, from, to}+  | blueprint `elem` resolvedBlueprints,+    Right conceptId <- conceptIdFor DocBlueprintKind blueprint =+      "- " <> renderConceptLink conceptId blueprint <> " `" <> from <> "` → `" <> to <> "`"+  | otherwise =+      "- `" <> blueprint <> "` `" <> from <> "` → `" <> to <> "` (declared outside this registry)"++renderAgentLaunch :: AgentLaunch -> T.Text+renderAgentLaunch AgentLaunch {provider, model, effort} =+  case declared of+    [] -> ""+    _ ->+      T.unlines declared+        <> "\nThese are defaults. An explicit `--provider`, `--model` or `--effort` flag \+           \and the `SEIHOU_AGENT_*` environment variables both override them; the \+           \invoking user's configuration files do not.\n"+  where+    declared =+      foldMap (\value -> ["- provider: `" <> value <> "`"]) provider+        <> foldMap (\value -> ["- model: `" <> value <> "`"]) model+        <> foldMap (\value -> ["- effort: `" <> value <> "`"]) effort++renderVersionProbe :: T.Text -> T.Text+renderVersionProbe probe =+  "```bash\n"+    <> T.strip probe+    <> "\n```\n\nSeihou reads no package-manager format of its own, so this \+       \author-declared command is how it discovers which version of this \+       \blueprint's library the project currently declares; its output supplies \+       \the default `--to` for `seihou agent migrate` (ADR 0009 in the seihou \+       \repository)."++renderCommandVars :: [CommandVar] -> T.Text+renderCommandVars commandVars = T.unlines (renderCommandVar <$> commandVars)++renderCommandVar :: CommandVar -> T.Text+renderCommandVar CommandVar {name = VarName varName, run, workDir, condition, trim, maxBytes} =+  "- `"+    <> varName+    <> "` — runs `"+    <> run+    <> "`"+    <> renderWorkDir workDir+    <> ", "+    <> (if trim then "trimmed" else "untrimmed")+    <> foldMap (\limit -> ", capped at " <> T.pack (show limit) <> " bytes") maxBytes+    <> renderCondition condition++renderGuidance :: [PromptGuidance] -> T.Text+renderGuidance guidance = T.intercalate "\n\n" (renderGuidanceBlock <$> guidance)++renderGuidanceBlock :: PromptGuidance -> T.Text+renderGuidanceBlock PromptGuidance {title, body, condition} =+  T.intercalate+    "\n\n"+    ( ["### " <> title, T.strip body]+        <> foldMap (\expr -> ["Applies when `" <> renderExpr expr <> "`."]) condition+    )++-- | The prompt as a reader needs it: an opening excerpt so the section reads,+-- then the whole text verbatim in a fence so nothing is lost.+renderAgentPrompt :: T.Text -> T.Text+renderAgentPrompt prompt+  | T.null (T.strip prompt) = "No prompt text provided."+  | otherwise =+      firstParagraph prompt <> "\n\n```text\n" <> T.strip prompt <> "\n```"+ renderBlueprintFiles :: [BlueprintFile] -> T.Text renderBlueprintFiles [] = "No reference files declared." renderBlueprintFiles files =@@ -170,8 +753,11 @@  renderTextList :: [T.Text] -> T.Text renderTextList [] = "No tool restrictions declared."-renderTextList values = T.unlines ["- `" <> value <> "`" | value <- values]+renderTextList values = renderTextList' values +renderTextList' :: [T.Text] -> T.Text+renderTextList' values = T.unlines ["- `" <> value <> "`" | value <- values]+ firstParagraph :: T.Text -> T.Text firstParagraph text =   case T.splitOn "\n\n" text of@@ -189,9 +775,11 @@ kindDir DocRecipeKind = "recipes" kindDir DocBlueprintKind = "blueprints" kindDir DocPromptKind = "prompts"+kindDir DocRegistryKind = "registry"  typeFor :: DocKind -> T.Text typeFor DocModuleKind = "SeihouModule" typeFor DocRecipeKind = "SeihouRecipe" typeFor DocBlueprintKind = "SeihouBlueprint" typeFor DocPromptKind = "SeihouPrompt"+typeFor DocRegistryKind = "SeihouRegistry"

@@ -20,8 +20,8 @@  runExtensionMain :: IO () runExtensionMain = do-  command <- customExecParser (prefs showHelpOnEmpty) opts-  case command of+  parsedCommand <- customExecParser (prefs showHelpOnEmpty) opts+  case parsedCommand of     Docs docsOpts ->       handleDocs docsOpts @@ -73,3 +73,31 @@           <> help "Output directory for the generated OKF bundle"       )     <*> switch (long "force" <> help "Overwrite a non-empty output directory")+    <*> optional+      ( strOption+          ( long "generated-at"+              <> metavar "DATE"+              <> help+                "ISO-8601 date or timestamp recorded as the generation time; \+                \omitted by default so regeneration is byte-stable"+          )+      )+    <*> switch+      ( long "permissive"+          <> help+            "Validate with OKF permissive conformance instead of the default \+            \strict authoring rules"+      )+    <*> optional+      ( strOption+          ( long "profile"+              <> metavar "PATH"+              <> help+                "Check the bundle against this house profile descriptor instead \+                \of the built-in one"+          )+      )+    <*> switch+      ( long "no-profile"+          <> help "Skip house-profile enforcement entirely"+      )

@@ -8,14 +8,31 @@  import Control.Lens ((^.)) import Control.Monad (when)+import Data.Aeson (Value)+import Data.Aeson.Text qualified as Aeson import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty import Data.Text qualified as T import Data.Text.IO qualified as TIO+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Builder qualified as TLB import GHC.Generics (Generic)+import Okf.Bundle (BundleError (..)) import Okf.ConceptId qualified as Okf-import Okf.Validation (BundleValidationError (..), ValidationError (..))+import Okf.Document (DocumentParseError (..))+import Okf.Log (LogValidationError (..))+import Okf.Profile+  ( FieldCondition (..),+    FieldPath (..),+    FieldPathSegment (..),+    ProfileViolation (..),+    renderCardinalityName,+    renderFieldFormatName,+  )+import Okf.Validation (BundleValidationError (..), ValidationError (..), ValidationProfile (..)) import Seihou.OKF.Docs.Model import Seihou.OKF.Docs.Render+import Seihou.OKF.Extension.Version (extensionVersion) import System.Directory   ( createDirectoryIfMissing,     doesDirectoryExist,@@ -31,10 +48,33 @@ data DocsOpts = DocsOpts   { dir :: !FilePath,     out :: !FilePath,-    force :: !Bool+    force :: !Bool,+    -- | Recorded verbatim as OKF @generated.at@. Absent by default, because+    -- reading the clock would make every regeneration produce different bytes.+    generatedAt :: !(Maybe T.Text),+    -- | Validate with 'PermissiveConformance' instead of the default+    -- 'StrictAuthoring'.+    permissive :: !Bool,+    -- | Check against this house profile descriptor instead of the built-in+    -- one.+    profile :: !(Maybe FilePath),+    -- | Skip house-profile enforcement entirely.+    noProfile :: !Bool   }   deriving stock (Eq, Generic, Show) +-- | The renderer configuration these command-line options describe.+renderOptionsFor :: DocsOpts -> RenderOptions+renderOptionsFor opts =+  RenderOptions+    { producerVersion = extensionVersion,+      generatedAt = opts ^. #generatedAt,+      validationProfile =+        if opts ^. #permissive then PermissiveConformance else StrictAuthoring,+      profileSource = opts ^. #profile,+      enforceProfile = not (opts ^. #noProfile)+    }+ runDocs :: DocsOpts -> IO (Either T.Text T.Text) runDocs opts = do   let registryFile = opts ^. #dir </> "seihou-registry.dhall"@@ -50,18 +90,25 @@           case modelResult of             Left err -> pure (Left (renderDocLoadError err))             Right model ->-              case renderDocBundle model of+              case renderDocBundle (renderOptionsFor opts) model of                 Left renderErrors ->                   pure (Left (renderMany renderDocRenderError renderErrors))                 Right (concepts, validationProblems)                   | not (null validationProblems) ->                       pure (Left (renderMany renderBundleValidationError validationProblems))                   | otherwise -> do-                      prepareOutputDirectory (opts ^. #out)-                      writeResult <- writeDocBundle (opts ^. #out) model-                      pure $ case writeResult of-                        Left errors -> Left (renderMany renderDocBundleError errors)-                        Right () -> Right ("Wrote " <> T.pack (show (length concepts)) <> " concepts to " <> T.pack (opts ^. #out))+                      -- Check the house profile before touching the output+                      -- directory, so a violating run leaves whatever was+                      -- there untouched rather than clearing it first.+                      profileProblems <- checkDocProfile (renderOptionsFor opts) concepts+                      if not (null profileProblems)+                        then pure (Left (renderMany renderDocBundleError profileProblems))+                        else do+                          prepareOutputDirectory (opts ^. #out)+                          writeResult <- writeDocBundle (renderOptionsFor opts) (opts ^. #out) model+                          pure $ case writeResult of+                            Left errors -> Left (renderMany renderDocBundleError errors)+                            Right () -> Right ("Wrote " <> T.pack (show (length concepts)) <> " concepts to " <> T.pack (opts ^. #out))  handleDocs :: DocsOpts -> IO () handleDocs opts = do@@ -105,19 +152,73 @@ renderDocBundleError :: DocBundleError -> T.Text renderDocBundleError (DocBundleRenderError err) = renderDocRenderError err renderDocBundleError (DocBundleValidationError err) = renderBundleValidationError err+renderDocBundleError (DocBundleIndexError err) =+  "failed to write bundle indexes: " <> renderBundleError err+renderDocBundleError (DocBundleProfileUnreadable err) =+  "could not read the house profile descriptor: " <> err+renderDocBundleError (DocBundleProfileInvalid errs) =+  "the house profile descriptor does not compile: "+    <> T.intercalate "; " (T.pack . show <$> NonEmpty.toList errs)+renderDocBundleError (DocBundleProfileViolation violation) =+  "house profile: " <> renderProfileViolation violation +-- | Total by construction; see 'renderBundleValidationError'.+renderBundleError :: BundleError -> T.Text+renderBundleError (InvalidConceptPath path err) =+  T.pack path <> ": not a usable concept path: " <> T.pack (show err)+renderBundleError (InvalidConceptDocument path err) =+  T.pack path <> ": " <> renderDocumentParseError err+renderBundleError (BundleIoError path err) =+  T.pack path <> ": " <> err++-- | Total by construction; see 'renderBundleValidationError'.+renderDocumentParseError :: DocumentParseError -> T.Text+renderDocumentParseError UnterminatedFrontmatter =+  "frontmatter block is never closed"+renderDocumentParseError (InvalidYaml err) =+  "frontmatter is not valid YAML: " <> err+renderDocumentParseError FrontmatterNotMapping =+  "frontmatter is not a YAML mapping"+ renderDocRenderError :: DocRenderError -> T.Text renderDocRenderError (InvalidDocConceptId kind name err) =   "invalid OKF concept ID for " <> T.pack (show kind) <> " " <> name <> ": " <> err +-- | Every 'BundleValidationError' constructor gets its own branch, deliberately+-- with no catch-all: @-Werror=incomplete-patterns@ then turns the next okf-core+-- upgrade that adds a constructor into a build failure here rather than a+-- pattern-match crash at generation time. renderBundleValidationError :: BundleValidationError -> T.Text renderBundleValidationError (DocumentInvalid conceptId err) =   Okf.renderConceptId conceptId <> ": " <> renderValidationError err renderBundleValidationError (DanglingReference source target) =   Okf.renderConceptId source <> ": link to missing concept: " <> Okf.renderConceptId target+renderBundleValidationError (DanglingFrontmatterPath conceptId field target alternative) =+  Okf.renderConceptId conceptId+    <> ": frontmatter field "+    <> field+    <> " names a path that is not in the bundle: "+    <> T.pack target+    <> maybe "" (\alt -> " (did you mean " <> T.pack alt <> "?)") alternative renderBundleValidationError (DuplicateConceptId conceptId) =   "duplicate concept ID: " <> Okf.renderConceptId conceptId+renderBundleValidationError (LogInvalid path err) =+  T.pack path <> ": " <> renderLogValidationError err+renderBundleValidationError (BundleVersionUnparseable raw) =+  "bundle root index declares an unparseable OKF version: " <> raw+renderBundleValidationError (BundleVersionNotUnderstood raw) =+  "bundle root index declares an OKF version this tool does not understand: " <> raw +-- | Total by construction; see 'renderBundleValidationError'.+renderLogValidationError :: LogValidationError -> T.Text+renderLogValidationError (LogDateNotIso raw) =+  "log day heading is not an ISO-8601 date: " <> raw+renderLogValidationError (LogDaysOutOfOrder earlier later) =+  "log days are out of order: " <> earlier <> " appears before " <> later+renderLogValidationError (LogEmptyDay day) =+  "log day has no entries: " <> day++-- | Total by construction; see 'renderBundleValidationError'. renderValidationError :: ValidationError -> T.Text renderValidationError (MissingRequiredField field) =   "missing required field: " <> field@@ -125,6 +226,159 @@   "field must be non-empty text: " <> field renderValidationError (MissingRecommendedField field) =   "missing recommended field: " <> field+renderValidationError (FieldMustBeListOfText field) =+  "field must be a list of text: " <> field+renderValidationError MissingGeneratedField =+  "concept records neither a generated block nor a legacy timestamp"+renderValidationError GeneratedMustHaveActor =+  "concept has a generated block with no by actor"+renderValidationError (SourceMissingResource index) =+  "sources entry " <> T.pack (show index) <> " has no resource"+renderValidationError (DuplicateSourceId sourceId) =+  "two sources entries share the id: " <> sourceId+renderValidationError (FootnoteLabelNotInSources label) =+  "body cites footnote label with no matching sources entry: " <> label+renderValidationError (SourceIdNotCited sourceId) =+  "sources entry is never cited in the body: " <> sourceId+renderValidationError (LegacyFieldInDeclaredV2 field) =+  "concept uses the superseded OKF v0.1 field " <> field <> " in a bundle declaring v0.2"+renderValidationError AttestedComputationMissingRuntime =+  "Attested Computation concept declares no runtime"+renderValidationError AttestedComputationHasNoComputation =+  "Attested Computation concept offers neither a computation path nor a body code block"+renderValidationError AttestedComputationHasBothComputations =+  "Attested Computation concept offers both a computation path and a body code block"+renderValidationError (AttestedComputationHasManyBlocks count) =+  "Attested Computation section holds "+    <> T.pack (show count)+    <> " code blocks; exactly one is permitted"  renderMany :: (a -> T.Text) -> [a] -> T.Text renderMany render = T.intercalate "\n" . fmap render++-- | Render one house-profile deviation.+--+-- okf-core reports 'ProfileViolation' but does not render it: the renderer+-- lives in the @okf-cli@ package, which this repository does not depend on.+-- Total by construction, for the reason 'renderBundleValidationError' gives.+renderProfileViolation :: ProfileViolation -> T.Text+renderProfileViolation (TypeNotInProfile conceptId conceptType) =+  at conceptId <> "type " <> conceptType <> " is not one this profile declares"+renderProfileViolation (MissingProfileField conceptId key condition) =+  at conceptId <> "missing required field " <> key <> renderFieldCondition condition+renderProfileViolation (MissingRecommendedProfileField conceptId key condition) =+  at conceptId <> "missing recommended field " <> key <> renderFieldCondition condition+renderProfileViolation (MissingNestedProfileField conceptId path condition) =+  at conceptId <> "missing required field " <> renderFieldPath path <> renderFieldCondition condition+renderProfileViolation (MissingRecommendedNestedProfileField conceptId path condition) =+  at conceptId <> "missing recommended field " <> renderFieldPath path <> renderFieldCondition condition+renderProfileViolation (ValueNotInVocabulary conceptId path allowed value) =+  at conceptId+    <> renderFieldPath path+    <> " holds "+    <> renderJson value+    <> ", which is not one of "+    <> T.intercalate ", " allowed+renderProfileViolation (CardinalityMismatch conceptId path cardinality value) =+  at conceptId+    <> renderFieldPath path+    <> " must be "+    <> renderCardinalityName cardinality+    <> ", but holds "+    <> renderJson value+renderProfileViolation (ValueFormatMismatch conceptId path format value) =+  at conceptId+    <> renderFieldPath path+    <> " must be "+    <> renderFieldFormatName format+    <> ", but holds "+    <> renderJson value+renderProfileViolation (DanglingHandleReference conceptId path handle) =+  at conceptId <> renderFieldPath path <> " references handle " <> handle <> ", which nothing in this bundle owns"+renderProfileViolation (ReferenceHandlePrefixMismatch conceptId path expected actual) =+  at conceptId <> renderFieldPath path <> " expects handle prefix " <> expected <> ", but holds " <> actual+renderProfileViolation (MalformedDocumentReference conceptId path value) =+  at conceptId <> renderFieldPath path <> " is neither a local handle nor an absolute URI: " <> renderJson value+renderProfileViolation (ExternalReferenceSchemeNotAllowed conceptId path scheme allowed) =+  at conceptId+    <> renderFieldPath path+    <> " uses URI scheme "+    <> scheme+    <> ", which this profile does not permit; allowed: "+    <> T.intercalate ", " allowed+renderProfileViolation (LocalDocumentReferenceNotAllowed conceptId path handle) =+  at conceptId <> renderFieldPath path <> " may not hold a local handle, but holds " <> handle+renderProfileViolation (ExternalReferencePatternMismatch conceptId path value pattern_) =+  at conceptId <> renderFieldPath path <> " holds " <> value <> ", which does not match " <> pattern_+renderProfileViolation (SelfDocumentReference conceptId path value) =+  at conceptId <> renderFieldPath path <> " references the concept it is written on: " <> value+renderProfileViolation (MalformedPathReference conceptId path value) =+  at conceptId <> renderFieldPath path <> " is not a usable path or URI: " <> renderJson value+renderProfileViolation (PathEscapesBundle conceptId path value) =+  at conceptId <> renderFieldPath path <> " climbs above the bundle root: " <> value+renderProfileViolation (DanglingPathReference conceptId path target) =+  at conceptId <> renderFieldPath path <> " names a path that is not in this bundle: " <> target+renderProfileViolation (FieldNotInProfile conceptId key) =+  at conceptId <> "field " <> key <> " is not one this profile declares"+renderProfileViolation (NestedElementNotRecord conceptId path value) =+  at conceptId <> renderFieldPath path <> " must be a record, but holds " <> renderJson value+renderProfileViolation (DuplicateNestedFieldValue conceptId path value indexes) =+  at conceptId+    <> renderFieldPath path+    <> " repeats the value "+    <> renderJson value+    <> " at elements "+    <> T.intercalate ", " (T.pack . show <$> NonEmpty.toList indexes)+renderProfileViolation (PathPatternMismatch conceptId conceptType pattern_) =+  at conceptId <> conceptType <> " concepts must live at " <> pattern_+renderProfileViolation (MissingResource conceptId conceptType scheme) =+  at conceptId <> conceptType <> " concepts must carry a " <> scheme <> ": resource"+renderProfileViolation (ResourceSchemeMismatch conceptId scheme resource) =+  at conceptId <> "resource must use the " <> scheme <> " scheme, but is " <> resource+renderProfileViolation (MissingSchemaSection conceptId conceptType) =+  at conceptId <> conceptType <> " concepts must carry a # Schema section"+renderProfileViolation (SchemaColumnsMismatch conceptId conceptType expected actual) =+  at conceptId+    <> conceptType+    <> " # Schema columns must be "+    <> T.intercalate ", " expected+    <> ", but are "+    <> T.intercalate ", " actual+renderProfileViolation (MissingDocumentId conceptId conceptType prefix) =+  at conceptId <> conceptType <> " concepts must carry a " <> prefix <> "-N handle"+renderProfileViolation (MalformedDocumentId conceptId prefix value) =+  at conceptId <> "handle " <> value <> " is not well formed for prefix " <> prefix+renderProfileViolation (DuplicateDocumentId handle conceptId other) =+  "handle "+    <> handle+    <> " is claimed by both "+    <> Okf.renderConceptId conceptId+    <> " and "+    <> Okf.renderConceptId other+renderProfileViolation (RequiredBundleVersionUnmet required declared) =+  "bundle must declare OKF version "+    <> required+    <> " or later, but declares "+    <> maybe "nothing" id declared++at :: Okf.ConceptId -> T.Text+at conceptId = Okf.renderConceptId conceptId <> ": "++renderFieldCondition :: Maybe FieldCondition -> T.Text+renderFieldCondition =+  foldMap+    ( \FieldCondition {field, hasValue} ->+        " (required when " <> field <> " is " <> T.intercalate " or " hasValue <> ")"+    )++-- | A frontmatter field path, in the dotted form the descriptor writes it in.+renderFieldPath :: FieldPath -> T.Text+renderFieldPath FieldPath {segments} =+  T.intercalate "." (renderFieldPathSegment <$> NonEmpty.toList segments)++renderFieldPathSegment :: FieldPathSegment -> T.Text+renderFieldPathSegment (FieldName name) = name+renderFieldPathSegment (ArrayIndex index) = "[" <> T.pack (show index) <> "]"++renderJson :: Value -> T.Text+renderJson = TL.toStrict . TLB.toLazyText . Aeson.encodeToTextBuilder

@@ -0,0 +1,23 @@+-- | The extension's own version, read from Cabal rather than a hand-maintained+-- literal, so the provenance actor stamped on every generated concept cannot+-- drift from the package that produced it.+module Seihou.OKF.Extension.Version+  ( extensionVersion,+    producerActorName,+  )+where++import Data.Text (Text)+import Data.Text qualified as T+import Data.Version (showVersion)+import Paths_seihou_okf_extension qualified as Paths++-- | The extension's package version, e.g. @"0.7.0.0"@.+extensionVersion :: Text+extensionVersion = T.pack (showVersion Paths.version)++-- | The producer half of the OKF @generated.by@ actor. The version half is+-- 'extensionVersion'; together okf renders them as+-- @seihou-okf-extension\/\<version\>@.+producerActorName :: Text+producerActorName = "seihou-okf-extension"

@@ -25,7 +25,7 @@         (model ^. #repoName) `shouldBe` "fixture-registry"         length (entriesByKind DocModuleKind model) `shouldBe` 3         length (entriesByKind DocRecipeKind model) `shouldBe` 1-        length (entriesByKind DocBlueprintKind model) `shouldBe` 1+        length (entriesByKind DocBlueprintKind model) `shouldBe` 2         length (entriesByKind DocPromptKind model) `shouldBe` 1      it "keeps catalog metadata from the registry entry" $ do@@ -57,6 +57,44 @@         (recipe ^. #moduleRefs) `shouldMatchList` [ModuleRef "base" True, ModuleRef "app" True]         (blueprint ^. #moduleRefs) `shouldBe` [ModuleRef "base" True] +    it "resolves an entailed edge naming a blueprint in the same registry" $ do+      withFixtureRegistry $ \registryDir -> do+        model <- shouldLoad registryDir+        let entry = requireEntry "entailing-blueprint" model+        (entry ^. #entailedRefs)+          `shouldContain` [ EntailedRef+                              { blueprint = "app-blueprint",+                                from = "1.0.0",+                                to = "2.0.0",+                                resolved = True+                              }+                          ]++    it "leaves an entailed edge naming a blueprint outside the registry unresolved" $ do+      withFixtureRegistry $ \registryDir -> do+        model <- shouldLoad registryDir+        let entry = requireEntry "entailing-blueprint" model+        (entry ^. #entailedRefs)+          `shouldContain` [ EntailedRef+                              { blueprint = "kiroku",+                                from = "1.9.0",+                                to = "2.0.0",+                                resolved = False+                              }+                          ]++    it "records no entailed edges for a blueprint that declares none" $ do+      withFixtureRegistry $ \registryDir -> do+        model <- shouldLoad registryDir+        (requireEntry "app-blueprint" model ^. #entailedRefs) `shouldBe` []++    it "records no entailed edges for kinds that cannot declare them" $ do+      withFixtureRegistry $ \registryDir -> do+        model <- shouldLoad registryDir+        (requireEntry "app" model ^. #entailedRefs) `shouldBe` []+        (requireEntry "app-recipe" model ^. #entailedRefs) `shouldBe` []+        (requireEntry "review" model ^. #entailedRefs) `shouldBe` []+     it "returns RegistryNotFound when the registry file is absent" $ do       withSystemTempDirectory "seihou-doc-model-missing" $ \registryDir -> do         result <- loadDocModel registryDir@@ -94,6 +132,7 @@   writeModule registryDir "modules/dangling" "dangling" ["missing"] "Dangling module"   writeRecipe registryDir   writeBlueprint registryDir+  writeEntailingBlueprint registryDir   writePrompt registryDir  writeModule :: FilePath -> FilePath -> String -> [String] -> String -> IO ()@@ -113,6 +152,14 @@   createDirectoryIfMissing True (registryDir </> relDir)   writeFile (registryDir </> relDir </> "blueprint.dhall") blueprintDhall +-- | A blueprint whose one migration edge entails two edges: one of a blueprint+-- listed in this registry, and one of a blueprint that is not.+writeEntailingBlueprint :: FilePath -> IO ()+writeEntailingBlueprint registryDir = do+  let relDir = "blueprints/entailing-blueprint"+  createDirectoryIfMissing True (registryDir </> relDir)+  writeFile (registryDir </> relDir </> "blueprint.dhall") entailingBlueprintDhall+ writePrompt :: FilePath -> IO () writePrompt registryDir = do   let relDir = "prompts/review"@@ -129,7 +176,10 @@   \  , { name = \"dangling\", version = None Text, path = \"modules/dangling\", description = Some \"Dangling module\", tags = [] : List Text }\n\   \  ]\n\   \, recipes = [ { name = \"app-recipe\", version = Some \"0.1.0\", path = \"recipes/app-recipe\", description = Some \"Recipe\", tags = [ \"recipe\" ] } ]\n\-  \, blueprints = [ { name = \"app-blueprint\", version = Some \"0.1.0\", path = \"blueprints/app-blueprint\", description = Some \"Blueprint\", tags = [ \"blueprint\" ] } ]\n\+  \, blueprints =\n\+  \  [ { name = \"app-blueprint\", version = Some \"0.1.0\", path = \"blueprints/app-blueprint\", description = Some \"Blueprint\", tags = [ \"blueprint\" ] }\n\+  \  , { name = \"entailing-blueprint\", version = Some \"0.1.0\", path = \"blueprints/entailing-blueprint\", description = Some \"Entailing blueprint\", tags = [] : List Text }\n\+  \  ]\n\   \, prompts = [ { name = \"review\", version = Some \"0.1.0\", path = \"prompts/review\", description = Some \"Review prompt\", tags = [ \"prompt\" ] } ]\n\   \}" @@ -194,6 +244,36 @@     <> "\n\        \, allowedTools = None (List Text)\n\        \, tags = [ \"blueprint\" ]\n\+       \}"++entailingBlueprintDhall :: String+entailingBlueprintDhall =+  "{ name = \"entailing-blueprint\"\n\+  \, version = Some \"0.1.0\"\n\+  \, description = Some \"Entailing blueprint\"\n\+  \, prompt = \"Upgrade\"\n\+  \, vars = [] : "+    <> varDeclListType+    <> "\n\+       \, prompts = [] : "+    <> promptListType+    <> "\n\+       \, baseModules = [] : List Text\n\+       \, files = [] : "+    <> blueprintFileListType+    <> "\n\+       \, allowedTools = None (List Text)\n\+       \, tags = [] : List Text\n\+       \, migrations =\n\+       \  [ { from = \"2.4.0\"\n\+       \    , to = \"3.0.0\"\n\+       \    , prompt = \"Cross it\"\n\+       \    , entails =\n\+       \      [ { blueprint = \"app-blueprint\", from = \"1.0.0\", to = \"2.0.0\" }\n\+       \      , { blueprint = \"kiroku\", from = \"1.9.0\", to = \"2.0.0\" }\n\+       \      ]\n\+       \    }\n\+       \  ]\n\        \}"  promptDhall :: String

@@ -1,13 +1,19 @@ module Seihou.OKF.Docs.RenderSpec (tests) where -import Control.Lens ((^.))+import Control.Lens ((&), (?~), (^.)) import Data.Generics.Labels () import Data.List (sort) import Data.Map.Strict qualified as Map import Data.Text qualified as T import Okf.Bundle qualified as Okf import Okf.ConceptId qualified as Okf-import Okf.Validation (BundleValidationError (..))+import Okf.Validation (BundleValidationError (..), ValidationProfile (..))+import Seihou.Core.Migration+  ( BlueprintMigration (..),+    EntailedEdge (..),+    Migration (..),+    MigrationOp (..),+  ) import Seihou.Core.Types import Seihou.OKF.Docs.Model import Seihou.OKF.Docs.Render@@ -21,19 +27,20 @@ spec :: Spec spec = do   describe "renderDocBundle" $ do-    it "emits one concept per entry with the documented id scheme" $ do-      let Right (concepts, problems) = renderDocBundle wellFormedModel+    it "emits one concept per entry, plus the registry overview, with the documented id scheme" $ do+      (concepts, problems) <- renderOrFail testOptions wellFormedModel       problems `shouldBe` []       sort (Okf.renderConceptId . Okf.conceptIdOf <$> concepts)         `shouldBe` [ "blueprints/app-blueprint",                      "modules/app",                      "modules/base",                      "prompts/review",-                     "recipes/app-recipe"+                     "recipes/app-recipe",+                     "registry/fixture"                    ]      it "renders frontmatter fields and resource pointers" $ do-      concept <- requireConcept "modules/base" wellFormedModel+      concept <- requireConcept "modules/base" testOptions wellFormedModel       let rendered = Okf.serializeConcept concept       rendered `shouldSatisfy` T.isInfixOf "type: SeihouModule"       rendered `shouldSatisfy` T.isInfixOf "title: base"@@ -41,35 +48,219 @@       rendered `shouldSatisfy` T.isInfixOf "version: 1.0.0"      it "renders resolvable cross-links to composed modules" $ do-      concept <- requireConcept "recipes/app-recipe" wellFormedModel+      concept <- requireConcept "recipes/app-recipe" testOptions wellFormedModel       let rendered = Okf.serializeConcept concept       rendered `shouldSatisfy` T.isInfixOf "](/modules/base.md)"       rendered `shouldSatisfy` T.isInfixOf "](/modules/app.md)"      it "validates clean for a well-formed model" $ do-      let Right (_, problems) = renderDocBundle wellFormedModel+      (_, problems) <- renderOrFail testOptions wellFormedModel       problems `shouldBe` []      it "reports a DanglingReference for an unresolved module ref" $ do-      let Right (_, problems) = renderDocBundle danglingModel+      (_, problems) <- renderOrFail testOptions danglingModel       problems `shouldSatisfy` any isDanglingReference      it "reports invalid generated concept IDs as render errors" $ do-      renderDocBundle invalidIdModel+      renderDocBundle testOptions invalidIdModel         `shouldBe` Left [InvalidDocConceptId DocModuleKind "-bad" "InvalidConceptIdSegment \"-bad\""] -requireConcept :: T.Text -> DocModel -> IO Okf.Concept-requireConcept rawId model =-  case renderDocBundle model of+    it "stamps a generated.by producer actor on every concept" $ do+      (concepts, _) <- renderOrFail testOptions wellFormedModel+      let rendered = Okf.serializeConcept <$> concepts+      rendered `shouldSatisfy` all (T.isInfixOf "by: seihou-okf-extension/9.9.9")++    it "omits generated.at unless the operator supplies one" $ do+      concept <- requireConcept "modules/base" testOptions wellFormedModel+      Okf.serializeConcept concept `shouldNotSatisfy` T.isInfixOf "at:"++    it "records --generated-at verbatim in generated.at" $ do+      let dated = testOptions & #generatedAt ?~ "2026-09-10"+      concept <- requireConcept "modules/base" dated wellFormedModel+      Okf.serializeConcept concept `shouldSatisfy` T.isInfixOf "at: 2026-09-10"++    it "marks every concept stable" $ do+      concept <- requireConcept "modules/base" testOptions wellFormedModel+      Okf.serializeConcept concept `shouldSatisfy` T.isInfixOf "status: stable"++    it "validates clean under StrictAuthoring when nothing supplies a description" $ do+      (_, problems) <- renderOrFail testOptions undescribedModel+      problems `shouldBe` []++    it "falls back to the artifact description when the registry entry has none" $ do+      concept <- requireConcept "modules/base" testOptions registrySilentModel+      Okf.serializeConcept concept+        `shouldSatisfy` T.isInfixOf "description: the artifact describes itself"++    it "synthesizes a description when neither the registry nor the artifact has one" $ do+      concept <- requireConcept "modules/base" testOptions undescribedModel+      Okf.serializeConcept concept+        `shouldSatisfy` T.isInfixOf "Seihou module `base` published by the `fixture` registry."++  describe "artifact features" $ do+    it "renders a variable declaration in full" $ do+      body <- requireBody "modules/rich" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "- `project.name` — text, required, matching `[a-z]+`. The project name"+      body `shouldSatisfy` T.isInfixOf "- `license` — one of `MIT`, `BSD-3`, optional, default `MIT`"+      body `shouldSatisfy` T.isInfixOf "- `retries` — integer, optional, between 0 and 5"++    it "renders an export alias" $ do+      body <- requireBody "modules/rich" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "- `project.name` as `app.name`"++    it "renders interactive prompts with choices and conditions" $ do+      body <- requireBody "modules/rich" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "## Prompts"+      body+        `shouldSatisfy` T.isInfixOf+          "- `license` — Which license? (choices: `MIT`, `BSD-3`) — when `IsSet project.name`"++    it "renders generation steps with strategy, patch operation and condition" $ do+      body <- requireBody "modules/rich" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "## Generation steps"+      body `shouldSatisfy` T.isInfixOf "- `Template` `flake.nix.tpl` → `flake.nix`"+      body+        `shouldSatisfy` T.isInfixOf+          "- `Copy` `gitignore.tpl` → `.gitignore` (appends one line to a file another module owns, if absent) — when `Eq license \"MIT\"`"++    it "renders commands with working directory and condition" $ do+      body <- requireBody "modules/rich" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "## Commands"+      body `shouldSatisfy` T.isInfixOf "- `cabal build` in `app` — when `IsSet license`"++    it "renders the removal procedure" $ do+      body <- requireBody "modules/rich" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "## Removal"+      body `shouldSatisfy` T.isInfixOf "- delete `flake.nix`"+      body `shouldSatisfy` T.isInfixOf "- strip this module's section from `.gitignore`"+      body `shouldSatisfy` T.isInfixOf "Then runs:"+      body `shouldSatisfy` T.isInfixOf "- `rm -rf dist-newstyle`"++    it "renders each module migration edge with its operations" $ do+      body <- requireBody "modules/rich" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "## Migrations"+      body `shouldSatisfy` T.isInfixOf "### 0.1.0 → 0.2.0"+      body `shouldSatisfy` T.isInfixOf "- move `old.nix` → `new.nix`"+      body `shouldSatisfy` T.isInfixOf "### 0.2.0 → 0.3.0"+      body `shouldSatisfy` T.isInfixOf "- delete directory `legacy`"+      body `shouldSatisfy` T.isInfixOf "- run `just fmt` in `."++    it "omits sections the module declares nothing for" $ do+      body <- requireBody "modules/base" testOptions wellFormedModel+      body `shouldNotSatisfy` T.isInfixOf "## Migrations"+      body `shouldNotSatisfy` T.isInfixOf "## Removal"+      body `shouldNotSatisfy` T.isInfixOf "## Generation steps"++    it "shows the variable bindings a recipe supplies along each edge" $ do+      body <- requireBody "recipes/rich-recipe" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "(with `license` = `MIT`, `project.name` = `demo`)"++    it "links an entailed edge whose blueprint is in the same registry" $ do+      body <- requireBody "blueprints/rich-blueprint" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "Entails:"+      body `shouldSatisfy` T.isInfixOf "- [other-blueprint](/blueprints/other-blueprint.md) `1.9.0` → `2.0.0`"++    it "labels an entailed edge whose blueprint is outside the registry" $ do+      body <- requireBody "blueprints/rich-blueprint" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "- `kiroku` `1.9.0` → `2.0.0` (declared outside this registry)"++    it "does not turn an out-of-registry entailed edge into a dangling reference" $ do+      (_, problems) <- renderOrFail testOptions richModel+      problems `shouldBe` []++    it "renders blueprint launch preferences and says what overrides them" $ do+      body <- requireBody "blueprints/rich-blueprint" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "## Agent launch"+      body `shouldSatisfy` T.isInfixOf "- provider: `claude`"+      body `shouldSatisfy` T.isInfixOf "- model: `opus`"+      body `shouldSatisfy` T.isInfixOf "- effort: `high`"+      body `shouldSatisfy` T.isInfixOf "SEIHOU_AGENT_*"++    it "renders the version probe command and why it exists" $ do+      body <- requireBody "blueprints/rich-blueprint" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "## Version probe"+      body `shouldSatisfy` T.isInfixOf "```bash\ncabal get-version\n```"+      body `shouldSatisfy` T.isInfixOf "reads no package-manager format"++    it "renders the blueprint tool allowlist" $ do+      body <- requireBody "blueprints/rich-blueprint" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "## Tools"+      body `shouldSatisfy` T.isInfixOf "- `Bash`"++    it "keeps the whole agent prompt, not just its first paragraph" $ do+      body <- requireBody "blueprints/rich-blueprint" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "Upgrade the project."+      body `shouldSatisfy` T.isInfixOf "```text\nUpgrade the project.\n\nBe careful.\n```"++    it "renders command-derived variables" $ do+      body <- requireBody "prompts/rich-prompt" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "## Command variables"+      body+        `shouldSatisfy` T.isInfixOf+          "- `head.sha` — runs `git rev-parse HEAD` in `.`, trimmed, capped at 64 bytes — when `IsSet license`"++    it "renders conditional guidance blocks" $ do+      body <- requireBody "prompts/rich-prompt" testOptions richModel+      body `shouldSatisfy` T.isInfixOf "## Guidance"+      body `shouldSatisfy` T.isInfixOf "### Formatting"+      body `shouldSatisfy` T.isInfixOf "Run the formatter before finishing."+      body `shouldSatisfy` T.isInfixOf "Applies when `Eq license \"MIT\"`."++  describe "registry overview concept" $ do+    it "emits one concept describing the registry itself" $ do+      (concepts, _) <- renderOrFail testOptions wellFormedModel+      sort (Okf.renderConceptId . Okf.conceptIdOf <$> concepts)+        `shouldSatisfy` elem "registry/fixture"++    it "links every artifact from the registry concept, grouped by kind" $ do+      body <- requireBody "registry/fixture" testOptions wellFormedModel+      body `shouldSatisfy` T.isInfixOf "## Modules"+      body `shouldSatisfy` T.isInfixOf "](/modules/base.md)"+      body `shouldSatisfy` T.isInfixOf "## Recipes"+      body `shouldSatisfy` T.isInfixOf "](/recipes/app-recipe.md)"+      body `shouldSatisfy` T.isInfixOf "## Blueprints"+      body `shouldSatisfy` T.isInfixOf "](/blueprints/app-blueprint.md)"+      body `shouldSatisfy` T.isInfixOf "## Prompts"+      body `shouldSatisfy` T.isInfixOf "](/prompts/review.md)"++    it "omits a kind section the registry publishes nothing for" $ do+      body <- requireBody "registry/fixture" testOptions danglingModel+      body `shouldNotSatisfy` T.isInfixOf "## Recipes"++-- | A fixed producer version, so assertions on the stamped actor do not change+-- every time the package version is bumped.+testOptions :: RenderOptions+testOptions =+  RenderOptions+    { producerVersion = "9.9.9",+      generatedAt = Nothing,+      validationProfile = StrictAuthoring,+      profileSource = Nothing,+      enforceProfile = True+    }++-- | Render a model, failing the example rather than pattern-matching partially.+renderOrFail :: RenderOptions -> DocModel -> IO ([Okf.Concept], [BundleValidationError])+renderOrFail opts model =+  case renderDocBundle opts model of     Left errs -> expectationFailure ("Expected render success, got " <> show errs) >> error "unreachable"-    Right (concepts, _) ->-      case Okf.parseConceptId rawId of-        Left err -> expectationFailure ("Bad test concept id: " <> show err) >> error "unreachable"-        Right conceptId ->-          case filter (\concept -> Okf.conceptIdOf concept == conceptId) concepts of-            [concept] -> pure concept-            other -> expectationFailure ("Expected one concept, got " <> show (length other)) >> error "unreachable"+    Right rendered -> pure rendered +-- | The rendered Markdown body of one concept, which is where every section+-- assertion above looks.+requireBody :: T.Text -> RenderOptions -> DocModel -> IO T.Text+requireBody rawId opts model = Okf.serializeConcept <$> requireConcept rawId opts model++requireConcept :: T.Text -> RenderOptions -> DocModel -> IO Okf.Concept+requireConcept rawId opts model = do+  (concepts, _) <- renderOrFail opts model+  case Okf.parseConceptId rawId of+    Left err -> expectationFailure ("Bad test concept id: " <> show err) >> error "unreachable"+    Right conceptId ->+      case filter (\concept -> Okf.conceptIdOf concept == conceptId) concepts of+        [concept] -> pure concept+        other -> expectationFailure ("Expected one concept, got " <> show (length other)) >> error "unreachable"+ isDanglingReference :: BundleValidationError -> Bool isDanglingReference DanglingReference {} = True isDanglingReference _ = False@@ -98,6 +289,55 @@         ]     } +-- | Neither the registry entry nor the module says anything about itself, which+-- is what StrictAuthoring would otherwise reject.+undescribedModel :: DocModel+undescribedModel =+  DocModel+    { repoName = "fixture",+      repoDescription = Nothing,+      entries = [silentEntry Nothing]+    }++-- | The registry entry is silent but the artifact describes itself.+registrySilentModel :: DocModel+registrySilentModel =+  DocModel+    { repoName = "fixture",+      repoDescription = Nothing,+      entries = [silentEntry (Just "the artifact describes itself")]+    }++silentEntry :: Maybe T.Text -> DocEntry+silentEntry artifactDescription =+  DocEntry+    { name = "base",+      kind = DocModuleKind,+      version = Nothing,+      description = Nothing,+      tags = [],+      path = "modules/base",+      artifact = DocModuleArtifact (silentModuleArtifact artifactDescription),+      moduleRefs = [],+      entailedRefs = []+    }++silentModuleArtifact :: Maybe T.Text -> Module+silentModuleArtifact description =+  Module+    { name = ModuleName "base",+      version = Nothing,+      description = description,+      vars = [],+      exports = [],+      prompts = [],+      steps = [],+      commands = [],+      dependencies = [],+      removal = Nothing,+      migrations = []+    }+ invalidIdModel :: DocModel invalidIdModel =   DocModel@@ -118,7 +358,8 @@       tags = ["module"],       path = path,       artifact = DocModuleArtifact (moduleArtifact name refs),-      moduleRefs = refs+      moduleRefs = refs,+      entailedRefs = []     }  moduleArtifact :: T.Text -> [ModuleRef] -> Module@@ -156,7 +397,8 @@               vars = [],               prompts = []             },-      moduleRefs = [ModuleRef "base" True, ModuleRef "app" True]+      moduleRefs = [ModuleRef "base" True, ModuleRef "app" True],+      entailedRefs = []     }  blueprintEntry :: DocEntry@@ -185,7 +427,8 @@               launch = Nothing,               versionProbe = Nothing             },-      moduleRefs = [ModuleRef "base" True]+      moduleRefs = [ModuleRef "base" True],+      entailedRefs = []     }  promptEntry :: DocEntry@@ -213,5 +456,281 @@               launch = Nothing,               guidance = []             },-      moduleRefs = []+      moduleRefs = [],+      entailedRefs = []+    }++-- | A registry whose artifacts declare every feature the renderer now covers,+-- including the four -- entailment, launch preferences, a version probe, and+-- command-derived variables -- that no real registry on this machine exercises.+richModel :: DocModel+richModel =+  DocModel+    { repoName = "fixture",+      repoDescription = Just "Fixture",+      entries = [richModuleEntry, richRecipeEntry, richBlueprintEntry, otherBlueprintEntry, richPromptEntry]+    }++richModuleEntry :: DocEntry+richModuleEntry =+  DocEntry+    { name = "rich",+      kind = DocModuleKind,+      version = Just "0.3.0",+      description = Just "A module that declares everything",+      tags = ["module"],+      path = "modules/rich",+      artifact = DocModuleArtifact richModule,+      moduleRefs = [],+      entailedRefs = []+    }++richModule :: Module+richModule =+  Module+    { name = ModuleName "rich",+      version = Just "0.3.0",+      description = Just "A module that declares everything",+      vars =+        [ VarDecl+            { name = "project.name",+              type_ = VTText,+              default_ = Nothing,+              description = Just "The project name",+              required = True,+              validation = Just (ValPattern "[a-z]+")+            },+          VarDecl+            { name = "license",+              type_ = VTChoice ["MIT", "BSD-3"],+              default_ = Just (VText "MIT"),+              description = Nothing,+              required = False,+              validation = Nothing+            },+          VarDecl+            { name = "retries",+              type_ = VTInt,+              default_ = Nothing,+              description = Nothing,+              required = False,+              validation = Just (ValRange 0 5)+            }+        ],+      exports = [VarExport {var = "project.name", alias = Just "app.name"}],+      prompts =+        [ Prompt+            { var = "license",+              text = "Which license?",+              condition = Just (ExprIsSet "project.name"),+              choices = Just ["MIT", "BSD-3"]+            }+        ],+      steps =+        [ Step+            { strategy = Template,+              src = "flake.nix.tpl",+              dest = "flake.nix",+              condition = Nothing,+              patch = Nothing+            },+          Step+            { strategy = Copy,+              src = "gitignore.tpl",+              dest = ".gitignore",+              condition = Just (ExprEq "license" (VText "MIT")),+              patch = Just AppendLineIfAbsent+            }+        ],+      commands =+        [ Command+            { run = "cabal build",+              workDir = Just "app",+              condition = Just (ExprIsSet "license")+            }+        ],+      dependencies = [],+      removal =+        Just+          Removal+            { steps =+                [ RemovalStep {action = RemoveFileAction, dest = "flake.nix", src = Nothing},+                  RemovalStep {action = RemoveSectionAction, dest = ".gitignore", src = Nothing}+                ],+              commands =+                [Command {run = "rm -rf dist-newstyle", workDir = Nothing, condition = Nothing}]+            },+      migrations =+        [ Migration+            { from = "0.1.0",+              to = "0.2.0",+              ops = [MoveFile {src = "old.nix", dest = "new.nix"}]+            },+          Migration+            { from = "0.2.0",+              to = "0.3.0",+              ops =+                [ DeleteDir {path = "legacy"},+                  RunCommand {run = "just fmt", workDir = Just "."}+                ]+            }+        ]+    }++richRecipeEntry :: DocEntry+richRecipeEntry =+  DocEntry+    { name = "rich-recipe",+      kind = DocRecipeKind,+      version = Nothing,+      description = Just "A recipe that preconfigures its modules",+      tags = [],+      path = "recipes/rich-recipe",+      artifact =+        DocRecipeArtifact+          Recipe+            { name = RecipeName "rich-recipe",+              version = Nothing,+              description = Just "A recipe that preconfigures its modules",+              modules =+                [ Dependency+                    { module_ = ModuleName "rich",+                      vars = Map.fromList [("project.name", "demo"), ("license", "MIT")]+                    }+                ],+              vars = [],+              prompts = []+            },+      moduleRefs = [ModuleRef "rich" True],+      entailedRefs = []+    }++richBlueprintEntry :: DocEntry+richBlueprintEntry =+  DocEntry+    { name = "rich-blueprint",+      kind = DocBlueprintKind,+      version = Nothing,+      description = Just "A blueprint that declares everything",+      tags = [],+      path = "blueprints/rich-blueprint",+      artifact = DocBlueprintArtifact richBlueprint,+      moduleRefs = [],+      -- One entailed edge resolves inside this registry and one does not, which+      -- is the distinction the renderer has to honour.+      entailedRefs =+        [ EntailedRef {blueprint = "other-blueprint", from = "1.9.0", to = "2.0.0", resolved = True},+          EntailedRef {blueprint = "kiroku", from = "1.9.0", to = "2.0.0", resolved = False}+        ]+    }++richBlueprint :: Blueprint+richBlueprint =+  Blueprint+    { name = ModuleName "rich-blueprint",+      version = Nothing,+      description = Just "A blueprint that declares everything",+      prompt = "Upgrade the project.\n\nBe careful.",+      vars = [],+      prompts = [],+      baseModules = [],+      files = [],+      allowedTools = Just ["Bash", "Read"],+      tags = [],+      migrations =+        [ BlueprintMigration+            { from = "2.4.0",+              to = "3.0.0",+              prompt = "Cross the breaking change.",+              entails =+                [ EntailedEdge {blueprint = "other-blueprint", from = "1.9.0", to = "2.0.0"},+                  EntailedEdge {blueprint = "kiroku", from = "1.9.0", to = "2.0.0"}+                ]+            }+        ],+      launch =+        Just+          AgentLaunch+            { provider = Just "claude",+              model = Just "opus",+              effort = Just "high",+              mode = Nothing+            },+      versionProbe = Just "cabal get-version"+    }++-- | The blueprint the rich blueprint entails, so that one entailed edge has a+-- target inside the bundle to link to.+otherBlueprintEntry :: DocEntry+otherBlueprintEntry =+  DocEntry+    { name = "other-blueprint",+      kind = DocBlueprintKind,+      version = Nothing,+      description = Just "The entailed blueprint",+      tags = [],+      path = "blueprints/other-blueprint",+      artifact =+        DocBlueprintArtifact+          Blueprint+            { name = ModuleName "other-blueprint",+              version = Nothing,+              description = Just "The entailed blueprint",+              prompt = "Do the other thing.",+              vars = [],+              prompts = [],+              baseModules = [],+              files = [],+              allowedTools = Nothing,+              tags = [],+              migrations = [],+              launch = Nothing,+              versionProbe = Nothing+            },+      moduleRefs = [],+      entailedRefs = []+    }++richPromptEntry :: DocEntry+richPromptEntry =+  DocEntry+    { name = "rich-prompt",+      kind = DocPromptKind,+      version = Nothing,+      description = Just "A prompt that declares everything",+      tags = [],+      path = "prompts/rich-prompt",+      artifact =+        DocPromptArtifact+          AgentPrompt+            { name = ModuleName "rich-prompt",+              version = Nothing,+              description = Just "A prompt that declares everything",+              prompt = "Review the change.",+              vars = [],+              prompts = [],+              commandVars =+                [ CommandVar+                    { name = "head.sha",+                      run = "git rev-parse HEAD",+                      workDir = Just ".",+                      condition = Just (ExprIsSet "license"),+                      trim = True,+                      maxBytes = Just 64+                    }+                ],+              guidance =+                [ PromptGuidance+                    { title = "Formatting",+                      body = "Run the formatter before finishing.",+                      condition = Just (ExprEq "license" (VText "MIT"))+                    }+                ],+              files = [],+              allowedTools = Nothing,+              tags = [],+              launch = Nothing+            },+      moduleRefs = [],+      entailedRefs = []     }

@@ -1,10 +1,15 @@ module Seihou.OKF.Extension.DocsSpec (tests) where +import Control.Lens ((&), (.~), (?~))+import Data.Generics.Labels () import Data.Text qualified as T+import Data.Text.IO qualified as TIO import Okf.Bundle qualified as Okf+import Okf.Index qualified as Okf import Okf.Validation qualified as Okf+import Seihou.OKF.Docs.Render (builtinProfileDescriptor) import Seihou.OKF.Extension.Docs-import System.Directory (createDirectoryIfMissing, doesFileExist)+import System.Directory (createDirectoryIfMissing, doesFileExist, doesPathExist) import System.FilePath ((</>)) import System.IO.Temp (withSystemTempDirectory) import Test.Hspec@@ -22,32 +27,114 @@         let registryDir = tmpDir </> "registry"             outDir = tmpDir </> "out"         writeFixtureRegistry registryDir-        result <- runDocs DocsOpts {dir = registryDir, out = outDir, force = False}-        result `shouldBe` Right ("Wrote 2 concepts to " <> T.pack outDir)+        result <- runDocs (docsOpts registryDir outDir False)+        result `shouldBe` Right ("Wrote 3 concepts to " <> T.pack outDir)         doesFileExist (outDir </> "modules" </> "base.md") `shouldReturn` True         doesFileExist (outDir </> "recipes" </> "base-recipe.md") `shouldReturn` True+        doesFileExist (outDir </> "index.md") `shouldReturn` True+        rootIndex <- TIO.readFile (outDir </> "index.md")+        rootIndex `shouldSatisfy` T.isInfixOf "okf_version: \"0.2\""+        doesFileExist (outDir </> "modules" </> "index.md") `shouldReturn` True+        doesFileExist (outDir </> "recipes" </> "index.md") `shouldReturn` True+        doesFileExist (outDir </> "registry" </> "fixture-registry.md") `shouldReturn` True+        doesFileExist (outDir </> "profile.dhall") `shouldReturn` True+        writtenProfile <- TIO.readFile (outDir </> "profile.dhall")+        writtenProfile `shouldBe` builtinProfileDescriptor         walked <- Okf.walkBundle outDir         case walked of           Left err -> expectationFailure ("Expected walkBundle success, got " <> show err)-          Right concepts -> Okf.validateBundle Okf.PermissiveConformance concepts `shouldBe` []+          Right concepts ->+            Okf.validateBundle+              Okf.PermissiveConformance+              Okf.VersionUndeclared+              (Okf.bundleInventoryOfConcepts concepts)+              concepts+              `shouldBe` []      it "refuses to overwrite a non-empty output directory without force" $ do       withSystemTempDirectory "seihou-okf-docs-force" $ \tmpDir -> do         let registryDir = tmpDir </> "registry"             outDir = tmpDir </> "out"         writeFixtureRegistry registryDir-        first <- runDocs DocsOpts {dir = registryDir, out = outDir, force = False}-        first `shouldBe` Right ("Wrote 2 concepts to " <> T.pack outDir)-        second <- runDocs DocsOpts {dir = registryDir, out = outDir, force = False}+        first <- runDocs (docsOpts registryDir outDir False)+        first `shouldBe` Right ("Wrote 3 concepts to " <> T.pack outDir)+        second <- runDocs (docsOpts registryDir outDir False)         second `shouldBe` Left ("output directory is not empty: " <> T.pack outDir <> "; pass --force to overwrite")-        forced <- runDocs DocsOpts {dir = registryDir, out = outDir, force = True}-        forced `shouldBe` Right ("Wrote 2 concepts to " <> T.pack outDir)+        forced <- runDocs (docsOpts registryDir outDir True)+        forced `shouldBe` Right ("Wrote 3 concepts to " <> T.pack outDir) +    it "refuses to write a bundle that violates the house profile" $ do+      withSystemTempDirectory "seihou-okf-docs-profile" $ \tmpDir -> do+        let registryDir = tmpDir </> "registry"+            outDir = tmpDir </> "out"+            profilePath = tmpDir </> "demanding.dhall"+        writeFixtureRegistry registryDir+        TIO.writeFile profilePath demandingProfile+        result <-+          runDocs (docsOpts registryDir outDir False & #profile ?~ profilePath)+        case result of+          Right summary -> expectationFailure ("Expected a profile violation, got " <> show summary)+          -- Specifically a violation, not an unreadable or uncompilable+          -- descriptor, which would also mention the house profile.+          Left err -> err `shouldSatisfy` T.isInfixOf "house profile: modules/base: missing required field stale_after"+        -- Nothing at all reached disk: the check runs before the output+        -- directory is even prepared.+        doesPathExist outDir `shouldReturn` False++    it "skips profile enforcement with --no-profile" $ do+      withSystemTempDirectory "seihou-okf-docs-no-profile" $ \tmpDir -> do+        let registryDir = tmpDir </> "registry"+            outDir = tmpDir </> "out"+            profilePath = tmpDir </> "demanding.dhall"+        writeFixtureRegistry registryDir+        TIO.writeFile profilePath demandingProfile+        result <-+          runDocs+            ( docsOpts registryDir outDir False+                & #profile ?~ profilePath+                & #noProfile .~ True+            )+        result `shouldBe` Right ("Wrote 3 concepts to " <> T.pack outDir)++    it "derives its demanding fixture profile from the real descriptor" $ do+      demandingProfile `shouldNotBe` builtinProfileDescriptor+     it "reports a missing registry file" $ do       withSystemTempDirectory "seihou-okf-docs-missing" $ \tmpDir -> do         let registryDir = tmpDir </> "missing"-        result <- runDocs DocsOpts {dir = registryDir, out = tmpDir </> "out", force = False}+        result <- runDocs (docsOpts registryDir (tmpDir </> "out") False)         result `shouldBe` Left ("registry file not found: " <> T.pack (registryDir </> "seihou-registry.dhall"))++-- | The default option set for a fixture run: strict validation, no generation+-- date, so the written bundle is byte-stable across runs.+docsOpts :: FilePath -> FilePath -> Bool -> DocsOpts+docsOpts registryDir outDir force =+  DocsOpts+    { dir = registryDir,+      out = outDir,+      force = force,+      generatedAt = Nothing,+      permissive = False,+      profile = Nothing,+      noProfile = False+    }++-- | The house profile, plus one required frontmatter key the generator never+-- emits, so that enforcement has something real to reject. Derived from the+-- real descriptor rather than hand-written, so it stays a valid profile.+--+-- 'demandingProfileIsDifferent' guards the substitution: if the descriptor is+-- reworded so the anchor no longer matches, that test fails loudly rather than+-- these two silently checking nothing.+demandingProfile :: T.Text+demandingProfile =+  T.replace+    demandingProfileAnchor+    ("[ scalar \"stale_after\" \"A key this generator never emits.\"\n              , scalar \"type\"")+    builtinProfileDescriptor++demandingProfileAnchor :: T.Text+demandingProfileAnchor = "[ scalar \"type\""  writeFixtureRegistry :: FilePath -> IO () writeFixtureRegistry registryDir = do