diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,20 @@ +# Changelog + +## Unreleased + +## 0.1.0.0 - 2026-06-28 + +### Added + +- Initial package scaffold (EP-31, Milestone 1): `Shikumi.Okf.Types` defining + `SomeProgram`, `ProgramDoc`, `ProgramManifest`, and `AppInfo`. +- Program rendering and bundle generation (Milestones 2–3): `Shikumi.Okf.Render` + (`renderProgramBody`) and `Shikumi.Okf.Generate` (`generateBundle`, + `writeProgramBundle`, and the per-concept builders), producing one `Shikumi App` + concept linking to one `Shikumi Program` concept per program. +- Shared OKF profile `profile/shikumi.dhall`, a worked `shikumi-okf-example` + executable, and the committed `example/out` bundle (Milestone 4). Verified with + the standalone `okf` CLI: `validate`, `--profile-enforce`, and `graph --json`. +- Model-call instructions in rendered bodies (Milestone 5): each `Predict` node's + signature instruction now appears under its model call, via the new core accessor + `Shikumi.Program.nodeInstructionsIndexed`. diff --git a/example/Main.hs b/example/Main.hs new file mode 100644 --- /dev/null +++ b/example/Main.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | A worked example of the OKF generator that doubles as the regenerate-and-diff +-- fixture. It builds a small two-program manifest — one typed @Predict@ program and +-- one opaque @Embed@ program (the shape an agent runtime such as shikigami produces) +-- — and writes the bundle to the directory given as the first argument (default +-- @./out@, i.e. @shikumi-okf/example/out@ when run from the package directory). +-- +-- Run it with: +-- +-- > cabal run shikumi-okf-example +-- +-- then validate the result with the standalone @okf@ CLI (see the package docs and +-- EP-31). Because no timestamp is passed, regenerating an unchanged manifest yields +-- byte-identical output, so the committed @example/out@ tree can be regenerated and +-- diffed in CI. +module Main (main) where + +import Data.Text (Text) +import GHC.Generics (Generic) +import Shikumi.Adapter (ToPrompt) +import Shikumi.Module (predict) +import Shikumi.Okf.Generate (writeProgramBundle) +import Shikumi.Okf.Types + ( AppInfo (..), + ProgramDoc (..), + ProgramManifest (..), + SomeProgram (..), + ) +import Shikumi.Program (Program, embed) +import Shikumi.Schema (FromModel, ToSchema, Validatable) +import Shikumi.Signature (Signature, mkSignature) +import System.Environment (getArgs) + +-- A typed program's input/output records. +newtype Ticket = Ticket {ticket :: Text} + deriving stock (Generic, Show, Eq) + +instance ToSchema Ticket + +instance FromModel Ticket + +instance ToPrompt Ticket + +instance Validatable Ticket + +newtype Category = Category {category :: Text} + deriving stock (Generic, Show, Eq) + +instance ToSchema Category + +instance FromModel Category + +instance ToPrompt Category + +instance Validatable Category + +classifyProgram :: Program Ticket Category +classifyProgram = predict (mkSignature "Classify the support ticket." :: Signature Ticket Category) + +-- An opaque embedded program: no inspectable internal structure. +heartbeatProgram :: Program () () +heartbeatProgram = embed (\_ -> pure ()) + +manifest :: ProgramManifest +manifest = + ProgramManifest + [ ProgramDoc + { name = "classify-ticket", + title = Just "Classify Ticket", + description = Just "Assigns a support ticket to a category.", + tags = ["support", "classification"], + declaredInputs = Nothing, + declaredOutputs = Nothing, + program = Just (SomeProgram classifyProgram) + }, + ProgramDoc + { name = "heartbeat", + title = Just "Heartbeat", + description = Just "Declared-agent heartbeat that emits a fixed digest.", + tags = ["agent"], + declaredInputs = Just "Trigger payload (ignored).", + declaredOutputs = Just "A fixed heartbeat digest.", + program = Just (SomeProgram heartbeatProgram) + } + ] + +exampleApp :: AppInfo +exampleApp = + AppInfo + { appNamespace = "shinzui", + appName = "example-app", + appTitle = Just "Example Application", + appDescription = Just "A worked example of shikumi-okf program documentation." + } + +main :: IO () +main = do + args <- getArgs + let root = case args of + (dir : _) -> dir + [] -> "out" + result <- writeProgramBundle root exampleApp Nothing manifest + case result of + Left err -> error ("bundle generation failed: " <> show err) + Right () -> putStrLn ("Wrote OKF bundle to " <> root) diff --git a/shikumi-okf.cabal b/shikumi-okf.cabal new file mode 100644 --- /dev/null +++ b/shikumi-okf.cabal @@ -0,0 +1,81 @@ +cabal-version: 3.4 +name: shikumi-okf +version: 0.1.0.0 +synopsis: + Generate OKF documentation bundles from shikumi programs (EP-31) + +category: AI +description: + An opt-in generator that documents shikumi @Program@ values as an Open + Knowledge Format (OKF) bundle: one @Shikumi App@ concept that links to one + @Shikumi Program@ concept per program an application ships. Given a + user-supplied 'Shikumi.Okf.Types.ProgramManifest' of named programs, it builds + Markdown concept documents (frontmatter + a body rendered from the program's + structure and the author's declared metadata) and writes them to disk through + the @okf-core@ producer API. + . + The heavy @okf-core@ dependency is isolated in this package — mirroring how + @shikumi-trace-otel@ quarantines the OpenTelemetry tree — so shikumi users who + do not care about OKF never depend on it. + +license: BSD-3-Clause +author: Nadeem Bitar +maintainer: nadeem@gmail.com +build-type: Simple +extra-doc-files: CHANGELOG.md + +common common-options + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-uni-patterns + -Wincomplete-record-updates -Wredundant-constraints + -fhide-source-paths -Wmissing-export-lists -Wpartial-fields + -Wmissing-deriving-strategies + + default-language: GHC2024 + default-extensions: + DeriveAnyClass + DuplicateRecordFields + OverloadedLabels + OverloadedStrings + +library + import: common-options + hs-source-dirs: src + exposed-modules: + Shikumi.Okf.Generate + Shikumi.Okf.Render + Shikumi.Okf.Types + + build-depends: + , base >=4.20 && <5 + , okf-core ^>=0.1.0.0 + , shikumi ^>=0.2.0.0 + , text ^>=2.1 + +executable shikumi-okf-example + import: common-options + hs-source-dirs: example + main-is: Main.hs + build-depends: + , base + , shikumi ^>=0.2.0.0 + , shikumi-okf ^>=0.1.0.0 + , text + +test-suite shikumi-okf-test + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + ghc-options: -threaded -with-rtsopts=-N + build-depends: + , base + , directory + , effectful + , filepath + , okf-core ^>=0.1.0.0 + , shikumi ^>=0.2.0.0 + , shikumi-okf ^>=0.1.0.0 + , tasty + , tasty-hunit + , text diff --git a/src/Shikumi/Okf/Generate.hs b/src/Shikumi/Okf/Generate.hs new file mode 100644 --- /dev/null +++ b/src/Shikumi/Okf/Generate.hs @@ -0,0 +1,132 @@ +-- | Turn a 'ProgramManifest' into OKF concepts and write them to disk. +-- +-- The bundle is one @Shikumi App@ concept that links to one @Shikumi Program@ +-- concept per manifest entry. Those Markdown links are the app→program edges the +-- OKF graph extractor reads, so a reader (or the @okf graph@ command) can answer +-- "which programs does this app ship?". Building concepts is pure and can fail +-- only on an invalid concept name (an author error in the manifest), surfaced as +-- 'GenerateError'; writing performs IO through the @okf-core@ producer API. +-- +-- Generation is deterministic: the timestamp is an explicit argument, never read +-- from the wall clock, so regenerating an unchanged manifest yields byte-identical +-- output and a "regenerate and diff" check stays meaningful. +module Shikumi.Okf.Generate + ( GenerateError (..), + programConceptId, + appConceptId, + programConcept, + appConcept, + generateBundle, + writeProgramBundle, + ) +where + +import Data.Bifunctor (first) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Text qualified as T +import Okf.Bundle (BundleError, Concept, conceptFromDocument, writeBundle) +import Okf.ConceptId (ConceptId, ConceptIdError, parseConceptId, renderConceptLink) +import Okf.Document + ( Frontmatter, + OKFDocument (..), + OkfCommon (..), + okfCommon, + setResource, + setTags, + ) +import Okf.Index (writeBundleIndexes) +import Shikumi.Okf.Render (renderProgramBody) +import Shikumi.Okf.Types (AppInfo (..), ProgramDoc (..), ProgramManifest (..)) + +-- | Why bundle generation failed. +data GenerateError + = -- | A manifest name did not form a valid OKF concept id (carries the raw + -- @apps/@ or @programs/@ text and the underlying parse error). + InvalidConceptName Text ConceptIdError + | -- | Writing the bundle's @index.md@ files failed. + IndexWriteError BundleError + deriving stock (Eq, Show) + +-- | The concept id of a program: @programs/@. +programConceptId :: ProgramDoc -> Either GenerateError ConceptId +programConceptId doc = mkConceptId ("programs/" <> name doc) + +-- | The concept id of the application: @apps/@. +appConceptId :: AppInfo -> Either GenerateError ConceptId +appConceptId app = mkConceptId ("apps/" <> appName app) + +mkConceptId :: Text -> Either GenerateError ConceptId +mkConceptId raw = first (InvalidConceptName raw) (parseConceptId raw) + +-- | Build the @Shikumi Program@ concept for one documented program. +programConcept :: AppInfo -> Maybe Text -> ProgramDoc -> Either GenerateError Concept +programConcept app timestamp doc = do + cid <- programConceptId doc + let resource = + "shikumi://" <> appNamespace app <> "/" <> appName app <> "/programs/" <> name doc + frontmatter = + applyTags (tags doc) . setResource resource $ + okfCommon + OkfCommon + { commonType = "Shikumi Program", + commonTitle = Just (fromMaybe (name doc) (title doc)), + commonDescription = description doc, + commonTimestamp = timestamp + } + okfDoc = OKFDocument {frontmatter, body = renderProgramBody doc} + pure (conceptFromDocument cid okfDoc) + +-- | Build the @Shikumi App@ concept that links to every program. +appConcept :: AppInfo -> Maybe Text -> ProgramManifest -> Either GenerateError Concept +appConcept app timestamp (ProgramManifest docs) = do + cid <- appConceptId app + links <- traverse programLink docs + let appLabel = fromMaybe (appName app) (appTitle app) + resource = "shikumi://" <> appNamespace app <> "/" <> appName app + bodyLines = + ["# " <> appLabel] + <> maybe [] (\d -> ["", d]) (appDescription app) + <> ["", "## Programs", ""] + <> links + frontmatter = + setResource resource $ + okfCommon + OkfCommon + { commonType = "Shikumi App", + commonTitle = Just appLabel, + commonDescription = appDescription app, + commonTimestamp = timestamp + } + okfDoc = OKFDocument {frontmatter, body = T.unlines bodyLines} + pure (conceptFromDocument cid okfDoc) + where + programLink doc = do + pcid <- programConceptId doc + pure ("- " <> renderConceptLink pcid (fromMaybe (name doc) (title doc))) + +-- | All concepts for a manifest: the app concept first, then one per program. +generateBundle :: AppInfo -> Maybe Text -> ProgramManifest -> Either GenerateError [Concept] +generateBundle app timestamp manifest = do + appC <- appConcept app timestamp manifest + programCs <- traverse (programConcept app timestamp) (entries manifest) + pure (appC : programCs) + +-- | Generate the bundle and write it to @root@, then write its @index.md@ files. +-- Returns the first error encountered (an invalid name before any IO, or an index +-- write failure after the concept files are written). +writeProgramBundle :: + FilePath -> AppInfo -> Maybe Text -> ProgramManifest -> IO (Either GenerateError ()) +writeProgramBundle root app timestamp manifest = + case generateBundle app timestamp manifest of + Left err -> pure (Left err) + Right concepts -> do + writeBundle root concepts + indexResult <- writeBundleIndexes root + pure (first IndexWriteError indexResult) + +-- | Attach a @tags@ field only when there is at least one tag, so a program with +-- no tags does not emit an empty @tags: []@ list. +applyTags :: [Text] -> Frontmatter -> Frontmatter +applyTags [] frontmatter = frontmatter +applyTags ts frontmatter = setTags ts frontmatter diff --git a/src/Shikumi/Okf/Render.hs b/src/Shikumi/Okf/Render.hs new file mode 100644 --- /dev/null +++ b/src/Shikumi/Okf/Render.hs @@ -0,0 +1,112 @@ +-- | Render a documented program into the Markdown body of its OKF concept. +-- +-- The body has up to four parts: a heading, the author's prose description, a +-- declared-interface section (free-text input/output summaries), and a structure +-- section derived from the program value itself. The structure section is +-- best-effort: a typed @Predict@ pipeline yields a constructor tree and the +-- input/output field names of each model call, whereas an opaque @Embed@ program +-- (the shape an agent runtime produces) has no inspectable internals, so we say so +-- plainly rather than emit an empty section. The declared-interface fields are +-- what carry the documentary weight in that opaque case. +module Shikumi.Okf.Render + ( renderProgramBody, + ) +where + +import Data.List (intercalate) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Text qualified as T +import Shikumi.Okf.Types (ProgramDoc (..), SomeProgram (..)) +import Shikumi.Program + ( NodeFields (..), + ProgramShape (..), + nodeFieldsIndexed, + nodeInstructionsIndexed, + programShape, + ) + +-- | The full Markdown body for one program, with a trailing newline. +renderProgramBody :: ProgramDoc -> Text +renderProgramBody doc = + T.unlines (intercalate [""] sections) + where + sections :: [[Text]] + sections = + filter + (not . null) + [ ["# " <> fromMaybe (name doc) (title doc)], + maybe [] pure (description doc), + interfaceSection doc, + structureSection (program doc) + ] + +-- | The declared-interface section, present only when the author supplied at +-- least one of the free-text input/output summaries. +interfaceSection :: ProgramDoc -> [Text] +interfaceSection doc = + case (declaredInputs doc, declaredOutputs doc) of + (Nothing, Nothing) -> [] + (mi, mo) -> + ["## Interface", ""] + <> maybe [] (\t -> ["- Input: " <> t]) mi + <> maybe [] (\t -> ["- Output: " <> t]) mo + +-- | The structure section, derived from the program's run-free shape. A +-- metadata-only doc ('Nothing') has no program to reflect, so it says so. +structureSection :: Maybe SomeProgram -> [Text] +structureSection Nothing = + ["## Structure", "", "Documented from metadata only; program structure is not available."] +structureSection (Just (SomeProgram p)) = + ["## Structure", ""] <> bodyLines + where + bodyLines = case programShape p of + ShapeEmbed -> + ["Opaque embedded program (no inspectable internal structure)."] + sh -> + renderShapeTree 0 sh + <> modelCalls (zip (nodeFieldsIndexed p) (nodeInstructionsIndexed p)) + +-- | Render the constructor tree as a nested Markdown bullet list. Each level of +-- nesting is indented two spaces. +renderShapeTree :: Int -> ProgramShape -> [Text] +renderShapeTree depth shape = case shape of + ShapePredict label -> [bullet ("Predict — outputs: " <> label)] + ShapeCompose a b -> bullet "Compose" : descend a <> descend b + ShapeFMap a -> bullet "FMap (pure post-processing)" : descend a + ShapeMap width a -> bullet ("Map (concurrency width " <> tshow width <> ")") : descend a + ShapeParallel a b -> bullet "Parallel" : descend a <> descend b + ShapeRetry n a -> bullet ("Retry (up to " <> tshow n <> " attempts)") : descend a + ShapeRetryWhen n a -> bullet ("RetryWhen (up to " <> tshow n <> " attempts)") : descend a + ShapeValidate a -> bullet "Validate" : descend a + ShapeMajorityVote k _ a -> bullet ("MajorityVote (k=" <> tshow k <> ")") : descend a + ShapeEnsemble as -> bullet "Ensemble" : concatMap descend as + ShapeEmbed -> [bullet "Embed (opaque effectful program)"] + where + bullet t = T.replicate (depth * 2) " " <> "- " <> t + descend = renderShapeTree (depth + 1) + +-- | A "Model calls" subsection listing, for each @Predict@ node in order, its +-- input and output field names and its signature instruction (as a nested bullet). +-- Omitted when the program has no model calls. +modelCalls :: [(NodeFields, Text)] -> [Text] +modelCalls [] = [] +modelCalls calls = + "" : "### Model calls" : "" : concat (zipWith entry [1 :: Int ..] calls) + where + entry idx (nf, instruction) = + [ "- " + <> tshow idx + <> ". inputs (" + <> commaSep (inputFieldNames nf) + <> ") -> outputs (" + <> commaSep (outputFieldNames nf) + <> ")", + " - Instruction: " <> instruction + ] + +commaSep :: [Text] -> Text +commaSep = T.intercalate ", " + +tshow :: (Show a) => a -> Text +tshow = T.pack . show diff --git a/src/Shikumi/Okf/Types.hs b/src/Shikumi/Okf/Types.hs new file mode 100644 --- /dev/null +++ b/src/Shikumi/Okf/Types.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE GADTs #-} + +-- | The data the OKF generator consumes: a manifest of an application's named +-- programs plus the application's own identity. +-- +-- A shikumi @Program i o@ is a typed value with no name of its own, so the +-- generator cannot discover programs by itself. Instead an application supplies a +-- 'ProgramManifest': a list of 'ProgramDoc' entries, each naming a program and +-- carrying the human-authored metadata that documents it. The program itself is +-- held behind the constraint-free existential 'SomeProgram' — every function the +-- generator runs on it ('Shikumi.Program.programShape', +-- 'Shikumi.Program.nodeFieldsIndexed') is fully polymorphic in @i@/@o@, so no +-- class dictionaries are needed. That is what lets the manifest hold both a typed +-- @Predict@ pipeline and an opaque @Embed@-based @Program Value Value@ (the shape +-- downstream agent runtimes such as @shikigami@ produce) side by side. +module Shikumi.Okf.Types + ( SomeProgram (..), + ProgramDoc (..), + ProgramManifest (..), + AppInfo (..), + ) +where + +import Data.Text (Text) +import Shikumi.Program (Program) + +-- | A shikumi program with its input/output types hidden. The constructor places +-- no constraints on @i@/@o@ because the generator only ever inspects the program +-- structurally (constructor tree and per-node field names), never runs or +-- serializes it. +data SomeProgram where + SomeProgram :: Program i o -> SomeProgram + +-- | One documented program. 'name' is the concept-id leaf used in the bundle +-- (e.g. @"sentiment"@ becomes concept @programs/sentiment@), so it must be a valid +-- OKF concept-id segment (starts with @[A-Za-z0-9_]@; may then contain @[-._]@). +-- +-- 'declaredInputs' and 'declaredOutputs' are free-text summaries the author +-- supplies. They carry the documentary weight for opaque programs: an @Embed@ +-- agent has no inspectable internal structure, so without them its document would +-- describe almost nothing. +-- +-- 'program' is optional. 'Just' wraps a program whose structure the renderer can +-- reflect; 'Nothing' documents a program from metadata alone — used when a source +-- (such as a @handan@ task with no eval handle) names a program it cannot hand +-- over as a value. A metadata-only doc still produces a valid concept; its +-- structure section says the structure is unavailable. +data ProgramDoc = ProgramDoc + { name :: !Text, + title :: !(Maybe Text), + description :: !(Maybe Text), + tags :: ![Text], + declaredInputs :: !(Maybe Text), + declaredOutputs :: !(Maybe Text), + program :: !(Maybe SomeProgram) + } + +-- | An application's catalogue of documented programs, in the order they should +-- appear in the bundle. +newtype ProgramManifest = ProgramManifest + { entries :: [ProgramDoc] + } + +-- | The owning application's identity. Used to build the @Shikumi App@ concept and +-- the @shikumi://\/\@ resource URIs that tie every program +-- concept back to its application. +data AppInfo = AppInfo + { appNamespace :: !Text, + appName :: !Text, + appTitle :: !(Maybe Text), + appDescription :: !(Maybe Text) + } diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,306 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Tests for the OKF bundle generator (EP-31, Milestones 2 and 3). +-- +-- The fixtures deliberately mix the two program shapes the generator must handle: +-- a typed @Predict@ pipeline (rich structural reflection) and an opaque @Embed@ +-- program (the shape an agent runtime such as shikigami produces, where reflection +-- is thin and the declared metadata carries the documentation). +module Main (main) where + +import Control.Exception (IOException, catch) +import Data.List (sort) +import Data.Maybe (mapMaybe) +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Generics (Generic) +import Okf.Bundle (conceptIdOf, conceptResource, conceptType, walkBundle) +import Okf.ConceptId (ConceptId, parseConceptId, renderConceptId) +import Okf.Graph (Edge (..), Graph (..), buildGraph) +import Okf.Validation (ValidationProfile (PermissiveConformance), validateBundle) +import Shikumi.Adapter (ToPrompt) +import Shikumi.Module (predict) +import Shikumi.Okf.Generate (generateBundle, writeProgramBundle) +import Shikumi.Okf.Render (renderProgramBody) +import Shikumi.Okf.Types + ( AppInfo (..), + ProgramDoc (..), + ProgramManifest (..), + SomeProgram (..), + ) +import Shikumi.Program (Program, embed, pipeline) +import Shikumi.Schema (FromModel, ToSchema, Validatable) +import Shikumi.Signature (Signature, mkSignature) +import System.Directory + ( createDirectoryIfMissing, + getTemporaryDirectory, + removeDirectoryRecursive, + ) +import System.FilePath (()) +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.HUnit (assertBool, assertEqual, testCase, (@?=)) + +-- --------------------------------------------------------------------------- +-- Fixture record types and programs +-- --------------------------------------------------------------------------- + +newtype Question = Question {question :: Text} + deriving stock (Generic, Show, Eq) + +instance ToSchema Question + +instance FromModel Question + +instance ToPrompt Question + +instance Validatable Question + +newtype Answer = Answer {answer :: Text} + deriving stock (Generic, Show, Eq) + +instance ToSchema Answer + +instance FromModel Answer + +instance ToPrompt Answer + +instance Validatable Answer + +qaSig :: Signature Question Answer +qaSig = mkSignature "Answer the question." + +polishSig :: Signature Answer Answer +polishSig = mkSignature "Polish the answer." + +-- | A single model call. +qaProgram :: Program Question Answer +qaProgram = predict qaSig + +-- | A two-stage pipeline: answer, then polish. Exercises the Compose tree and +-- multiple model-call entries. +qaPolishedProgram :: Program Question Answer +qaPolishedProgram = pipeline (predict qaSig) (predict polishSig) + +-- | An opaque embedded program (the shikigami shape): no inspectable structure. +-- The lambda's polymorphic effect row is inferred from 'embed's rank-2 argument +-- type, so no local signature (which would be flagged redundant) is needed. +noopProgram :: Program () () +noopProgram = embed (\_ -> pure ()) + +-- --------------------------------------------------------------------------- +-- Fixture manifest +-- --------------------------------------------------------------------------- + +qaDoc :: ProgramDoc +qaDoc = + ProgramDoc + { name = "qa", + title = Just "Question Answering", + description = Just "Answers a question.", + tags = ["nlp"], + declaredInputs = Nothing, + declaredOutputs = Nothing, + program = Just (SomeProgram qaProgram) + } + +noopDoc :: ProgramDoc +noopDoc = + ProgramDoc + { name = "noop-summary", + title = Just "Noop Summary", + description = Just "Returns a fixed digest.", + tags = [], + declaredInputs = Just "Ignored trigger payload (JSON).", + declaredOutputs = Just "A fixed summary digest (JSON).", + program = Just (SomeProgram noopProgram) + } + +polishedDoc :: ProgramDoc +polishedDoc = + ProgramDoc + { name = "qa-polished", + title = Just "Polished QA", + description = Just "Answer then polish.", + tags = [], + declaredInputs = Nothing, + declaredOutputs = Nothing, + program = Just (SomeProgram qaPolishedProgram) + } + +-- | A metadata-only doc: no program value (the shape a handan task without an +-- eval handle produces). +metaOnlyDoc :: ProgramDoc +metaOnlyDoc = + ProgramDoc + { name = "legacy-task", + title = Just "Legacy Task", + description = Just "A task with no recoverable program.", + tags = [], + declaredInputs = Nothing, + declaredOutputs = Nothing, + program = Nothing + } + +demoApp :: AppInfo +demoApp = + AppInfo + { appNamespace = "shinzui", + appName = "demo", + appTitle = Just "Demo App", + appDescription = Just "A demo application." + } + +demoManifest :: ProgramManifest +demoManifest = ProgramManifest [qaDoc, noopDoc, polishedDoc] + +-- --------------------------------------------------------------------------- +-- Expected rendered bodies (inline goldens — self-contained, pin exact format) +-- --------------------------------------------------------------------------- + +expectedQaBody :: Text +expectedQaBody = + T.unlines + [ "# Question Answering", + "", + "Answers a question.", + "", + "## Structure", + "", + "- Predict — outputs: answer", + "", + "### Model calls", + "", + "- 1. inputs (question) -> outputs (answer)", + " - Instruction: Answer the question." + ] + +expectedNoopBody :: Text +expectedNoopBody = + T.unlines + [ "# Noop Summary", + "", + "Returns a fixed digest.", + "", + "## Interface", + "", + "- Input: Ignored trigger payload (JSON).", + "- Output: A fixed summary digest (JSON).", + "", + "## Structure", + "", + "Opaque embedded program (no inspectable internal structure)." + ] + +-- --------------------------------------------------------------------------- +-- Tests +-- --------------------------------------------------------------------------- + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = + testGroup + "shikumi-okf" + [ testGroup + "Render" + [ testCase "typed Predict body (golden)" $ + renderProgramBody qaDoc @?= expectedQaBody, + testCase "opaque Embed body (golden)" $ + renderProgramBody noopDoc @?= expectedNoopBody, + testCase "Compose tree renders both model calls" $ do + let body = renderProgramBody polishedDoc + assertBool "has Compose" ("- Compose" `T.isInfixOf` body) + assertBool "nests Predict" (" - Predict — outputs: answer" `T.isInfixOf` body) + assertBool "first call" ("inputs (question) -> outputs (answer)" `T.isInfixOf` body) + assertBool "second call" ("inputs (answer) -> outputs (answer)" `T.isInfixOf` body) + assertBool "first instruction" (" - Instruction: Answer the question." `T.isInfixOf` body) + assertBool "second instruction" (" - Instruction: Polish the answer." `T.isInfixOf` body), + testCase "metadata-only body (no program) states structure unavailable" $ do + let body = renderProgramBody metaOnlyDoc + assertBool "header" ("# Legacy Task" `T.isInfixOf` body) + assertBool + "structure note" + ("Documented from metadata only; program structure is not available." `T.isInfixOf` body) + ], + testGroup + "Generate" + [ testCase "generated bundle has no validation errors" $ + case generateBundle demoApp Nothing demoManifest of + Left err -> fail ("generateBundle failed: " <> show err) + Right concepts -> + validateBundle PermissiveConformance concepts @?= [], + testCase "one app concept plus one per program" $ + case generateBundle demoApp Nothing demoManifest of + Left err -> fail (show err) + Right concepts -> do + let ids = map (renderConceptId . conceptIdOf) concepts + assertEqual + "concept ids" + ["apps/demo", "programs/qa", "programs/noop-summary", "programs/qa-polished"] + ids + ], + testGroup + "Conformance" + -- Hermetic invariants matching profile/shikumi.dhall (the .dhall profile + -- itself is enforced end-to-end by `okf validate --profile-enforce`; this + -- asserts the same conventions in-process without dhall or a file path). + [ testCase "types and resource scheme match the shikumi profile" $ + case generateBundle demoApp Nothing demoManifest of + Left err -> fail (show err) + Right (appC : programCs) -> do + conceptType appC @?= "Shikumi App" + mapM_ (\c -> conceptType c @?= "Shikumi Program") programCs + let resources = map conceptResource (appC : programCs) + assertBool + "every resource uses the shikumi:// scheme" + (all (maybe False ("shikumi://" `T.isPrefixOf`)) resources) + Right [] -> fail "expected at least the app concept" + ], + testGroup + "RoundTrip" + [ testCase "app links to every program (graph edges)" $ do + root <- freshTempDir "shikumi-okf-roundtrip" + result <- writeProgramBundle root demoApp Nothing demoManifest + case result of + Left err -> fail ("writeProgramBundle failed: " <> show err) + Right () -> do + walked <- walkBundle root + case walked of + Left err -> fail ("walkBundle failed: " <> show err) + Right concepts -> do + let graph = buildGraph concepts + assertEqual "node count (app + 3 programs)" 4 (length (nodes graph)) + appId <- expectConceptId "apps/demo" + let targetsFromApp = + mapMaybe + (\e -> if source e == appId then Just (renderConceptId (target e)) else Nothing) + (edges graph) + -- Compare as a set: buildGraph orders edges by target, which is + -- not the manifest order, but every app->program edge must exist. + assertEqual + "app -> program edges" + (sort ["programs/qa", "programs/noop-summary", "programs/qa-polished"]) + (sort targetsFromApp) + ] + ] + +-- --------------------------------------------------------------------------- +-- Helpers +-- --------------------------------------------------------------------------- + +-- | A clean temp directory (removed if it exists), so the round-trip test is +-- idempotent across runs. +freshTempDir :: FilePath -> IO FilePath +freshTempDir name = do + base <- getTemporaryDirectory + let root = base name + removeDirectoryRecursive root `catch` \(_ :: IOException) -> pure () + createDirectoryIfMissing True root + pure root + +expectConceptId :: Text -> IO ConceptId +expectConceptId raw = + case parseConceptId raw of + Right cid -> pure cid + Left err -> fail ("bad concept id in test: " <> show err)