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.5.0.0 +version: 0.6.0.0 synopsis: OKF documentation extension for Seihou registries description: External Seihou extension executable for generating OKF documentation bundles @@ -24,10 +24,10 @@ library seihou-okf-extension-internal default-language: GHC2024 default-extensions: + DeriveAnyClass DuplicateRecordFields NoFieldSelectors OverloadedLabels - OverloadedRecordDot OverloadedStrings TypeFamilies @@ -44,19 +44,21 @@ base >=4.18 && <5, directory >=1.3 && <2, filepath >=1.4 && <2, + generic-lens >=2.2 && <3, + lens >=5.2 && <6, okf-core ^>=0.1.2.0, optparse-applicative >=0.18 && <1, - seihou-core ^>=0.5.0.0, + seihou-core ^>=0.6.0.0, text >=2.0 && <3, executable seihou-okf-extension default-language: GHC2024 ghc-options: -threaded default-extensions: + DeriveAnyClass DuplicateRecordFields NoFieldSelectors OverloadedLabels - OverloadedRecordDot OverloadedStrings TypeFamilies @@ -64,16 +66,18 @@ main-is: Main.hs build-depends: base >=4.18 && <5, + generic-lens >=2.2 && <3, + lens >=5.2 && <6, seihou-okf-extension-internal, test-suite seihou-okf-extension-test type: exitcode-stdio-1.0 default-language: GHC2024 default-extensions: + DeriveAnyClass DuplicateRecordFields NoFieldSelectors OverloadedLabels - OverloadedRecordDot OverloadedStrings TypeFamilies @@ -89,9 +93,11 @@ containers >=0.6 && <1, directory >=1.3 && <2, filepath >=1.4 && <2, + generic-lens >=2.2 && <3, hspec >=2.11 && <3, + lens >=5.2 && <6, okf-core ^>=0.1.2.0, - seihou-core ^>=0.5.0.0, + seihou-core ^>=0.6.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 @@ -9,7 +9,10 @@ ) where +import Control.Lens ((&), (.~), (^.)) +import Data.Generics.Labels () import Data.Text qualified as T +import GHC.Generics (Generic) import Seihou.Core.Registry (Registry (..), RegistryEntry (..)) import Seihou.Core.Types ( AgentPrompt, @@ -47,29 +50,29 @@ deriving stock (Eq, Show) data DocEntry = DocEntry - { entryName :: T.Text, - entryKind :: DocKind, - entryVersion :: Maybe T.Text, - entryDescription :: Maybe T.Text, - entryTags :: [T.Text], - entryPath :: FilePath, - entryArtifact :: DocArtifact, - entryModuleRefs :: [ModuleRef] + { name :: !T.Text, + kind :: !DocKind, + version :: !(Maybe T.Text), + description :: !(Maybe T.Text), + tags :: ![T.Text], + path :: !FilePath, + artifact :: !DocArtifact, + moduleRefs :: ![ModuleRef] } - deriving stock (Eq, Show) + deriving stock (Eq, Generic, Show) data ModuleRef = ModuleRef - { refName :: T.Text, - refResolved :: Bool + { name :: !T.Text, + resolved :: !Bool } - deriving stock (Eq, Show) + deriving stock (Eq, Generic, Show) data DocModel = DocModel - { docRepoName :: T.Text, - docRepoDescription :: Maybe T.Text, - docEntries :: [DocEntry] + { repoName :: !T.Text, + repoDescription :: !(Maybe T.Text), + entries :: ![DocEntry] } - deriving stock (Eq, Show) + deriving stock (Eq, Generic, Show) data DocLoadError = RegistryNotFound FilePath @@ -102,13 +105,13 @@ ] pure $ do entries <- entriesResult - let moduleNames = [entry.entryName | entry <- entries, entry.entryKind == DocModuleKind] + let moduleNames = [entry ^. #name | entry <- entries, entry ^. #kind == DocModuleKind] resolvedEntries = map (resolveEntryRefs moduleNames) entries Right DocModel - { docRepoName = repoName, - docRepoDescription = repoDescription, - docEntries = resolvedEntries + { repoName = repoName, + repoDescription = repoDescription, + entries = resolvedEntries } loadEntries :: (RegistryEntry -> IO (Either DocLoadError DocEntry)) -> [RegistryEntry] -> IO (Either DocLoadError [DocEntry]) @@ -133,10 +136,10 @@ loadModuleEntry :: FilePath -> RegistryEntry -> IO (Either DocLoadError DocEntry) loadModuleEntry registryDir entry = do - let artifactFile = registryDir entry.path "module.dhall" + let artifactFile = registryDir entry ^. #path "module.dhall" result <- evalModuleFromFile artifactFile pure $ case result of - Left err -> Left (ArtifactLoadFailed entry.name.unModuleName (renderModuleLoadError err)) + Left err -> Left (ArtifactLoadFailed (entry ^. #name . #unModuleName) (renderModuleLoadError err)) Right artifact@Module {dependencies} -> Right $ docEntryFromRegistry @@ -147,10 +150,10 @@ loadRecipeEntry :: FilePath -> RegistryEntry -> IO (Either DocLoadError DocEntry) loadRecipeEntry registryDir entry = do - let artifactFile = registryDir entry.path "recipe.dhall" + let artifactFile = registryDir entry ^. #path "recipe.dhall" result <- evalRecipeFromFile artifactFile pure $ case result of - Left err -> Left (ArtifactLoadFailed entry.name.unModuleName (renderModuleLoadError err)) + Left err -> Left (ArtifactLoadFailed (entry ^. #name . #unModuleName) (renderModuleLoadError err)) Right artifact@Recipe {modules = recipeModules} -> Right $ docEntryFromRegistry @@ -161,10 +164,10 @@ loadBlueprintEntry :: FilePath -> RegistryEntry -> IO (Either DocLoadError DocEntry) loadBlueprintEntry registryDir entry = do - let artifactFile = registryDir entry.path "blueprint.dhall" + let artifactFile = registryDir entry ^. #path "blueprint.dhall" result <- evalBlueprintFromFile artifactFile pure $ case result of - Left err -> Left (ArtifactLoadFailed entry.name.unModuleName (renderModuleLoadError err)) + Left err -> Left (ArtifactLoadFailed (entry ^. #name . #unModuleName) (renderModuleLoadError err)) Right artifact@Blueprint {baseModules} -> Right $ docEntryFromRegistry @@ -175,10 +178,10 @@ loadPromptEntry :: FilePath -> RegistryEntry -> IO (Either DocLoadError DocEntry) loadPromptEntry registryDir entry = do - let artifactFile = registryDir entry.path "prompt.dhall" + let artifactFile = registryDir entry ^. #path "prompt.dhall" result <- evalAgentPromptFromFile artifactFile pure $ case result of - Left err -> Left (ArtifactLoadFailed entry.name.unModuleName (renderModuleLoadError err)) + Left err -> Left (ArtifactLoadFailed (entry ^. #name . #unModuleName) (renderModuleLoadError err)) Right artifact -> Right $ docEntryFromRegistry @@ -190,30 +193,26 @@ docEntryFromRegistry :: RegistryEntry -> DocKind -> DocArtifact -> [ModuleRef] -> DocEntry docEntryFromRegistry entry kind artifact refs = DocEntry - { entryName = entry.name.unModuleName, - entryKind = kind, - entryVersion = entry.version, - entryDescription = entry.description, - entryTags = entry.tags, - entryPath = entry.path, - entryArtifact = artifact, - entryModuleRefs = refs + { name = entry ^. #name . #unModuleName, + kind = kind, + version = entry ^. #version, + description = entry ^. #description, + tags = entry ^. #tags, + path = entry ^. #path, + artifact = artifact, + moduleRefs = refs } moduleRefs :: [Dependency] -> [ModuleRef] moduleRefs dependencies = - [ ModuleRef {refName = moduleName.unModuleName, refResolved = False} + [ ModuleRef {name = moduleName ^. #unModuleName, resolved = False} | moduleName <- depModuleNames dependencies ] resolveEntryRefs :: [T.Text] -> DocEntry -> DocEntry resolveEntryRefs moduleNames entry = entry - { entryModuleRefs = - [ ref {refResolved = ref.refName `elem` moduleNames} - | ref <- entry.entryModuleRefs - ] - } + & #moduleRefs .~ [ref & #resolved .~ ((ref ^. #name) `elem` moduleNames) | ref <- entry ^. #moduleRefs] renderModuleLoadError :: ModuleLoadError -> T.Text renderModuleLoadError = T.pack . show 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 @@ -7,9 +7,11 @@ ) where +import Control.Lens ((^.)) import Data.Aeson (Value (..)) import Data.Bifunctor (first) import Data.Either (partitionEithers) +import Data.Generics.Labels () import Data.Text qualified as T import Okf.Bundle (Concept, conceptFromDocument, writeBundle) import Okf.ConceptId (ConceptId, parseConceptId, renderConceptLink) @@ -42,7 +44,7 @@ renderDocBundle :: DocModel -> Either [DocRenderError] ([Concept], [BundleValidationError]) renderDocBundle model = - case partitionEithers (conceptFor model.docRepoName <$> model.docEntries) of + case partitionEithers (conceptFor (model ^. #repoName) <$> model ^. #entries) of ([], concepts) -> Right (concepts, validateBundle PermissiveConformance concepts) (errors, _) -> @@ -62,9 +64,9 @@ conceptFor :: T.Text -> DocEntry -> Either DocRenderError Concept conceptFor repoName entry = - case conceptIdFor entry.entryKind entry.entryName of + case conceptIdFor (entry ^. #kind) (entry ^. #name) of Left err -> - Left (InvalidDocConceptId entry.entryKind entry.entryName err) + Left (InvalidDocConceptId (entry ^. #kind) (entry ^. #name) err) Right conceptId -> Right (conceptFromDocument conceptId (documentFor repoName entry)) @@ -77,22 +79,22 @@ frontmatterFor :: T.Text -> DocEntry -> Okf.Frontmatter frontmatterFor repoName entry = maybeSetVersion - . Okf.setTags entry.entryTags + . Okf.setTags (entry ^. #tags) . Okf.setResource (resourceFor repoName entry) $ Okf.okfCommon Okf.OkfCommon - { Okf.commonType = typeFor entry.entryKind, - Okf.commonTitle = Just entry.entryName, - Okf.commonDescription = entry.entryDescription, + { Okf.commonType = typeFor (entry ^. #kind), + Okf.commonTitle = Just (entry ^. #name), + Okf.commonDescription = entry ^. #description, Okf.commonTimestamp = Nothing } where maybeSetVersion = - maybe id (\version -> Okf.setField "version" (String version)) entry.entryVersion + maybe id (\version -> Okf.setField "version" (String version)) (entry ^. #version) resourceFor :: T.Text -> DocEntry -> T.Text resourceFor repoName entry = - "seihou://" <> repoName <> "/" <> T.pack entry.entryPath + "seihou://" <> repoName <> "/" <> T.pack (entry ^. #path) bodyFor :: DocEntry -> T.Text bodyFor entry = @@ -105,23 +107,23 @@ baseSections :: DocEntry -> [T.Text] baseSections entry = - [ "# " <> entry.entryName, - maybe "No description provided." id entry.entryDescription + [ "# " <> entry ^. #name, + maybe "No description provided." id (entry ^. #description) ] - <> foldMap (\version -> ["**Version:** " <> version]) entry.entryVersion + <> foldMap (\version -> ["**Version:** " <> version]) (entry ^. #version) kindSections :: DocEntry -> [T.Text] kindSections entry = - case entry.entryArtifact of + case entry ^. #artifact of DocModuleArtifact Module {vars, exports} -> - [ "## Dependencies\n\n" <> renderModuleRefs "This module has no dependencies." entry.entryModuleRefs, + [ "## 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.entryModuleRefs] + ["## 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.entryModuleRefs, + [ "## 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 ] @@ -135,7 +137,7 @@ renderModuleRefs emptyMessage refs = case refs of [] -> emptyMessage - _ -> T.unlines ["- " <> moduleLink ref.refName | ref <- refs] + _ -> T.unlines ["- " <> moduleLink (ref ^. #name) | ref <- refs] moduleLink :: T.Text -> T.Text moduleLink name = diff --git a/src/Seihou/OKF/Extension/Docs.hs b/src/Seihou/OKF/Extension/Docs.hs --- a/src/Seihou/OKF/Extension/Docs.hs +++ b/src/Seihou/OKF/Extension/Docs.hs @@ -6,9 +6,12 @@ ) where +import Control.Lens ((^.)) import Control.Monad (when) +import Data.Generics.Labels () import Data.Text qualified as T import Data.Text.IO qualified as TIO +import GHC.Generics (Generic) import Okf.ConceptId qualified as Okf import Okf.Validation (BundleValidationError (..), ValidationError (..)) import Seihou.OKF.Docs.Model @@ -26,15 +29,15 @@ import System.IO (stderr) data DocsOpts = DocsOpts - { docsDir :: FilePath, - docsOut :: FilePath, - docsForce :: Bool + { dir :: !FilePath, + out :: !FilePath, + force :: !Bool } - deriving stock (Eq, Show) + deriving stock (Eq, Generic, Show) runDocs :: DocsOpts -> IO (Either T.Text T.Text) runDocs opts = do - let registryFile = opts.docsDir "seihou-registry.dhall" + let registryFile = opts ^. #dir "seihou-registry.dhall" registryExists <- doesFileExist registryFile if not registryExists then pure (Left ("registry file not found: " <> T.pack registryFile)) @@ -43,7 +46,7 @@ case outputCheck of Left err -> pure (Left err) Right () -> do - modelResult <- loadDocModel opts.docsDir + modelResult <- loadDocModel (opts ^. #dir) case modelResult of Left err -> pure (Left (renderDocLoadError err)) Right model -> @@ -54,11 +57,11 @@ | not (null validationProblems) -> pure (Left (renderMany renderBundleValidationError validationProblems)) | otherwise -> do - prepareOutputDirectory opts.docsOut - writeResult <- writeDocBundle opts.docsOut model + 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.docsOut) + Right () -> Right ("Wrote " <> T.pack (show (length concepts)) <> " concepts to " <> T.pack (opts ^. #out)) handleDocs :: DocsOpts -> IO () handleDocs opts = do @@ -72,18 +75,18 @@ checkOutputDirectory :: DocsOpts -> IO (Either T.Text ()) checkOutputDirectory opts = do - pathExists <- doesPathExist opts.docsOut + pathExists <- doesPathExist (opts ^. #out) if not pathExists then pure (Right ()) else do - isDirectory <- doesDirectoryExist opts.docsOut + isDirectory <- doesDirectoryExist (opts ^. #out) if not isDirectory - then pure (Left ("output path exists and is not a directory: " <> T.pack opts.docsOut)) + then pure (Left ("output path exists and is not a directory: " <> T.pack (opts ^. #out))) else do - entries <- listDirectory opts.docsOut - if null entries || opts.docsForce + entries <- listDirectory (opts ^. #out) + if null entries || opts ^. #force then pure (Right ()) - else pure (Left ("output directory is not empty: " <> T.pack opts.docsOut <> "; pass --force to overwrite")) + else pure (Left ("output directory is not empty: " <> T.pack (opts ^. #out) <> "; pass --force to overwrite")) prepareOutputDirectory :: FilePath -> IO () prepareOutputDirectory outDir = do 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 @@ -1,5 +1,7 @@ module Seihou.OKF.Docs.ModelSpec (tests) where +import Control.Lens ((^.)) +import Data.Generics.Labels () import Data.List (find) import Data.Maybe (fromMaybe) import Data.Text qualified as T @@ -20,7 +22,7 @@ it "loads all four registry entry kinds from a fixture registry" $ do withFixtureRegistry $ \registryDir -> do model <- shouldLoad registryDir - model.docRepoName `shouldBe` "fixture-registry" + (model ^. #repoName) `shouldBe` "fixture-registry" length (entriesByKind DocModuleKind model) `shouldBe` 3 length (entriesByKind DocRecipeKind model) `shouldBe` 1 length (entriesByKind DocBlueprintKind model) `shouldBe` 1 @@ -30,30 +32,30 @@ withFixtureRegistry $ \registryDir -> do model <- shouldLoad registryDir let entry = requireEntry "app" model - entry.entryVersion `shouldBe` Just "1.2.3" - entry.entryDescription `shouldBe` Just "Application module" - entry.entryTags `shouldBe` ["haskell", "app"] - entry.entryPath `shouldBe` "modules/app" + (entry ^. #version) `shouldBe` Just "1.2.3" + (entry ^. #description) `shouldBe` Just "Application module" + (entry ^. #tags) `shouldBe` ["haskell", "app"] + (entry ^. #path) `shouldBe` "modules/app" it "marks module dependencies that resolve inside the registry" $ do withFixtureRegistry $ \registryDir -> do model <- shouldLoad registryDir let entry = requireEntry "app" model - entry.entryModuleRefs `shouldContain` [ModuleRef "base" True] + (entry ^. #moduleRefs) `shouldContain` [ModuleRef "base" True] it "marks module dependencies that do not resolve inside the registry" $ do withFixtureRegistry $ \registryDir -> do model <- shouldLoad registryDir let entry = requireEntry "dangling" model - entry.entryModuleRefs `shouldBe` [ModuleRef "missing" False] + (entry ^. #moduleRefs) `shouldBe` [ModuleRef "missing" False] it "captures recipe and blueprint module references" $ do withFixtureRegistry $ \registryDir -> do model <- shouldLoad registryDir let recipe = requireEntry "app-recipe" model blueprint = requireEntry "app-blueprint" model - recipe.entryModuleRefs `shouldMatchList` [ModuleRef "base" True, ModuleRef "app" True] - blueprint.entryModuleRefs `shouldBe` [ModuleRef "base" True] + (recipe ^. #moduleRefs) `shouldMatchList` [ModuleRef "base" True, ModuleRef "app" True] + (blueprint ^. #moduleRefs) `shouldBe` [ModuleRef "base" True] it "returns RegistryNotFound when the registry file is absent" $ do withSystemTempDirectory "seihou-doc-model-missing" $ \registryDir -> do @@ -71,12 +73,12 @@ entriesByKind :: DocKind -> DocModel -> [DocEntry] entriesByKind kind model = - filter (\entry -> entry.entryKind == kind) model.docEntries + filter (\entry -> entry ^. #kind == kind) (model ^. #entries) requireEntry :: String -> DocModel -> DocEntry requireEntry name model = fromMaybe (error ("missing entry " <> name)) $ - find (\entry -> entry.entryName == T.pack name) model.docEntries + find (\entry -> entry ^. #name == T.pack name) (model ^. #entries) withFixtureRegistry :: (FilePath -> IO a) -> IO a withFixtureRegistry action = 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,5 +1,7 @@ module Seihou.OKF.Docs.RenderSpec (tests) where +import Control.Lens ((^.)) +import Data.Generics.Labels () import Data.List (sort) import Data.Map.Strict qualified as Map import Data.Text qualified as T @@ -75,9 +77,9 @@ wellFormedModel :: DocModel wellFormedModel = DocModel - { docRepoName = "fixture", - docRepoDescription = Just "Fixture", - docEntries = + { repoName = "fixture", + repoDescription = Just "Fixture", + entries = [ moduleEntry "base" [] "modules/base", moduleEntry "app" [ModuleRef "base" True] "modules/app", recipeEntry, @@ -89,9 +91,9 @@ danglingModel :: DocModel danglingModel = DocModel - { docRepoName = "fixture", - docRepoDescription = Nothing, - docEntries = + { repoName = "fixture", + repoDescription = Nothing, + entries = [ moduleEntry "app" [ModuleRef "missing" False] "modules/app" ] } @@ -99,9 +101,9 @@ invalidIdModel :: DocModel invalidIdModel = DocModel - { docRepoName = "fixture", - docRepoDescription = Nothing, - docEntries = + { repoName = "fixture", + repoDescription = Nothing, + entries = [ moduleEntry "-bad" [] "modules/bad" ] } @@ -109,14 +111,14 @@ moduleEntry :: T.Text -> [ModuleRef] -> FilePath -> DocEntry moduleEntry name refs path = DocEntry - { entryName = name, - entryKind = DocModuleKind, - entryVersion = Just "1.0.0", - entryDescription = Just (name <> " module"), - entryTags = ["module"], - entryPath = path, - entryArtifact = DocModuleArtifact (moduleArtifact name refs), - entryModuleRefs = refs + { name = name, + kind = DocModuleKind, + version = Just "1.0.0", + description = Just (name <> " module"), + tags = ["module"], + path = path, + artifact = DocModuleArtifact (moduleArtifact name refs), + moduleRefs = refs } moduleArtifact :: T.Text -> [ModuleRef] -> Module @@ -130,7 +132,7 @@ prompts = [], steps = [], commands = [], - dependencies = [Dependency (ModuleName ref.refName) Map.empty | ref <- refs], + dependencies = [Dependency (ModuleName (ref ^. #name)) Map.empty | ref <- refs], removal = Nothing, migrations = [] } @@ -138,13 +140,13 @@ recipeEntry :: DocEntry recipeEntry = DocEntry - { entryName = "app-recipe", - entryKind = DocRecipeKind, - entryVersion = Just "0.1.0", - entryDescription = Just "Recipe", - entryTags = ["recipe"], - entryPath = "recipes/app-recipe", - entryArtifact = + { name = "app-recipe", + kind = DocRecipeKind, + version = Just "0.1.0", + description = Just "Recipe", + tags = ["recipe"], + path = "recipes/app-recipe", + artifact = DocRecipeArtifact Recipe { name = RecipeName "app-recipe", @@ -154,19 +156,19 @@ vars = [], prompts = [] }, - entryModuleRefs = [ModuleRef "base" True, ModuleRef "app" True] + moduleRefs = [ModuleRef "base" True, ModuleRef "app" True] } blueprintEntry :: DocEntry blueprintEntry = DocEntry - { entryName = "app-blueprint", - entryKind = DocBlueprintKind, - entryVersion = Just "0.1.0", - entryDescription = Just "Blueprint", - entryTags = ["blueprint"], - entryPath = "blueprints/app-blueprint", - entryArtifact = + { name = "app-blueprint", + kind = DocBlueprintKind, + version = Just "0.1.0", + description = Just "Blueprint", + tags = ["blueprint"], + path = "blueprints/app-blueprint", + artifact = DocBlueprintArtifact Blueprint { name = ModuleName "app-blueprint", @@ -179,21 +181,22 @@ files = [], allowedTools = Nothing, tags = ["blueprint"], - migrations = [] + migrations = [], + launch = Nothing }, - entryModuleRefs = [ModuleRef "base" True] + moduleRefs = [ModuleRef "base" True] } promptEntry :: DocEntry promptEntry = DocEntry - { entryName = "review", - entryKind = DocPromptKind, - entryVersion = Just "0.1.0", - entryDescription = Just "Review prompt", - entryTags = ["prompt"], - entryPath = "prompts/review", - entryArtifact = + { name = "review", + kind = DocPromptKind, + version = Just "0.1.0", + description = Just "Review prompt", + tags = ["prompt"], + path = "prompts/review", + artifact = DocPromptArtifact AgentPrompt { name = ModuleName "review", @@ -206,7 +209,8 @@ files = [], allowedTools = Nothing, tags = ["prompt"], - launch = Nothing + launch = Nothing, + guidance = [] }, - entryModuleRefs = [] + moduleRefs = [] } diff --git a/test/Seihou/OKF/Extension/DocsSpec.hs b/test/Seihou/OKF/Extension/DocsSpec.hs --- a/test/Seihou/OKF/Extension/DocsSpec.hs +++ b/test/Seihou/OKF/Extension/DocsSpec.hs @@ -22,7 +22,7 @@ let registryDir = tmpDir "registry" outDir = tmpDir "out" writeFixtureRegistry registryDir - result <- runDocs DocsOpts {docsDir = registryDir, docsOut = outDir, docsForce = False} + result <- runDocs DocsOpts {dir = registryDir, out = outDir, force = False} result `shouldBe` Right ("Wrote 2 concepts to " <> T.pack outDir) doesFileExist (outDir "modules" "base.md") `shouldReturn` True doesFileExist (outDir "recipes" "base-recipe.md") `shouldReturn` True @@ -36,17 +36,17 @@ let registryDir = tmpDir "registry" outDir = tmpDir "out" writeFixtureRegistry registryDir - first <- runDocs DocsOpts {docsDir = registryDir, docsOut = outDir, docsForce = False} + first <- runDocs DocsOpts {dir = registryDir, out = outDir, force = False} first `shouldBe` Right ("Wrote 2 concepts to " <> T.pack outDir) - second <- runDocs DocsOpts {docsDir = registryDir, docsOut = outDir, docsForce = False} + second <- runDocs DocsOpts {dir = registryDir, out = outDir, force = False} second `shouldBe` Left ("output directory is not empty: " <> T.pack outDir <> "; pass --force to overwrite") - forced <- runDocs DocsOpts {docsDir = registryDir, docsOut = outDir, docsForce = True} + forced <- runDocs DocsOpts {dir = registryDir, out = outDir, force = True} forced `shouldBe` Right ("Wrote 2 concepts to " <> T.pack outDir) it "reports a missing registry file" $ do withSystemTempDirectory "seihou-okf-docs-missing" $ \tmpDir -> do let registryDir = tmpDir "missing" - result <- runDocs DocsOpts {docsDir = registryDir, docsOut = tmpDir "out", docsForce = False} + result <- runDocs DocsOpts {dir = registryDir, out = tmpDir "out", force = False} result `shouldBe` Left ("registry file not found: " <> T.pack (registryDir "seihou-registry.dhall")) writeFixtureRegistry :: FilePath -> IO ()