diff --git a/seihou-okf-extension.cabal b/seihou-okf-extension.cabal --- a/seihou-okf-extension.cabal +++ b/seihou-okf-extension.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-okf-extension -version: 0.13.0.0 +version: 0.14.0.0 synopsis: OKF documentation extension for Seihou registries description: External Seihou extension executable for generating OKF documentation bundles @@ -60,7 +60,7 @@ lens >=5.2 && <6, okf-core ^>=0.10.0.0, optparse-applicative >=0.18 && <1, - seihou-core ^>=0.13.0.0, + seihou-core ^>=0.14.0.0, temporary >=1.3 && <2, text >=2.0 && <3, @@ -118,7 +118,7 @@ hspec >=2.11 && <3, lens >=5.2 && <6, okf-core ^>=0.10.0.0, - seihou-core ^>=0.13.0.0, + seihou-core ^>=0.14.0.0, seihou-okf-extension-internal, tasty >=1.4 && <2, tasty-hspec >=1.2 && <2, diff --git a/src/Seihou/OKF/Docs/Model.hs b/src/Seihou/OKF/Docs/Model.hs --- a/src/Seihou/OKF/Docs/Model.hs +++ b/src/Seihou/OKF/Docs/Model.hs @@ -3,6 +3,7 @@ DocArtifact (..), DocEntry (..), ModuleRef (..), + BaseRecipeRef (..), EntailedRef (..), DocModel (..), DocLoadError (..), @@ -10,7 +11,7 @@ ) where -import Control.Lens ((&), (.~), (^.)) +import Control.Lens ((%~), (&), (.~), (^.)) import Data.Generics.Labels () import Data.Text qualified as T import GHC.Generics (Generic) @@ -23,6 +24,7 @@ Module (..), ModuleLoadError, Recipe (..), + RecipeReference (..), depModuleNames, ) import Seihou.Dhall.Eval @@ -62,6 +64,7 @@ path :: !FilePath, artifact :: !DocArtifact, moduleRefs :: ![ModuleRef], + baseRecipe :: !(Maybe BaseRecipeRef), -- | 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. @@ -69,6 +72,13 @@ } deriving stock (Eq, Generic, Show) +-- | A descriptor-local base edge. Documentation never fetches its source. +data BaseRecipeRef = BaseRecipeRef + { reference :: !RecipeReference, + resolved :: !Bool + } + deriving stock (Eq, Generic, Show) + data ModuleRef = ModuleRef { name :: !T.Text, resolved :: !Bool @@ -130,8 +140,9 @@ pure $ do entries <- entriesResult let moduleNames = [entry ^. #name | entry <- entries, entry ^. #kind == DocModuleKind] + recipeNames = [entry ^. #name | entry <- entries, entry ^. #kind == DocRecipeKind] blueprintNames = [entry ^. #name | entry <- entries, entry ^. #kind == DocBlueprintKind] - resolvedEntries = map (resolveEntryRefs moduleNames blueprintNames) entries + resolvedEntries = map (resolveEntryRefs moduleNames recipeNames blueprintNames) entries Right DocModel { repoName = repoName, @@ -230,6 +241,9 @@ path = entry ^. #path, artifact = artifact, moduleRefs = refs, + baseRecipe = case artifact of + DocRecipeArtifact recipe -> (\ref -> BaseRecipeRef ref False) <$> recipe ^. #extends + _ -> Nothing, entailedRefs = entailed } @@ -254,10 +268,11 @@ -- | 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 = +resolveEntryRefs :: [T.Text] -> [T.Text] -> [T.Text] -> DocEntry -> DocEntry +resolveEntryRefs moduleNames recipeNames blueprintNames entry = entry & #moduleRefs .~ [ref & #resolved .~ ((ref ^. #name) `elem` moduleNames) | ref <- entry ^. #moduleRefs] + & #baseRecipe %~ fmap (\ref -> ref & #resolved .~ ((ref ^. #reference . #recipe . #unRecipeName) `elem` recipeNames && ref ^. #reference . #source == Nothing)) & #entailedRefs .~ [ref & #resolved .~ ((ref ^. #blueprint) `elem` blueprintNames) | ref <- entry ^. #entailedRefs] renderModuleLoadError :: ModuleLoadError -> T.Text diff --git a/src/Seihou/OKF/Docs/Render.hs b/src/Seihou/OKF/Docs/Render.hs --- a/src/Seihou/OKF/Docs/Render.hs +++ b/src/Seihou/OKF/Docs/Render.hs @@ -62,6 +62,7 @@ Prompt (..), PromptGuidance (..), Recipe (..), + RecipeReference (..), Removal (..), RemovalAction (..), RemovalStep (..), @@ -421,10 +422,14 @@ <> 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)] + DocRecipeArtifact Recipe {modules = recipeModules, vars, prompts, extends, moduleOverrides, promptOverrides} -> + foldMap (\ref -> [section "Extends" (renderRecipeBase entry ref)]) extends + <> [section "Composes" (renderDependencies (maybe "This recipe does not compose any modules." (const "Uses its inherited members without adding modules.") extends) recipeModules)] + <> optionalSection "Inherited module overrides" (T.unlines ["- `" <> (override ^. #module_ . #unModuleName) <> "`" <> renderSuppliedVars (override ^. #vars) | override <- moduleOverrides]) + <> [section "Override rules" "The oldest base supplies the primary module. Child literals override ancestor literals globally by variable name; defaults remain fallbacks. Explicit module overrides replace selected keys without adding instances. Prompt overrides replace inherited questions in place; new prompts append." | extends /= Nothing] <> optionalSection "Variables" (renderVarDecls' vars) <> optionalSection "Prompts" (renderPrompts prompts) + <> optionalSection "Inherited prompt overrides" (renderPrompts promptOverrides) 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) @@ -466,6 +471,18 @@ resolvedEntailedBlueprints :: DocEntry -> [T.Text] resolvedEntailedBlueprints entry = [ref ^. #blueprint | ref <- entry ^. #entailedRefs, ref ^. #resolved] + +renderRecipeBase :: DocEntry -> RecipeReference -> T.Text +renderRecipeBase entry ref = + let name = ref ^. #recipe . #unRecipeName + linked = case entry ^. #baseRecipe of + Just base | base ^. #resolved -> case conceptIdFor DocRecipeKind name of + Right conceptId -> renderConceptLink conceptId name + Left _ -> "`" <> name <> "`" + _ -> "`" <> name <> "`" + source = maybe " (declaring registry)" (\url -> " from `" <> url <> "`") (ref ^. #source) + interval = maybe "" (\range -> "; version >= `" <> range ^. #minimum <> "` and < `" <> range ^. #before <> "`") (ref ^. #versionRange) + in linked <> source <> interval <> ". Selected from the source's default-branch HEAD; no historical tag search." renderDependencies :: T.Text -> [Dependency] -> T.Text renderDependencies emptyMessage [] = emptyMessage diff --git a/test/Seihou/OKF/Docs/ModelSpec.hs b/test/Seihou/OKF/Docs/ModelSpec.hs --- a/test/Seihou/OKF/Docs/ModelSpec.hs +++ b/test/Seihou/OKF/Docs/ModelSpec.hs @@ -5,6 +5,7 @@ import Data.List (find) import Data.Maybe (fromMaybe) import Data.Text qualified as T +import Data.Text.IO qualified as TIO import Seihou.OKF.Docs.Model import System.Directory (createDirectoryIfMissing) import System.FilePath (()) @@ -56,6 +57,18 @@ blueprint = requireEntry "app-blueprint" model (recipe ^. #moduleRefs) `shouldMatchList` [ModuleRef "base" True, ModuleRef "app" True] (blueprint ^. #moduleRefs) `shouldBe` [ModuleRef "base" True] + + it "retains an external base reference without fetching it or requiring installed members" $ + withFixtureRegistry $ \registryDir -> do + let path = registryDir "recipes/app-recipe/recipe.dhall" + TIO.writeFile path ("(" <> T.pack recipeDhall <> ") // {extends=Some {recipe=\"external\",source=Some \"https://example.invalid/base.git\",versionRange=Some {minimum=\"1\",before=\"2\"}}}") + model <- shouldLoad registryDir + case requireEntry "app-recipe" model ^. #baseRecipe of + Nothing -> expectationFailure "missing base relationship" + Just base -> do + base ^. #resolved `shouldBe` False + base ^. #reference . #source `shouldBe` Just "https://example.invalid/base.git" + base ^. #reference . #recipe `shouldBe` "external" it "resolves an entailed edge naming a blueprint in the same registry" $ do withFixtureRegistry $ \registryDir -> do diff --git a/test/Seihou/OKF/Docs/RenderSpec.hs b/test/Seihou/OKF/Docs/RenderSpec.hs --- a/test/Seihou/OKF/Docs/RenderSpec.hs +++ b/test/Seihou/OKF/Docs/RenderSpec.hs @@ -1,6 +1,6 @@ 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 @@ -155,6 +155,29 @@ body <- requireBody "recipes/rich-recipe" testOptions richModel body `shouldSatisfy` T.isInfixOf "(with `license` = `MIT`, `project.name` = `demo`)" + it "documents an external settings-only base and explicit overrides without dangling links" $ do + let ref = RecipeReference "external-base" (Just "https://example.test/base.git") (Just (RecipeVersionRange "1" "2")) + model = derivedModel ref False + (concepts, problems) <- renderOrFail testOptions model + problems `shouldBe` [] + body <- requireBody "recipes/app-recipe" testOptions model + body `shouldSatisfy` T.isInfixOf "## Extends" + body `shouldSatisfy` T.isInfixOf "`external-base` from `https://example.test/base.git`" + body `shouldSatisfy` T.isInfixOf "version >= `1` and < `2`" + body `shouldSatisfy` T.isInfixOf "Uses its inherited members without adding modules." + body `shouldSatisfy` T.isInfixOf "`external-member` (with `license` = `MIT`)" + body `shouldSatisfy` T.isInfixOf "## Inherited prompt overrides" + body `shouldNotSatisfy` T.isInfixOf "does not compose any modules" + length concepts `shouldBe` length (wellFormedModel ^. #entries) + 1 + + it "links a base known to be in the same registry" $ do + let parent = recipeEntry & #name .~ "parent" & #path .~ "recipes/parent" + model = derivedModel (RecipeReference "parent" Nothing Nothing) True & #entries %~ (<> [parent]) + (_, problems) <- renderOrFail testOptions model + problems `shouldBe` [] + body <- requireBody "recipes/app-recipe" testOptions model + body `shouldSatisfy` T.isInfixOf "[parent](/recipes/parent.md)" + 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:" @@ -319,6 +342,7 @@ path = "modules/base", artifact = DocModuleArtifact (silentModuleArtifact artifactDescription), moduleRefs = [], + baseRecipe = Nothing, entailedRefs = [] } @@ -359,6 +383,7 @@ path = path, artifact = DocModuleArtifact (moduleArtifact name refs), moduleRefs = refs, + baseRecipe = Nothing, entailedRefs = [] } @@ -395,9 +420,13 @@ description = Just "Recipe", modules = [simpleDep "base", simpleDep "app"], vars = [], - prompts = [] + prompts = [], + extends = Nothing, + moduleOverrides = [], + promptOverrides = [] }, moduleRefs = [ModuleRef "base" True, ModuleRef "app" True], + baseRecipe = Nothing, entailedRefs = [] } @@ -428,6 +457,7 @@ versionProbe = Nothing }, moduleRefs = [ModuleRef "base" True], + baseRecipe = Nothing, entailedRefs = [] } @@ -457,6 +487,7 @@ guidance = [] }, moduleRefs = [], + baseRecipe = Nothing, entailedRefs = [] } @@ -482,6 +513,7 @@ path = "modules/rich", artifact = DocModuleArtifact richModule, moduleRefs = [], + baseRecipe = Nothing, entailedRefs = [] } @@ -603,9 +635,13 @@ } ], vars = [], - prompts = [] + prompts = [], + extends = Nothing, + moduleOverrides = [], + promptOverrides = [] }, moduleRefs = [ModuleRef "rich" True], + baseRecipe = Nothing, entailedRefs = [] } @@ -622,6 +658,7 @@ moduleRefs = [], -- One entailed edge resolves inside this registry and one does not, which -- is the distinction the renderer has to honour. + baseRecipe = Nothing, 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} @@ -692,6 +729,7 @@ versionProbe = Nothing }, moduleRefs = [], + baseRecipe = Nothing, entailedRefs = [] } @@ -736,5 +774,17 @@ launch = Nothing }, moduleRefs = [], + baseRecipe = Nothing, entailedRefs = [] } + +derivedModel :: RecipeReference -> Bool -> DocModel +derivedModel reference resolved = wellFormedModel & #entries %~ map derive + where + derive entry = case entry ^. #artifact of + DocRecipeArtifact recipe -> + entry + & #artifact .~ DocRecipeArtifact (recipe & #modules .~ [] & #extends .~ Just reference & #moduleOverrides .~ [RecipeModuleOverride "external-member" (Map.singleton "license" "MIT")] & #promptOverrides .~ [Prompt "license" "Choose a license" Nothing Nothing]) + & #moduleRefs .~ [] + & #baseRecipe .~ Just (BaseRecipeRef reference resolved) + _ -> entry