packages feed

seihou-core-0.4.0.0: test/Seihou/Dhall/EvalSpec.hs

module Seihou.Dhall.EvalSpec (tests) where

import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Seihou.Core.Types
import Seihou.Dhall.Eval (evalDhallExpr, evalModuleFromFile, evalRecipeFromFile)
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.Dhall.Eval" spec

fixtureDir :: FilePath
fixtureDir = "test/fixtures"

-- | Build a minimal @module.dhall@ source containing a single variable with the
-- given name, declared type string, and @default@ Dhall expression (e.g.
-- @"Some \"true\""@ or @"None Text"@).
moduleWithVar :: String -> String -> String -> String
moduleWithVar varName varType defaultExpr =
  "{ name = \"var-test\"\n\
  \, version = None Text\n\
  \, description = None Text\n\
  \, vars =\n\
  \  [ { name = \""
    ++ varName
    ++ "\"\n\
       \    , type = \""
    ++ varType
    ++ "\"\n\
       \    , default = "
    ++ defaultExpr
    ++ "\n\
       \    , description = None Text\n\
       \    , required = False\n\
       \    , validation = None Text\n\
       \    }\n\
       \  ]\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\
       \, removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }\n\
       \}"

spec :: Spec
spec = do
  describe "evalDhallExpr (spike)" $ do
    it "decodes a simple Dhall record with name and version" $ do
      result <- evalDhallExpr "{ name = \"my-project\", version = \"0.1.0\" }"
      Map.lookup "name" result `shouldBe` Just "my-project"
      Map.lookup "version" result `shouldBe` Just "0.1.0"

  describe "evalModuleFromFile" $ do
    it "decodes the haskell-base fixture module" $ do
      result <- evalModuleFromFile (fixtureDir </> "haskell-base" </> "module.dhall")
      case result of
        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
        Right m -> do
          m.name `shouldBe` ModuleName "haskell-base"
          m.description `shouldBe` Just "A Haskell project template"
          length (m.vars) `shouldBe` 3
          length (m.prompts) `shouldBe` 1
          length (m.steps) `shouldBe` 5
          length (m.exports) `shouldBe` 1
          m.dependencies `shouldBe` []

    it "decodes variable declarations correctly" $ do
      result <- evalModuleFromFile (fixtureDir </> "haskell-base" </> "module.dhall")
      case result of
        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
        Right m -> do
          let (projectName : projectVersion : _) = m.vars
          projectName.name `shouldBe` VarName "project.name"
          projectName.type_ `shouldBe` VTText
          projectName.default_ `shouldBe` Nothing
          projectName.required `shouldBe` True
          projectName.validation `shouldBe` Just (ValPattern "[a-z][a-z0-9-]*")

          projectVersion.name `shouldBe` VarName "project.version"
          projectVersion.default_ `shouldBe` Just (VText "0.1.0.0")
          projectVersion.required `shouldBe` False

    it "decodes steps with correct strategy" $ do
      result <- evalModuleFromFile (fixtureDir </> "haskell-base" </> "module.dhall")
      case result of
        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
        Right m -> do
          let (readme : libStep : licenseStep : _) = m.steps
          readme.strategy `shouldBe` Template
          readme.src `shouldBe` "README.md.tpl"
          readme.dest `shouldBe` "README.md"
          readme.condition `shouldBe` Nothing
          readme.patch `shouldBe` Nothing

          libStep.strategy `shouldBe` Template
          libStep.src `shouldBe` "src/Lib.hs.tpl"
          libStep.dest `shouldBe` "src/Lib.hs"
          libStep.patch `shouldBe` Nothing

          licenseStep.strategy `shouldBe` Copy
          licenseStep.src `shouldBe` "LICENSE"
          licenseStep.dest `shouldBe` "LICENSE"
          licenseStep.condition `shouldBe` Just (ExprIsSet "license")
          licenseStep.patch `shouldBe` Nothing

    it "decodes exports correctly" $ do
      result <- evalModuleFromFile (fixtureDir </> "haskell-base" </> "module.dhall")
      case result of
        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
        Right m -> do
          let (export1 : _) = m.exports
          export1.var `shouldBe` VarName "project.name"
          export1.alias `shouldBe` Nothing

    it "returns DhallEvalError for nonexistent file" $ do
      result <- evalModuleFromFile "/nonexistent/path/module.dhall"
      case result of
        Left (DhallEvalError _ _) -> pure ()
        Left other -> expectationFailure ("Expected DhallEvalError, got: " <> show other)
        Right _ -> expectationFailure "Expected Left, got Right"

    it "returns Left for unknown var type (not a crash)" $ do
      result <- evalModuleFromFile (fixtureDir </> "bad-vartype" </> "module.dhall")
      case result of
        Left (DhallEvalError _ msg) ->
          T.isInfixOf "strng" msg `shouldBe` True
        Left other -> expectationFailure ("Expected DhallEvalError, got: " <> show other)
        Right _ -> expectationFailure "Expected Left for bad var type"

    it "returns Left for unknown strategy (not a crash)" $ do
      result <- evalModuleFromFile (fixtureDir </> "bad-strategy" </> "module.dhall")
      case result of
        Left (DhallEvalError _ msg) ->
          T.isInfixOf "coppy" msg `shouldBe` True
        Left other -> expectationFailure ("Expected DhallEvalError, got: " <> show other)
        Right _ -> expectationFailure "Expected Left for bad strategy"

    it "decodes prompts correctly" $ do
      result <- evalModuleFromFile (fixtureDir </> "haskell-base" </> "module.dhall")
      case result of
        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
        Right m -> do
          let (prompt1 : _) = m.prompts
          prompt1.var `shouldBe` VarName "project.name"
          prompt1.text `shouldBe` "What is the project name?"
          prompt1.condition `shouldBe` Nothing
          prompt1.choices `shouldBe` Nothing

    it "decodes step with patch = Some \"append-file\"" $ do
      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do
        createDirectoryIfMissing True (tmpDir </> "files")
        writeFile (tmpDir </> "files" </> "section.tpl") "section content"
        let dhall =
              "{ name = \"patch-test\"\n\
              \, version = None Text\n\
              \, description = None Text\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 =\n\
              \  [ { strategy = \"template\"\n\
              \    , src = \"section.tpl\"\n\
              \    , dest = \"README.md\"\n\
              \    , when = None Text\n\
              \    , patch = Some \"append-file\"\n\
              \    }\n\
              \  , { strategy = \"template\"\n\
              \    , src = \"section.tpl\"\n\
              \    , dest = \"README.md\"\n\
              \    , when = None Text\n\
              \    , patch = Some \"prepend-file\"\n\
              \    }\n\
              \  , { strategy = \"template\"\n\
              \    , src = \"section.tpl\"\n\
              \    , dest = \"README.md\"\n\
              \    , when = None Text\n\
              \    , patch = Some \"append-section\"\n\
              \    }\n\
              \  ]\n\
              \, commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }\n\
              \, dependencies = [] : List Text\n\
              \, removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }\n\
              \}"
        writeFile (tmpDir </> "module.dhall") dhall
        result <- evalModuleFromFile (tmpDir </> "module.dhall")
        case result of
          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
          Right m -> do
            let (s1 : s2 : s3 : _) = m.steps
            s1.patch `shouldBe` Just AppendFile
            s2.patch `shouldBe` Just PrependFile
            s3.patch `shouldBe` Just AppendSection

    it "returns Left for unknown patch operation (not a crash)" $ do
      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do
        createDirectoryIfMissing True (tmpDir </> "files")
        writeFile (tmpDir </> "files" </> "section.tpl") "content"
        let dhall =
              "{ name = \"bad-patch\"\n\
              \, version = None Text\n\
              \, description = None Text\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 =\n\
              \  [ { strategy = \"template\"\n\
              \    , src = \"section.tpl\"\n\
              \    , dest = \"README.md\"\n\
              \    , when = None Text\n\
              \    , patch = Some \"invalid-op\"\n\
              \    }\n\
              \  ]\n\
              \, commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }\n\
              \, dependencies = [] : List Text\n\
              \, removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }\n\
              \}"
        writeFile (tmpDir </> "module.dhall") dhall
        result <- evalModuleFromFile (tmpDir </> "module.dhall")
        case result of
          Left (DhallEvalError _ msg) ->
            T.isInfixOf "invalid-op" msg `shouldBe` True
          Left other -> expectationFailure ("Expected DhallEvalError, got: " <> show other)
          Right _ -> expectationFailure "Expected Left for bad patch operation"

    it "coerces a bool default to VBool at decode time" $ do
      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do
        writeFile (tmpDir </> "module.dhall") (moduleWithVar "feature.on" "bool" "Some \"true\"")
        result <- evalModuleFromFile (tmpDir </> "module.dhall")
        case result of
          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
          Right m -> do
            let v = head m.vars
            v.type_ `shouldBe` VTBool
            v.default_ `shouldBe` Just (VBool True)

    it "coerces an int default to VInt at decode time" $ do
      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do
        writeFile (tmpDir </> "module.dhall") (moduleWithVar "retries" "int" "Some \"3\"")
        result <- evalModuleFromFile (tmpDir </> "module.dhall")
        case result of
          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
          Right m -> do
            let v = head m.vars
            v.type_ `shouldBe` VTInt
            v.default_ `shouldBe` Just (VInt 3)

    it "fails module load on a malformed bool default" $ do
      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do
        writeFile (tmpDir </> "module.dhall") (moduleWithVar "feature.on" "bool" "Some \"treu\"")
        result <- evalModuleFromFile (tmpDir </> "module.dhall")
        case result of
          Left (DhallEvalError _ msg) -> do
            T.isInfixOf "feature.on" msg `shouldBe` True
            T.isInfixOf "treu" msg `shouldBe` True
          Left other -> expectationFailure ("Expected DhallEvalError, got: " <> show other)
          Right _ -> expectationFailure "Expected Left for malformed bool default"

  describe "dependencyDecoder" $ do
    let emptyModuleWithDeps depsStr =
          "{ name = \"test-mod\"\n\
          \, version = None Text\n\
          \, description = None Text\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 = "
            ++ depsStr
            ++ "\n\
               \, removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }\n\
               \}"

    it "decodes a bare string dependency" $ do
      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do
        writeFile (tmpDir </> "module.dhall") (emptyModuleWithDeps "[\"base\"]")
        result <- evalModuleFromFile (tmpDir </> "module.dhall")
        case result of
          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
          Right m -> do
            length m.dependencies `shouldBe` 1
            let dep = head m.dependencies
            dep.depModule `shouldBe` ModuleName "base"
            Map.null dep.depVars `shouldBe` True

    it "decodes a parameterized record dependency" $ do
      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do
        writeFile (tmpDir </> "module.dhall") (emptyModuleWithDeps "[{ module = \"base\", vars = [{ name = \"x\", value = \"y\" }] }]")
        result <- evalModuleFromFile (tmpDir </> "module.dhall")
        case result of
          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
          Right m -> do
            length m.dependencies `shouldBe` 1
            let dep = head m.dependencies
            dep.depModule `shouldBe` ModuleName "base"
            Map.lookup (VarName "x") dep.depVars `shouldBe` Just "y"

    it "decodes a parameterized dependency with empty vars" $ do
      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do
        writeFile (tmpDir </> "module.dhall") (emptyModuleWithDeps "[{ module = \"base\", vars = [] : List { name : Text, value : Text } }]")
        result <- evalModuleFromFile (tmpDir </> "module.dhall")
        case result of
          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
          Right m -> do
            length m.dependencies `shouldBe` 1
            let dep = head m.dependencies
            dep.depModule `shouldBe` ModuleName "base"
            Map.null dep.depVars `shouldBe` True

    it "decodes a module.dhall with parameterized dependencies" $ do
      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do
        writeFile (tmpDir </> "module.dhall") (emptyModuleWithDeps "[{ module = \"child-mod\", vars = [{ name = \"skill.name\", value = \"exec-plan\" }] }]")
        result <- evalModuleFromFile (tmpDir </> "module.dhall")
        case result of
          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
          Right m -> do
            length m.dependencies `shouldBe` 1
            let dep = head m.dependencies
            dep.depModule `shouldBe` ModuleName "child-mod"
            Map.lookup (VarName "skill.name") dep.depVars `shouldBe` Just "exec-plan"

  describe "evalRecipeFromFile" $ do
    it "decodes the haskell-with-nix-recipe fixture" $ do
      result <- evalRecipeFromFile (fixtureDir </> "haskell-with-nix-recipe" </> "recipe.dhall")
      case result of
        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
        Right r -> do
          r.name `shouldBe` RecipeName "haskell-with-nix"
          r.version `shouldBe` Just "1.0.0"
          r.description `shouldBe` Just "Haskell project with Nix integration"
          length r.modules `shouldBe` 2
          let (m1 : m2 : _) = r.modules
          m1.depModule `shouldBe` ModuleName "haskell-base"
          Map.null m1.depVars `shouldBe` True
          m2.depModule `shouldBe` ModuleName "nix-flake"
          Map.null m2.depVars `shouldBe` True
          r.vars `shouldBe` []
          r.prompts `shouldBe` []

    it "decodes the haskell-pinned-recipe fixture with variable bindings" $ do
      result <- evalRecipeFromFile (fixtureDir </> "haskell-pinned-recipe" </> "recipe.dhall")
      case result of
        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
        Right r -> do
          r.name `shouldBe` RecipeName "haskell-pinned"
          length r.modules `shouldBe` 2
          let (m1 : m2 : _) = r.modules
          m1.depModule `shouldBe` ModuleName "haskell-base"
          Map.null m1.depVars `shouldBe` True
          m2.depModule `shouldBe` ModuleName "nix-flake"
          Map.lookup (VarName "nix.system") m2.depVars `shouldBe` Just "aarch64-darwin"

    it "returns DhallEvalError for nonexistent recipe file" $ do
      result <- evalRecipeFromFile "/nonexistent/path/recipe.dhall"
      case result of
        Left (DhallEvalError _ _) -> pure ()
        Left other -> expectationFailure ("Expected DhallEvalError, got: " <> show other)
        Right _ -> expectationFailure "Expected Left, got Right"

    it "decodes a recipe with recipe-level vars and prompts" $ do
      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do
        let dhall =
              "{ name = \"prompted-recipe\"\n\
              \, version = Some \"1.0.0\"\n\
              \, description = Some \"Recipe with prompts\"\n\
              \, modules =\n\
              \  [ { module = \"base\", vars = [] : List { name : Text, value : Text } }\n\
              \  ]\n\
              \, vars =\n\
              \  [ { name = \"project.name\"\n\
              \    , type = \"text\"\n\
              \    , default = None Text\n\
              \    , description = Some \"Project name\"\n\
              \    , required = True\n\
              \    , validation = None Text\n\
              \    }\n\
              \  ]\n\
              \, prompts =\n\
              \  [ { var = \"project.name\"\n\
              \    , text = \"What is the project name?\"\n\
              \    , when = None Text\n\
              \    , choices = None (List Text)\n\
              \    }\n\
              \  ]\n\
              \}"
        writeFile (tmpDir </> "recipe.dhall") dhall
        result <- evalRecipeFromFile (tmpDir </> "recipe.dhall")
        case result of
          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)
          Right r -> do
            r.name `shouldBe` RecipeName "prompted-recipe"
            length r.vars `shouldBe` 1
            let v = head r.vars
            v.name `shouldBe` VarName "project.name"
            v.type_ `shouldBe` VTText
            v.required `shouldBe` True
            length r.prompts `shouldBe` 1
            let p = head r.prompts
            p.var `shouldBe` VarName "project.name"
            p.text `shouldBe` "What is the project name?"