module Seihou.OKF.Docs.Render
( conceptIdFor,
DocRenderError (..),
DocBundleError (..),
renderDocBundle,
writeDocBundle,
)
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)
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 ^. #repoName) <$> model ^. #entries) 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 ^. #kind) (entry ^. #name) of
Left err ->
Left (InvalidDocConceptId (entry ^. #kind) (entry ^. #name) 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 ^. #tags)
. Okf.setResource (resourceFor repoName entry)
$ Okf.okfCommon
Okf.OkfCommon
{ 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 ^. #version)
resourceFor :: T.Text -> DocEntry -> T.Text
resourceFor repoName entry =
"seihou://" <> repoName <> "/" <> T.pack (entry ^. #path)
bodyFor :: DocEntry -> T.Text
bodyFor entry =
T.intercalate
"\n\n"
( baseSections entry
<> kindSections entry
)
<> "\n"
baseSections :: DocEntry -> [T.Text]
baseSections entry =
[ "# " <> entry ^. #name,
maybe "No description provided." id (entry ^. #description)
]
<> foldMap (\version -> ["**Version:** " <> version]) (entry ^. #version)
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
]
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 ^. #name) | 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"