packages feed

seihou-core-0.4.0.0: test/Seihou/Core/ScaffoldSpec.hs

module Seihou.Core.ScaffoldSpec (tests) where

import Data.Text qualified as T
import Seihou.Core.AgentPrompt (validateAgentPrompt)
import Seihou.Core.Blueprint (validateBlueprint)
import Seihou.Core.Module (validateModule)
import Seihou.Core.Scaffold (blueprintDhall, exampleAgentPromptMarkdown, examplePromptMarkdown, moduleDhall, promptDhall, readmeTemplate)
import Seihou.Core.Types
import Seihou.Dhall.Eval (evalAgentPromptFromFile, evalBlueprintFromFile, evalModuleFromFile)
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, makeAbsolute)
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.Core.Scaffold" spec

-- | Resolve the local schema path for tests, trying both package-relative and
-- project root-relative locations (like mori's fixturePath pattern).
-- Uses an absolute path since generated Dhall is written to a temp directory.
resolveSchemaPath :: IO T.Text
resolveSchemaPath = do
  let pkgRelative = "../schema/package.dhall"
      rootRelative = "schema/package.dhall"
  pkgExists <- doesDirectoryExist "../schema"
  path <-
    if pkgExists
      then makeAbsolute pkgRelative
      else makeAbsolute rootRelative
  pure (T.pack path)

spec :: Spec
spec = do
  describe "moduleDhall" $ do
    it "generates Dhall that includes schema import" $ do
      schemaPath <- resolveSchemaPath
      let content = moduleDhall "test-mod" schemaPath ""
      T.isInfixOf "let S =" content `shouldBe` True
      T.isInfixOf "S.Module::" content `shouldBe` True

    it "generates Dhall that loads via evalModuleFromFile" $ do
      schemaPath <- resolveSchemaPath
      withSystemTempDirectory "seihou-scaffold-test" $ \tmpDir -> do
        let modDir = tmpDir </> "test-mod"
            dhallFile = modDir </> "module.dhall"
            filesDir = modDir </> "files"
        createDirectoryIfMissing True filesDir
        writeFile dhallFile (T.unpack (moduleDhall "test-mod" schemaPath ""))
        writeFile (filesDir </> "README.md.tpl") (T.unpack readmeTemplate)
        result <- evalModuleFromFile dhallFile
        case result of
          Left err -> expectationFailure $ "Failed to load generated module: " ++ show err
          Right m -> m.name `shouldBe` "test-mod"

    it "generates a module that passes validateModule" $ do
      schemaPath <- resolveSchemaPath
      withSystemTempDirectory "seihou-scaffold-test" $ \tmpDir -> do
        let modDir = tmpDir </> "test-mod"
            dhallFile = modDir </> "module.dhall"
            filesDir = modDir </> "files"
        createDirectoryIfMissing True filesDir
        writeFile dhallFile (T.unpack (moduleDhall "test-mod" schemaPath ""))
        writeFile (filesDir </> "README.md.tpl") (T.unpack readmeTemplate)
        result <- evalModuleFromFile dhallFile
        case result of
          Left err -> expectationFailure $ "Failed to load: " ++ show err
          Right m -> do
            validated <- validateModule modDir m
            case validated of
              Left err -> expectationFailure $ "Validation failed: " ++ show err
              Right _ -> pure ()

    it "generates expected module structure" $ do
      schemaPath <- resolveSchemaPath
      withSystemTempDirectory "seihou-scaffold-test" $ \tmpDir -> do
        let modDir = tmpDir </> "test-mod"
            dhallFile = modDir </> "module.dhall"
            filesDir = modDir </> "files"
        createDirectoryIfMissing True filesDir
        writeFile dhallFile (T.unpack (moduleDhall "test-mod" schemaPath ""))
        writeFile (filesDir </> "README.md.tpl") (T.unpack readmeTemplate)
        result <- evalModuleFromFile dhallFile
        case result of
          Left err -> expectationFailure $ "Failed to load: " ++ show err
          Right m -> do
            length (m.vars) `shouldBe` 1
            map (.name) m.vars `shouldBe` ["project.name"]
            length (m.steps) `shouldBe` 1
            length (m.prompts) `shouldBe` 1
            length (m.commands) `shouldBe` 0
            length (m.exports) `shouldBe` 0
            length (m.dependencies) `shouldBe` 0

  describe "readmeTemplate" $ do
    it "contains the project.name placeholder" $ do
      T.isInfixOf "{{project.name}}" readmeTemplate `shouldBe` True

  describe "blueprintDhall" $ do
    it "generates Dhall that imports the schema and uses Blueprint::" $ do
      schemaPath <- resolveSchemaPath
      let content = blueprintDhall "test-bp" schemaPath ""
      T.isInfixOf "let S =" content `shouldBe` True
      T.isInfixOf "S.Blueprint::" content `shouldBe` True

    it "imports prompt.md as Text rather than inlining the body" $ do
      schemaPath <- resolveSchemaPath
      let content = blueprintDhall "test-bp" schemaPath ""
      T.isInfixOf "./prompt.md as Text" content `shouldBe` True

    it "decodes via evalBlueprintFromFile when prompt.md is present" $ do
      schemaPath <- resolveSchemaPath
      withSystemTempDirectory "seihou-blueprint-scaffold-test" $ \tmpDir -> do
        let bpDir = tmpDir </> "test-bp"
            dhallFile = bpDir </> "blueprint.dhall"
            filesDir = bpDir </> "files"
        createDirectoryIfMissing True filesDir
        writeFile dhallFile (T.unpack (blueprintDhall "test-bp" schemaPath ""))
        writeFile (bpDir </> "prompt.md") (T.unpack examplePromptMarkdown)
        result <- evalBlueprintFromFile dhallFile
        case result of
          Left err -> expectationFailure $ "Failed to load generated blueprint: " ++ show err
          Right b -> b.name `shouldBe` "test-bp"

    it "produces a blueprint that passes validateBlueprint" $ do
      schemaPath <- resolveSchemaPath
      withSystemTempDirectory "seihou-blueprint-scaffold-test" $ \tmpDir -> do
        let bpDir = tmpDir </> "test-bp"
            dhallFile = bpDir </> "blueprint.dhall"
            filesDir = bpDir </> "files"
        createDirectoryIfMissing True filesDir
        writeFile dhallFile (T.unpack (blueprintDhall "test-bp" schemaPath ""))
        writeFile (bpDir </> "prompt.md") (T.unpack examplePromptMarkdown)
        result <- evalBlueprintFromFile dhallFile
        case result of
          Left err -> expectationFailure $ "Failed to load: " ++ show err
          Right b -> do
            validated <- validateBlueprint bpDir b
            case validated of
              Left err -> expectationFailure $ "Validation failed: " ++ show err
              Right _ -> pure ()

    it "produces the expected blueprint structure (1 var, 1 prompt, 0 base modules, 0 files)" $ do
      schemaPath <- resolveSchemaPath
      withSystemTempDirectory "seihou-blueprint-scaffold-test" $ \tmpDir -> do
        let bpDir = tmpDir </> "test-bp"
            dhallFile = bpDir </> "blueprint.dhall"
            filesDir = bpDir </> "files"
        createDirectoryIfMissing True filesDir
        writeFile dhallFile (T.unpack (blueprintDhall "test-bp" schemaPath ""))
        writeFile (bpDir </> "prompt.md") (T.unpack examplePromptMarkdown)
        result <- evalBlueprintFromFile dhallFile
        case result of
          Left err -> expectationFailure $ "Failed to load: " ++ show err
          Right b -> do
            length (b.vars) `shouldBe` 1
            map (.name) b.vars `shouldBe` ["project.name"]
            length (b.prompts) `shouldBe` 1
            length (b.baseModules) `shouldBe` 0
            length (b.files) `shouldBe` 0
            length (b.tags) `shouldBe` 0

  describe "examplePromptMarkdown" $ do
    it "contains the {{project.name}} placeholder so authors see substitution" $ do
      T.isInfixOf "{{project.name}}" examplePromptMarkdown `shouldBe` True

    it "is non-empty after trimming (would otherwise fail prompt-non-empty validation)" $ do
      T.null (T.strip examplePromptMarkdown) `shouldBe` False

  describe "promptDhall" $ do
    it "generates self-contained Dhall with prompt-specific type aliases" $ do
      schemaPath <- resolveSchemaPath
      let content = promptDhall "review-changes" schemaPath ""
      T.isInfixOf "let Prompt =" content `shouldBe` True
      T.isInfixOf "let CommandVar =" content `shouldBe` True

    it "imports prompt.md as Text rather than inlining the body" $ do
      schemaPath <- resolveSchemaPath
      let content = promptDhall "review-changes" schemaPath ""
      T.isInfixOf "./prompt.md as Text" content `shouldBe` True

    it "decodes via evalAgentPromptFromFile when prompt.md is present" $ do
      schemaPath <- resolveSchemaPath
      withSystemTempDirectory "seihou-prompt-scaffold-test" $ \tmpDir -> do
        let promptDir = tmpDir </> "review-changes"
            dhallFile = promptDir </> "prompt.dhall"
            filesDir = promptDir </> "files"
        createDirectoryIfMissing True filesDir
        writeFile dhallFile (T.unpack (promptDhall "review-changes" schemaPath ""))
        writeFile (promptDir </> "prompt.md") (T.unpack exampleAgentPromptMarkdown)
        result <- evalAgentPromptFromFile dhallFile
        case result of
          Left err -> expectationFailure $ "Failed to load generated prompt: " ++ show err
          Right p -> p.name `shouldBe` "review-changes"

    it "produces a prompt that passes validateAgentPrompt" $ do
      schemaPath <- resolveSchemaPath
      withSystemTempDirectory "seihou-prompt-scaffold-test" $ \tmpDir -> do
        let promptDir = tmpDir </> "review-changes"
            dhallFile = promptDir </> "prompt.dhall"
            filesDir = promptDir </> "files"
        createDirectoryIfMissing True filesDir
        writeFile dhallFile (T.unpack (promptDhall "review-changes" schemaPath ""))
        writeFile (promptDir </> "prompt.md") (T.unpack exampleAgentPromptMarkdown)
        result <- evalAgentPromptFromFile dhallFile
        case result of
          Left err -> expectationFailure $ "Failed to load: " ++ show err
          Right p -> do
            validated <- validateAgentPrompt promptDir p
            case validated of
              Left err -> expectationFailure $ "Validation failed: " ++ show err
              Right _ -> pure ()

    it "produces the expected prompt structure" $ do
      schemaPath <- resolveSchemaPath
      withSystemTempDirectory "seihou-prompt-scaffold-test" $ \tmpDir -> do
        let promptDir = tmpDir </> "review-changes"
            dhallFile = promptDir </> "prompt.dhall"
            filesDir = promptDir </> "files"
        createDirectoryIfMissing True filesDir
        writeFile dhallFile (T.unpack (promptDhall "review-changes" schemaPath ""))
        writeFile (promptDir </> "prompt.md") (T.unpack exampleAgentPromptMarkdown)
        result <- evalAgentPromptFromFile dhallFile
        case result of
          Left err -> expectationFailure $ "Failed to load: " ++ show err
          Right p -> do
            length (p.vars) `shouldBe` 1
            map (.name) p.vars `shouldBe` ["project.name"]
            length (p.prompts) `shouldBe` 0
            length (p.commandVars) `shouldBe` 0
            length (p.files) `shouldBe` 0
            length (p.tags) `shouldBe` 0

  describe "exampleAgentPromptMarkdown" $ do
    it "contains the {{project.name}} placeholder so debug rendering shows substitution" $ do
      T.isInfixOf "{{project.name}}" exampleAgentPromptMarkdown `shouldBe` True

    it "is non-empty after trimming" $ do
      T.null (T.strip exampleAgentPromptMarkdown) `shouldBe` False