seihou-okf-extension (empty) → 0.4.0.0
raw patch · 11 files changed
+1330/−0 lines, 11 filesdep +aesondep +basedep +containers
Dependencies added: aeson, base, containers, directory, filepath, hspec, okf-core, optparse-applicative, seihou-core, seihou-okf-extension, tasty, tasty-hspec, temporary, text
Files
- LICENSE +28/−0
- seihou-okf-extension.cabal +99/−0
- src-exe/Main.hs +6/−0
- src/Seihou/OKF/Docs/Model.hs +219/−0
- src/Seihou/OKF/Docs/Render.hs +195/−0
- src/Seihou/OKF/Extension.hs +75/−0
- src/Seihou/OKF/Extension/Docs.hs +127/−0
- test/Main.hs +24/−0
- test/Seihou/OKF/Docs/ModelSpec.hs +255/−0
- test/Seihou/OKF/Docs/RenderSpec.hs +211/−0
- test/Seihou/OKF/Extension/DocsSpec.hs +91/−0
+ LICENSE view
@@ -0,0 +1,28 @@+BSD 3-Clause License++Copyright (c) 2026, Nadeem Bitar++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ seihou-okf-extension.cabal view
@@ -0,0 +1,99 @@+cabal-version: 3.0+name: seihou-okf-extension+version: 0.4.0.0+synopsis: OKF documentation extension for Seihou registries+description:+ External Seihou extension executable for generating OKF documentation bundles+ from Seihou registries. The initial package establishes the extension boundary;+ later plans add registry loading, rendering, and the real docs command.++homepage: https://github.com/shinzui/seihou+bug-reports: https://github.com/shinzui/seihou/issues+license: BSD-3-Clause+license-file: LICENSE+author: Nadeem Bitar+maintainer: nadeem@gmail.com+copyright: (c) 2026 Nadeem Bitar+category: Development+build-type: Simple++source-repository head+ type: git+ location: https://github.com/shinzui/seihou.git++library seihou-okf-extension-internal+ default-language: GHC2024+ default-extensions:+ DuplicateRecordFields+ NoFieldSelectors+ OverloadedLabels+ OverloadedRecordDot+ OverloadedStrings+ TypeFamilies++ hs-source-dirs: src+ visibility: private+ exposed-modules:+ Seihou.OKF.Docs.Model+ Seihou.OKF.Docs.Render+ Seihou.OKF.Extension+ Seihou.OKF.Extension.Docs++ build-depends:+ aeson >=2.1 && <3,+ base >=4.18 && <5,+ directory >=1.3 && <2,+ filepath >=1.4 && <2,+ okf-core ^>=0.1.2.0,+ optparse-applicative >=0.18 && <1,+ seihou-core ^>=0.4.0.0,+ text >=2.0 && <3,++executable seihou-okf-extension+ default-language: GHC2024+ ghc-options: -threaded+ default-extensions:+ DuplicateRecordFields+ NoFieldSelectors+ OverloadedLabels+ OverloadedRecordDot+ OverloadedStrings+ TypeFamilies++ hs-source-dirs: src-exe+ main-is: Main.hs+ build-depends:+ base >=4.18 && <5,+ seihou-okf-extension-internal,++test-suite seihou-okf-extension-test+ type: exitcode-stdio-1.0+ default-language: GHC2024+ default-extensions:+ DuplicateRecordFields+ NoFieldSelectors+ OverloadedLabels+ OverloadedRecordDot+ OverloadedStrings+ TypeFamilies++ hs-source-dirs: test+ main-is: Main.hs+ other-modules:+ Seihou.OKF.Docs.ModelSpec+ Seihou.OKF.Docs.RenderSpec+ Seihou.OKF.Extension.DocsSpec++ build-depends:+ base >=4.18 && <5,+ containers >=0.6 && <1,+ directory >=1.3 && <2,+ filepath >=1.4 && <2,+ hspec >=2.11 && <3,+ okf-core ^>=0.1.2.0,+ seihou-core ^>=0.4.0.0,+ seihou-okf-extension-internal,+ tasty >=1.4 && <2,+ tasty-hspec >=1.2 && <2,+ temporary >=1.3 && <2,+ text >=2.0 && <3,
+ src-exe/Main.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Seihou.OKF.Extension (runExtensionMain)++main :: IO ()+main = runExtensionMain
+ src/Seihou/OKF/Docs/Model.hs view
@@ -0,0 +1,219 @@+module Seihou.OKF.Docs.Model+ ( DocKind (..),+ DocArtifact (..),+ DocEntry (..),+ ModuleRef (..),+ DocModel (..),+ DocLoadError (..),+ loadDocModel,+ )+where++import Data.Text qualified as T+import Seihou.Core.Registry (Registry (..), RegistryEntry (..))+import Seihou.Core.Types+ ( AgentPrompt,+ Blueprint (..),+ Dependency,+ Module (..),+ ModuleLoadError,+ ModuleName (..),+ Recipe (..),+ RecipeName (..),+ depModuleNames,+ )+import Seihou.Dhall.Eval+ ( evalAgentPromptFromFile,+ evalBlueprintFromFile,+ evalModuleFromFile,+ evalRecipeFromFile,+ evalRegistryFromFile,+ )+import System.Directory (doesFileExist)+import System.FilePath ((</>))++data DocKind+ = DocModuleKind+ | DocRecipeKind+ | DocBlueprintKind+ | DocPromptKind+ deriving stock (Eq, Show)++data DocArtifact+ = DocModuleArtifact Module+ | DocRecipeArtifact Recipe+ | DocBlueprintArtifact Blueprint+ | DocPromptArtifact AgentPrompt+ 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]+ }+ deriving stock (Eq, Show)++data ModuleRef = ModuleRef+ { refName :: T.Text,+ refResolved :: Bool+ }+ deriving stock (Eq, Show)++data DocModel = DocModel+ { docRepoName :: T.Text,+ docRepoDescription :: Maybe T.Text,+ docEntries :: [DocEntry]+ }+ deriving stock (Eq, Show)++data DocLoadError+ = RegistryNotFound FilePath+ | RegistryLoadFailed T.Text+ | ArtifactLoadFailed T.Text T.Text+ deriving stock (Eq, Show)++loadDocModel :: FilePath -> IO (Either DocLoadError DocModel)+loadDocModel registryDir = do+ let registryFile = registryDir </> "seihou-registry.dhall"+ registryExists <- doesFileExist registryFile+ if not registryExists+ then pure (Left (RegistryNotFound registryFile))+ else do+ registryResult <- evalRegistryFromFile registryFile+ case registryResult of+ Left err ->+ pure (Left (RegistryLoadFailed (renderModuleLoadError err)))+ Right registry ->+ buildDocModel registryDir registry++buildDocModel :: FilePath -> Registry -> IO (Either DocLoadError DocModel)+buildDocModel registryDir Registry {repoName, repoDescription, modules, recipes, blueprints, prompts} = do+ entriesResult <-+ concatResults+ [ loadEntries (loadModuleEntry registryDir) modules,+ loadEntries (loadRecipeEntry registryDir) recipes,+ loadEntries (loadBlueprintEntry registryDir) blueprints,+ loadEntries (loadPromptEntry registryDir) prompts+ ]+ pure $ do+ entries <- entriesResult+ let moduleNames = [entry.entryName | entry <- entries, entry.entryKind == DocModuleKind]+ resolvedEntries = map (resolveEntryRefs moduleNames) entries+ Right+ DocModel+ { docRepoName = repoName,+ docRepoDescription = repoDescription,+ docEntries = resolvedEntries+ }++loadEntries :: (RegistryEntry -> IO (Either DocLoadError DocEntry)) -> [RegistryEntry] -> IO (Either DocLoadError [DocEntry])+loadEntries _ [] = pure (Right [])+loadEntries loadEntry (entry : entries) = do+ result <- loadEntry entry+ case result of+ Left err -> pure (Left err)+ Right docEntry -> do+ rest <- loadEntries loadEntry entries+ pure ((docEntry :) <$> rest)++concatResults :: [IO (Either DocLoadError [DocEntry])] -> IO (Either DocLoadError [DocEntry])+concatResults [] = pure (Right [])+concatResults (action : actions) = do+ result <- action+ case result of+ Left err -> pure (Left err)+ Right entries -> do+ rest <- concatResults actions+ pure ((entries <>) <$> rest)++loadModuleEntry :: FilePath -> RegistryEntry -> IO (Either DocLoadError DocEntry)+loadModuleEntry registryDir entry = do+ let artifactFile = registryDir </> entry.path </> "module.dhall"+ result <- evalModuleFromFile artifactFile+ pure $ case result of+ Left err -> Left (ArtifactLoadFailed entry.name.unModuleName (renderModuleLoadError err))+ Right artifact@Module {dependencies} ->+ Right $+ docEntryFromRegistry+ entry+ DocModuleKind+ (DocModuleArtifact artifact)+ (moduleRefs dependencies)++loadRecipeEntry :: FilePath -> RegistryEntry -> IO (Either DocLoadError DocEntry)+loadRecipeEntry registryDir entry = do+ let artifactFile = registryDir </> entry.path </> "recipe.dhall"+ result <- evalRecipeFromFile artifactFile+ pure $ case result of+ Left err -> Left (ArtifactLoadFailed entry.name.unModuleName (renderModuleLoadError err))+ Right artifact@Recipe {modules = recipeModules} ->+ Right $+ docEntryFromRegistry+ entry+ DocRecipeKind+ (DocRecipeArtifact artifact)+ (moduleRefs recipeModules)++loadBlueprintEntry :: FilePath -> RegistryEntry -> IO (Either DocLoadError DocEntry)+loadBlueprintEntry registryDir entry = do+ let artifactFile = registryDir </> entry.path </> "blueprint.dhall"+ result <- evalBlueprintFromFile artifactFile+ pure $ case result of+ Left err -> Left (ArtifactLoadFailed entry.name.unModuleName (renderModuleLoadError err))+ Right artifact@Blueprint {baseModules} ->+ Right $+ docEntryFromRegistry+ entry+ DocBlueprintKind+ (DocBlueprintArtifact artifact)+ (moduleRefs baseModules)++loadPromptEntry :: FilePath -> RegistryEntry -> IO (Either DocLoadError DocEntry)+loadPromptEntry registryDir entry = do+ let artifactFile = registryDir </> entry.path </> "prompt.dhall"+ result <- evalAgentPromptFromFile artifactFile+ pure $ case result of+ Left err -> Left (ArtifactLoadFailed entry.name.unModuleName (renderModuleLoadError err))+ Right artifact ->+ Right $+ docEntryFromRegistry+ entry+ DocPromptKind+ (DocPromptArtifact artifact)+ []++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+ }++moduleRefs :: [Dependency] -> [ModuleRef]+moduleRefs dependencies =+ [ ModuleRef {refName = moduleName.unModuleName, refResolved = False}+ | moduleName <- depModuleNames dependencies+ ]++resolveEntryRefs :: [T.Text] -> DocEntry -> DocEntry+resolveEntryRefs moduleNames entry =+ entry+ { entryModuleRefs =+ [ ref {refResolved = ref.refName `elem` moduleNames}+ | ref <- entry.entryModuleRefs+ ]+ }++renderModuleLoadError :: ModuleLoadError -> T.Text+renderModuleLoadError = T.pack . show
+ src/Seihou/OKF/Docs/Render.hs view
@@ -0,0 +1,195 @@+module Seihou.OKF.Docs.Render+ ( conceptIdFor,+ DocRenderError (..),+ DocBundleError (..),+ renderDocBundle,+ writeDocBundle,+ )+where++import Data.Aeson (Value (..))+import Data.Bifunctor (first)+import Data.Either (partitionEithers)+import Data.Text qualified as T+import Okf.Bundle (Concept, conceptFromDocument, writeBundle)+import Okf.ConceptId (ConceptId, parseConceptId, renderConceptLink)+import Okf.Document qualified as Okf+import Okf.Validation (BundleValidationError, ValidationProfile (..), validateBundle)+import Seihou.Core.Types+ ( AgentPrompt (..),+ Blueprint (..),+ BlueprintFile (..),+ Module (..),+ Recipe (..),+ VarDecl (..),+ VarExport (..),+ VarName (..),+ )+import Seihou.OKF.Docs.Model++data DocRenderError+ = InvalidDocConceptId DocKind T.Text T.Text+ deriving stock (Eq, Show)++data DocBundleError+ = DocBundleRenderError DocRenderError+ | DocBundleValidationError BundleValidationError+ deriving stock (Eq, Show)++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.docRepoName <$> model.docEntries) of+ ([], concepts) ->+ Right (concepts, validateBundle PermissiveConformance 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+ Left renderErrors ->+ pure (Left (DocBundleRenderError <$> renderErrors))+ Right (concepts, validationErrors)+ | null validationErrors -> Right <$> writeBundle outDir concepts+ | otherwise -> pure (Left (DocBundleValidationError <$> validationErrors))++conceptFor :: T.Text -> DocEntry -> Either DocRenderError Concept+conceptFor repoName entry =+ case conceptIdFor entry.entryKind entry.entryName of+ Left err ->+ Left (InvalidDocConceptId entry.entryKind entry.entryName err)+ Right conceptId ->+ Right (conceptFromDocument conceptId (documentFor repoName entry))++documentFor :: T.Text -> DocEntry -> Okf.OKFDocument+documentFor repoName entry =+ Okf.OKFDocument+ (frontmatterFor repoName entry)+ (bodyFor entry)++frontmatterFor :: T.Text -> DocEntry -> Okf.Frontmatter+frontmatterFor repoName entry =+ maybeSetVersion+ . Okf.setTags entry.entryTags+ . Okf.setResource (resourceFor repoName entry)+ $ Okf.okfCommon+ Okf.OkfCommon+ { Okf.commonType = typeFor entry.entryKind,+ Okf.commonTitle = Just entry.entryName,+ Okf.commonDescription = entry.entryDescription,+ Okf.commonTimestamp = Nothing+ }+ where+ maybeSetVersion =+ maybe id (\version -> Okf.setField "version" (String version)) entry.entryVersion++resourceFor :: T.Text -> DocEntry -> T.Text+resourceFor repoName entry =+ "seihou://" <> repoName <> "/" <> T.pack entry.entryPath++bodyFor :: DocEntry -> T.Text+bodyFor entry =+ T.intercalate+ "\n\n"+ ( baseSections entry+ <> kindSections entry+ )+ <> "\n"++baseSections :: DocEntry -> [T.Text]+baseSections entry =+ [ "# " <> entry.entryName,+ maybe "No description provided." id entry.entryDescription+ ]+ <> foldMap (\version -> ["**Version:** " <> version]) entry.entryVersion++kindSections :: DocEntry -> [T.Text]+kindSections entry =+ case entry.entryArtifact of+ DocModuleArtifact Module {vars, exports} ->+ [ "## Dependencies\n\n" <> renderModuleRefs "This module has no dependencies." entry.entryModuleRefs,+ "## Variables\n\n" <> renderVarDecls vars,+ "## Exports\n\n" <> renderExports exports+ ]+ DocRecipeArtifact _ ->+ ["## Composes\n\n" <> renderModuleRefs "This recipe does not compose any modules." entry.entryModuleRefs]+ DocBlueprintArtifact Blueprint {prompt, files} ->+ [ "## Base modules\n\n" <> renderModuleRefs "This blueprint declares no base modules." entry.entryModuleRefs,+ "## Agent prompt\n\n" <> firstParagraph prompt,+ "## Reference files\n\n" <> renderBlueprintFiles files+ ]+ 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+ ]++renderModuleRefs :: T.Text -> [ModuleRef] -> T.Text+renderModuleRefs emptyMessage refs =+ case refs of+ [] -> emptyMessage+ _ -> T.unlines ["- " <> moduleLink ref.refName | ref <- refs]++moduleLink :: T.Text -> T.Text+moduleLink name =+ case conceptIdFor DocModuleKind name of+ Right conceptId -> renderConceptLink conceptId name+ Left _ -> "`" <> name <> "`"++renderVarDecls :: [VarDecl] -> T.Text+renderVarDecls [] = "No variables declared."+renderVarDecls vars =+ T.unlines ["- `" <> varName <> "`" <> requiredLabel required | VarDecl {name = VarName varName, required} <- vars]++requiredLabel :: Bool -> T.Text+requiredLabel required+ | required = " (required)"+ | otherwise = ""++renderExports :: [VarExport] -> T.Text+renderExports [] = "No exports declared."+renderExports exports =+ T.unlines ["- `" <> varName <> "`" | VarExport {var = VarName varName} <- exports]++renderBlueprintFiles :: [BlueprintFile] -> T.Text+renderBlueprintFiles [] = "No reference files declared."+renderBlueprintFiles files =+ T.unlines+ [ "- `" <> T.pack src <> "`" <> maybe "" (" - " <>) description+ | BlueprintFile {src, description} <- files+ ]++renderTextList :: [T.Text] -> T.Text+renderTextList [] = "No tool restrictions declared."+renderTextList values = T.unlines ["- `" <> value <> "`" | value <- values]++firstParagraph :: T.Text -> T.Text+firstParagraph text =+ case T.splitOn "\n\n" text of+ [] -> "No prompt text provided."+ paragraph : _ ->+ case T.strip paragraph of+ "" -> "No prompt text provided."+ stripped -> stripped++conceptIdTextFor :: DocKind -> T.Text -> T.Text+conceptIdTextFor kind name = kindDir kind <> "/" <> name++kindDir :: DocKind -> T.Text+kindDir DocModuleKind = "modules"+kindDir DocRecipeKind = "recipes"+kindDir DocBlueprintKind = "blueprints"+kindDir DocPromptKind = "prompts"++typeFor :: DocKind -> T.Text+typeFor DocModuleKind = "SeihouModule"+typeFor DocRecipeKind = "SeihouRecipe"+typeFor DocBlueprintKind = "SeihouBlueprint"+typeFor DocPromptKind = "SeihouPrompt"
+ src/Seihou/OKF/Extension.hs view
@@ -0,0 +1,75 @@+module Seihou.OKF.Extension+ ( okfSmoke,+ runExtensionMain,+ )+where++import Data.Text (Text)+import Data.Text qualified as T+import Okf.Document (OKFDocument (..), emptyFrontmatter, serializeDocument)+import Options.Applicative+import Options.Applicative.Help.Pretty (pretty, vsep)+import Seihou.OKF.Extension.Docs (DocsOpts (..), handleDocs)++data Command+ = Docs DocsOpts+ deriving stock (Eq, Show)++okfSmoke :: Text+okfSmoke = serializeDocument (OKFDocument emptyFrontmatter "# smoke\n")++runExtensionMain :: IO ()+runExtensionMain = do+ command <- customExecParser (prefs showHelpOnEmpty) opts+ case command of+ Docs docsOpts ->+ handleDocs docsOpts++opts :: ParserInfo Command+opts =+ info+ (commandParser <**> helper)+ ( fullDesc+ <> progDesc "Generate OKF documentation bundles for Seihou registries"+ <> header "seihou-okf-extension - OKF documentation extension for Seihou"+ )++commandParser :: Parser Command+commandParser =+ hsubparser+ (command "docs" docsInfo)++docsInfo :: ParserInfo Command+docsInfo =+ info+ (Docs <$> docsParser <**> helper)+ ( fullDesc+ <> progDesc "Generate OKF docs for a Seihou registry"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Reads seihou-registry.dhall, loads each listed artifact, validates the OKF bundle," :: String),+ pretty ("and writes one Markdown concept document per registry entry." :: String),+ pretty ("Smoke value length: " <> show (T.length okfSmoke) :: String)+ ]+ )+ )++docsParser :: Parser DocsOpts+docsParser =+ DocsOpts+ <$> strOption+ ( long "dir"+ <> metavar "PATH"+ <> value "."+ <> showDefault+ <> help "Registry directory containing seihou-registry.dhall"+ )+ <*> strOption+ ( long "out"+ <> metavar "PATH"+ <> value "okf-docs"+ <> showDefault+ <> help "Output directory for the generated OKF bundle"+ )+ <*> switch (long "force" <> help "Overwrite a non-empty output directory")
+ src/Seihou/OKF/Extension/Docs.hs view
@@ -0,0 +1,127 @@+module Seihou.OKF.Extension.Docs+ ( DocsOpts (..),+ runDocs,+ handleDocs,+ renderDocBundleError,+ )+where++import Control.Monad (when)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Okf.ConceptId qualified as Okf+import Okf.Validation (BundleValidationError (..), ValidationError (..))+import Seihou.OKF.Docs.Model+import Seihou.OKF.Docs.Render+import System.Directory+ ( createDirectoryIfMissing,+ doesDirectoryExist,+ doesFileExist,+ doesPathExist,+ listDirectory,+ removeDirectoryRecursive,+ )+import System.Exit (exitFailure)+import System.FilePath ((</>))+import System.IO (stderr)++data DocsOpts = DocsOpts+ { docsDir :: FilePath,+ docsOut :: FilePath,+ docsForce :: Bool+ }+ deriving stock (Eq, Show)++runDocs :: DocsOpts -> IO (Either T.Text T.Text)+runDocs opts = do+ let registryFile = opts.docsDir </> "seihou-registry.dhall"+ registryExists <- doesFileExist registryFile+ if not registryExists+ then pure (Left ("registry file not found: " <> T.pack registryFile))+ else do+ outputCheck <- checkOutputDirectory opts+ case outputCheck of+ Left err -> pure (Left err)+ Right () -> do+ modelResult <- loadDocModel opts.docsDir+ case modelResult of+ Left err -> pure (Left (renderDocLoadError err))+ Right model ->+ case renderDocBundle model of+ Left renderErrors ->+ pure (Left (renderMany renderDocRenderError renderErrors))+ Right (concepts, validationProblems)+ | not (null validationProblems) ->+ pure (Left (renderMany renderBundleValidationError validationProblems))+ | otherwise -> do+ prepareOutputDirectory opts.docsOut+ writeResult <- writeDocBundle opts.docsOut 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)++handleDocs :: DocsOpts -> IO ()+handleDocs opts = do+ result <- runDocs opts+ case result of+ Left err -> do+ TIO.hPutStrLn stderr err+ exitFailure+ Right summary ->+ TIO.putStrLn summary++checkOutputDirectory :: DocsOpts -> IO (Either T.Text ())+checkOutputDirectory opts = do+ pathExists <- doesPathExist opts.docsOut+ if not pathExists+ then pure (Right ())+ else do+ isDirectory <- doesDirectoryExist opts.docsOut+ if not isDirectory+ then pure (Left ("output path exists and is not a directory: " <> T.pack opts.docsOut))+ else do+ entries <- listDirectory opts.docsOut+ if null entries || opts.docsForce+ then pure (Right ())+ else pure (Left ("output directory is not empty: " <> T.pack opts.docsOut <> "; pass --force to overwrite"))++prepareOutputDirectory :: FilePath -> IO ()+prepareOutputDirectory outDir = do+ exists <- doesDirectoryExist outDir+ when exists (removeDirectoryRecursive outDir)+ createDirectoryIfMissing True outDir++renderDocLoadError :: DocLoadError -> T.Text+renderDocLoadError (RegistryNotFound path) =+ "registry file not found: " <> T.pack path+renderDocLoadError (RegistryLoadFailed err) =+ "failed to load registry: " <> err+renderDocLoadError (ArtifactLoadFailed name err) =+ "failed to load registry entry " <> name <> ": " <> err++renderDocBundleError :: DocBundleError -> T.Text+renderDocBundleError (DocBundleRenderError err) = renderDocRenderError err+renderDocBundleError (DocBundleValidationError err) = renderBundleValidationError err++renderDocRenderError :: DocRenderError -> T.Text+renderDocRenderError (InvalidDocConceptId kind name err) =+ "invalid OKF concept ID for " <> T.pack (show kind) <> " " <> name <> ": " <> err++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 (DuplicateConceptId conceptId) =+ "duplicate concept ID: " <> Okf.renderConceptId conceptId++renderValidationError :: ValidationError -> T.Text+renderValidationError (MissingRequiredField field) =+ "missing required field: " <> field+renderValidationError (FieldMustBeNonEmptyText field) =+ "field must be non-empty text: " <> field+renderValidationError (MissingRecommendedField field) =+ "missing recommended field: " <> field++renderMany :: (a -> T.Text) -> [a] -> T.Text+renderMany render = T.intercalate "\n" . fmap render
+ test/Main.hs view
@@ -0,0 +1,24 @@+module Main (main) where++import Data.Text qualified as T+import Seihou.OKF.Docs.ModelSpec qualified as ModelSpec+import Seihou.OKF.Docs.RenderSpec qualified as RenderSpec+import Seihou.OKF.Extension (okfSmoke)+import Seihou.OKF.Extension.DocsSpec qualified as DocsSpec+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++main :: IO ()+main = do+ smokeTests <- testSpec "Seihou.OKF.Extension" spec+ modelTests <- ModelSpec.tests+ renderTests <- RenderSpec.tests+ docsTests <- DocsSpec.tests+ defaultMain (testGroup "seihou-okf-extension" [smokeTests, modelTests, renderTests, docsTests])++spec :: Spec+spec = do+ describe "okfSmoke" $ do+ it "serializes an OKF document through okf-core" $ do+ okfSmoke `shouldSatisfy` T.isInfixOf "# smoke"
+ test/Seihou/OKF/Docs/ModelSpec.hs view
@@ -0,0 +1,255 @@+module Seihou.OKF.Docs.ModelSpec (tests) where++import Data.List (find)+import Data.Maybe (fromMaybe)+import Data.Text qualified as T+import Seihou.OKF.Docs.Model+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.OKF.Docs.Model" spec++spec :: Spec+spec = do+ describe "loadDocModel" $ do+ it "loads all four registry entry kinds from a fixture registry" $ do+ withFixtureRegistry $ \registryDir -> do+ model <- shouldLoad registryDir+ model.docRepoName `shouldBe` "fixture-registry"+ length (entriesByKind DocModuleKind model) `shouldBe` 3+ length (entriesByKind DocRecipeKind model) `shouldBe` 1+ length (entriesByKind DocBlueprintKind model) `shouldBe` 1+ length (entriesByKind DocPromptKind model) `shouldBe` 1++ it "keeps catalog metadata from the registry entry" $ do+ 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"++ 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]++ 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]++ 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]++ it "returns RegistryNotFound when the registry file is absent" $ do+ withSystemTempDirectory "seihou-doc-model-missing" $ \registryDir -> do+ result <- loadDocModel registryDir+ result `shouldBe` Left (RegistryNotFound (registryDir </> "seihou-registry.dhall"))++shouldLoad :: FilePath -> IO DocModel+shouldLoad registryDir = do+ result <- loadDocModel registryDir+ case result of+ Left err -> do+ expectationFailure ("Expected Right, got Left: " <> show err)+ error "unreachable"+ Right model -> pure model++entriesByKind :: DocKind -> DocModel -> [DocEntry]+entriesByKind kind model =+ filter (\entry -> entry.entryKind == kind) model.docEntries++requireEntry :: String -> DocModel -> DocEntry+requireEntry name model =+ fromMaybe (error ("missing entry " <> name)) $+ find (\entry -> entry.entryName == T.pack name) model.docEntries++withFixtureRegistry :: (FilePath -> IO a) -> IO a+withFixtureRegistry action =+ withSystemTempDirectory "seihou-doc-model" $ \registryDir -> do+ writeFixtureRegistry registryDir+ action registryDir++writeFixtureRegistry :: FilePath -> IO ()+writeFixtureRegistry registryDir = do+ writeFile (registryDir </> "seihou-registry.dhall") registryDhall+ writeModule registryDir "modules/base" "base" [] "Base module"+ writeModule registryDir "modules/app" "app" ["base"] "Application module"+ writeModule registryDir "modules/dangling" "dangling" ["missing"] "Dangling module"+ writeRecipe registryDir+ writeBlueprint registryDir+ writePrompt registryDir++writeModule :: FilePath -> FilePath -> String -> [String] -> String -> IO ()+writeModule registryDir relDir name dependencies description = do+ createDirectoryIfMissing True (registryDir </> relDir)+ writeFile (registryDir </> relDir </> "module.dhall") (moduleDhall name dependencies description)++writeRecipe :: FilePath -> IO ()+writeRecipe registryDir = do+ let relDir = "recipes/app-recipe"+ createDirectoryIfMissing True (registryDir </> relDir)+ writeFile (registryDir </> relDir </> "recipe.dhall") recipeDhall++writeBlueprint :: FilePath -> IO ()+writeBlueprint registryDir = do+ let relDir = "blueprints/app-blueprint"+ createDirectoryIfMissing True (registryDir </> relDir)+ writeFile (registryDir </> relDir </> "blueprint.dhall") blueprintDhall++writePrompt :: FilePath -> IO ()+writePrompt registryDir = do+ let relDir = "prompts/review"+ createDirectoryIfMissing True (registryDir </> relDir)+ writeFile (registryDir </> relDir </> "prompt.dhall") promptDhall++registryDhall :: String+registryDhall =+ "{ repoName = \"fixture-registry\"\n\+ \, repoDescription = Some \"Fixture registry\"\n\+ \, modules =\n\+ \ [ { name = \"base\", version = Some \"1.0.0\", path = \"modules/base\", description = Some \"Base module\", tags = [ \"haskell\" ] }\n\+ \ , { name = \"app\", version = Some \"1.2.3\", path = \"modules/app\", description = Some \"Application module\", tags = [ \"haskell\", \"app\" ] }\n\+ \ , { 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\+ \, prompts = [ { name = \"review\", version = Some \"0.1.0\", path = \"prompts/review\", description = Some \"Review prompt\", tags = [ \"prompt\" ] } ]\n\+ \}"++moduleDhall :: String -> [String] -> String -> String+moduleDhall name dependencies description =+ "{ name = \""+ <> name+ <> "\"\n\+ \, version = Some \"1.0.0\"\n\+ \, description = Some \""+ <> description+ <> "\"\n\+ \, vars = [] : "+ <> varDeclListType+ <> "\n\+ \, exports = [] : "+ <> varExportListType+ <> "\n\+ \, prompts = [] : "+ <> promptListType+ <> "\n\+ \, steps = [] : "+ <> stepListType+ <> "\n\+ \, commands = [] : "+ <> commandListType+ <> "\n\+ \, dependencies = "+ <> dependencyList dependencies+ <> "\n\+ \}"++recipeDhall :: String+recipeDhall =+ "{ name = \"app-recipe\"\n\+ \, version = Some \"0.1.0\"\n\+ \, description = Some \"Recipe\"\n\+ \, modules = [ \"base\", \"app\" ]\n\+ \, vars = [] : "+ <> varDeclListType+ <> "\n\+ \, prompts = [] : "+ <> promptListType+ <> "\n\+ \}"++blueprintDhall :: String+blueprintDhall =+ "{ name = \"app-blueprint\"\n\+ \, version = Some \"0.1.0\"\n\+ \, description = Some \"Blueprint\"\n\+ \, prompt = \"Build the app\"\n\+ \, vars = [] : "+ <> varDeclListType+ <> "\n\+ \, prompts = [] : "+ <> promptListType+ <> "\n\+ \, baseModules = [ \"base\" ]\n\+ \, files = [] : "+ <> blueprintFileListType+ <> "\n\+ \, allowedTools = None (List Text)\n\+ \, tags = [ \"blueprint\" ]\n\+ \}"++promptDhall :: String+promptDhall =+ "{ name = \"review\"\n\+ \, version = Some \"0.1.0\"\n\+ \, description = Some \"Review prompt\"\n\+ \, prompt = \"Review the change\"\n\+ \, vars = [] : "+ <> varDeclListType+ <> "\n\+ \, prompts = [] : "+ <> promptListType+ <> "\n\+ \, commandVars = [] : "+ <> commandVarListType+ <> "\n\+ \, files = [] : "+ <> blueprintFileListType+ <> "\n\+ \, allowedTools = None (List Text)\n\+ \, tags = [ \"prompt\" ]\n\+ \, launch = None { provider : Optional Text, mode : Optional Text, model : Optional Text }\n\+ \}"++dependencyList :: [String] -> String+dependencyList [] = "[] : List Text"+dependencyList deps = "[ " <> joinComma (map show deps) <> " ]"++joinComma :: [String] -> String+joinComma [] = ""+joinComma [x] = x+joinComma (x : xs) = x <> ", " <> joinComma xs++varDeclListType :: String+varDeclListType =+ "List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }"++varExportListType :: String+varExportListType =+ "List { var : Text, alias : Optional Text }"++promptListType :: String+promptListType =+ "List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }"++stepListType :: String+stepListType =+ "List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }"++commandListType :: String+commandListType =+ "List { run : Text, workDir : Optional Text, when : Optional Text }"++blueprintFileListType :: String+blueprintFileListType =+ "List { src : Text, description : Optional Text }"++commandVarListType :: String+commandVarListType =+ "List { name : Text, run : Text, workDir : Optional Text, when : Optional Text, trim : Bool, maxBytes : Optional Natural }"
+ test/Seihou/OKF/Docs/RenderSpec.hs view
@@ -0,0 +1,211 @@+module Seihou.OKF.Docs.RenderSpec (tests) where++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 Seihou.Core.Types+import Seihou.OKF.Docs.Model+import Seihou.OKF.Docs.Render+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.OKF.Docs.Render" spec++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+ problems `shouldBe` []+ sort (Okf.renderConceptId . Okf.conceptIdOf <$> concepts)+ `shouldBe` [ "blueprints/app-blueprint",+ "modules/app",+ "modules/base",+ "prompts/review",+ "recipes/app-recipe"+ ]++ it "renders frontmatter fields and resource pointers" $ do+ concept <- requireConcept "modules/base" wellFormedModel+ let rendered = Okf.serializeConcept concept+ rendered `shouldSatisfy` T.isInfixOf "type: SeihouModule"+ rendered `shouldSatisfy` T.isInfixOf "title: base"+ rendered `shouldSatisfy` T.isInfixOf "resource: seihou://fixture/modules/base"+ rendered `shouldSatisfy` T.isInfixOf "version: 1.0.0"++ it "renders resolvable cross-links to composed modules" $ do+ concept <- requireConcept "recipes/app-recipe" 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 `shouldBe` []++ it "reports a DanglingReference for an unresolved module ref" $ do+ let Right (_, problems) = renderDocBundle danglingModel+ problems `shouldSatisfy` any isDanglingReference++ it "reports invalid generated concept IDs as render errors" $ do+ renderDocBundle invalidIdModel+ `shouldBe` Left [InvalidDocConceptId DocModuleKind "-bad" "InvalidConceptIdSegment \"-bad\""]++requireConcept :: T.Text -> DocModel -> IO Okf.Concept+requireConcept rawId model =+ case renderDocBundle 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"++isDanglingReference :: BundleValidationError -> Bool+isDanglingReference DanglingReference {} = True+isDanglingReference _ = False++wellFormedModel :: DocModel+wellFormedModel =+ DocModel+ { docRepoName = "fixture",+ docRepoDescription = Just "Fixture",+ docEntries =+ [ moduleEntry "base" [] "modules/base",+ moduleEntry "app" [ModuleRef "base" True] "modules/app",+ recipeEntry,+ blueprintEntry,+ promptEntry+ ]+ }++danglingModel :: DocModel+danglingModel =+ DocModel+ { docRepoName = "fixture",+ docRepoDescription = Nothing,+ docEntries =+ [ moduleEntry "app" [ModuleRef "missing" False] "modules/app"+ ]+ }++invalidIdModel :: DocModel+invalidIdModel =+ DocModel+ { docRepoName = "fixture",+ docRepoDescription = Nothing,+ docEntries =+ [ moduleEntry "-bad" [] "modules/bad"+ ]+ }++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+ }++moduleArtifact :: T.Text -> [ModuleRef] -> Module+moduleArtifact name refs =+ Module+ { name = ModuleName name,+ version = Just "1.0.0",+ description = Just (name <> " module"),+ vars = [],+ exports = [],+ prompts = [],+ steps = [],+ commands = [],+ dependencies = [Dependency (ModuleName ref.refName) Map.empty | ref <- refs],+ removal = Nothing,+ migrations = []+ }++recipeEntry :: DocEntry+recipeEntry =+ DocEntry+ { entryName = "app-recipe",+ entryKind = DocRecipeKind,+ entryVersion = Just "0.1.0",+ entryDescription = Just "Recipe",+ entryTags = ["recipe"],+ entryPath = "recipes/app-recipe",+ entryArtifact =+ DocRecipeArtifact+ Recipe+ { name = RecipeName "app-recipe",+ version = Just "0.1.0",+ description = Just "Recipe",+ modules = [simpleDep "base", simpleDep "app"],+ vars = [],+ prompts = []+ },+ entryModuleRefs = [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 =+ DocBlueprintArtifact+ Blueprint+ { name = ModuleName "app-blueprint",+ version = Just "0.1.0",+ description = Just "Blueprint",+ prompt = "Build the app",+ vars = [],+ prompts = [],+ baseModules = [simpleDep "base"],+ files = [],+ allowedTools = Nothing,+ tags = ["blueprint"]+ },+ entryModuleRefs = [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 =+ DocPromptArtifact+ AgentPrompt+ { name = ModuleName "review",+ version = Just "0.1.0",+ description = Just "Review prompt",+ prompt = "Review the change",+ vars = [],+ prompts = [],+ commandVars = [],+ files = [],+ allowedTools = Nothing,+ tags = ["prompt"],+ launch = Nothing+ },+ entryModuleRefs = []+ }
+ test/Seihou/OKF/Extension/DocsSpec.hs view
@@ -0,0 +1,91 @@+module Seihou.OKF.Extension.DocsSpec (tests) where++import Data.Text qualified as T+import Okf.Bundle qualified as Okf+import Okf.Validation qualified as Okf+import Seihou.OKF.Extension.Docs+import System.Directory (createDirectoryIfMissing, doesFileExist)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.OKF.Extension.Docs" spec++spec :: Spec+spec = do+ describe "runDocs" $ do+ it "writes and validates an OKF bundle for a registry" $ do+ withSystemTempDirectory "seihou-okf-docs" $ \tmpDir -> do+ let registryDir = tmpDir </> "registry"+ outDir = tmpDir </> "out"+ writeFixtureRegistry registryDir+ result <- runDocs DocsOpts {docsDir = registryDir, docsOut = outDir, docsForce = 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+ walked <- Okf.walkBundle outDir+ case walked of+ Left err -> expectationFailure ("Expected walkBundle success, got " <> show err)+ Right concepts -> Okf.validateBundle Okf.PermissiveConformance 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 {docsDir = registryDir, docsOut = outDir, docsForce = False}+ first `shouldBe` Right ("Wrote 2 concepts to " <> T.pack outDir)+ second <- runDocs DocsOpts {docsDir = registryDir, docsOut = outDir, docsForce = 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 `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 `shouldBe` Left ("registry file not found: " <> T.pack (registryDir </> "seihou-registry.dhall"))++writeFixtureRegistry :: FilePath -> IO ()+writeFixtureRegistry registryDir = do+ createDirectoryIfMissing True (registryDir </> "modules" </> "base")+ createDirectoryIfMissing True (registryDir </> "recipes" </> "base-recipe")+ writeFile (registryDir </> "seihou-registry.dhall") registryDhall+ writeFile (registryDir </> "modules" </> "base" </> "module.dhall") moduleDhall+ writeFile (registryDir </> "recipes" </> "base-recipe" </> "recipe.dhall") recipeDhall++registryDhall :: String+registryDhall =+ "{ repoName = \"fixture-registry\"\n\+ \, repoDescription = Some \"Fixture registry\"\n\+ \, modules = [ { name = \"base\", version = Some \"1.0.0\", path = \"modules/base\", description = Some \"Base module\", tags = [ \"haskell\" ] } ]\n\+ \, recipes = [ { name = \"base-recipe\", version = Some \"0.1.0\", path = \"recipes/base-recipe\", description = Some \"Recipe\", tags = [ \"recipe\" ] } ]\n\+ \, blueprints = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }\n\+ \, prompts = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }\n\+ \}"++moduleDhall :: String+moduleDhall =+ "{ name = \"base\"\n\+ \, version = Some \"1.0.0\"\n\+ \, description = Some \"Base module\"\n\+ \, vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }\n\+ \, exports = [] : List { var : Text, alias : Optional Text }\n\+ \, prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }\n\+ \, steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }\n\+ \, commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }\n\+ \, dependencies = [] : List Text\n\+ \}"++recipeDhall :: String+recipeDhall =+ "{ name = \"base-recipe\"\n\+ \, version = Some \"0.1.0\"\n\+ \, description = Some \"Recipe\"\n\+ \, modules = [ \"base\" ]\n\+ \, vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }\n\+ \, prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }\n\+ \}"