packages feed

seihou-cli-0.4.0.0: src/Seihou/CLI/Registry/Validate.hs

module Seihou.CLI.Registry.Validate
  ( ValidateRegistryOpts (..),
    ValidateOutcome (..),
    runValidate,
    handleValidate,
    renderValidationReport,
  )
where

import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import GHC.Generics (Generic)
import Seihou.CLI.Registry.Sync (resolveOnDiskVersions)
import Seihou.Core.Registry
  ( RegistryValidationIssue (..),
    RegistryValidationReport (..),
    RepoContents (..),
    discoverRepoContents,
    formatValidationIssue,
    reportHasIssues,
    validateRegistryFull,
  )
import Seihou.Dhall.Eval (evalRegistryFromFile)
import Seihou.Prelude
import System.Directory (doesDirectoryExist)
import System.Exit (ExitCode (..), exitWith)
import System.IO (hPutStrLn, stderr)

-- | Flags parsed for the @seihou registry validate@ subcommand.
data ValidateRegistryOpts = ValidateRegistryOpts
  { validateRegistryDir :: Maybe FilePath
  }
  deriving stock (Eq, Show, Generic)

-- | Terminal outcome of a validate run, decoupled from IO concerns like
-- printing and 'exitWith' so tests can assert without capturing stdout.
data ValidateOutcome
  = -- | Report ran. Caller decides exit code from 'reportHasIssues'.
    ValidateOk RegistryValidationReport
  | -- | Could not even start (no registry at target dir, etc.).
    ValidateFailed Text
  deriving stock (Eq, Show, Generic)

-- | Testable core of @seihou registry validate@. Locates the registry,
-- resolves each entry's on-disk version, and produces the unified report.
runValidate :: ValidateRegistryOpts -> IO ValidateOutcome
runValidate opts = do
  let target = maybe "." id opts.validateRegistryDir
  dirExists <- doesDirectoryExist target
  if not dirExists
    then pure (ValidateFailed ("target directory does not exist: " <> T.pack target))
    else do
      contents <- discoverRepoContents evalRegistryFromFile target
      case contents of
        MultiModule reg -> do
          lookups <- resolveOnDiskVersions target reg
          report <- validateRegistryFull target reg lookups
          pure (ValidateOk report)
        _ ->
          pure
            ( ValidateFailed
                "registry validate requires a seihou-registry.dhall at the target directory"
            )

-- | Handler wired into the CLI command dispatcher. Drives 'runValidate',
-- prints the report, and exits 0 or 1 based on 'reportHasIssues'.
handleValidate :: ValidateRegistryOpts -> IO ()
handleValidate opts = do
  outcome <- runValidate opts
  case outcome of
    ValidateFailed msg -> do
      hPutStrLn stderr ("error: " <> T.unpack msg)
      exitWith (ExitFailure 1)
    ValidateOk report -> do
      TIO.putStr (renderValidationReport report)
      if reportHasIssues report
        then exitWith (ExitFailure 1)
        else exitWith ExitSuccess

-- | Format the report for stdout. Mirrors the wording shown in the ExecPlan
-- example: an "OK" one-liner on success, an "errors:" list with a summary
-- line on failure.
renderValidationReport :: RegistryValidationReport -> Text
renderValidationReport r
  | null r.reportIssues =
      T.unlines
        [ "OK: "
            <> T.pack (show r.reportModuleCount)
            <> " "
            <> pluralize r.reportModuleCount "module" "modules"
            <> ", "
            <> T.pack (show r.reportRecipeCount)
            <> " "
            <> pluralize r.reportRecipeCount "recipe" "recipes"
            <> ", "
            <> T.pack (show r.reportBlueprintCount)
            <> " "
            <> pluralize r.reportBlueprintCount "blueprint" "blueprints"
            <> ", "
            <> T.pack (show r.reportPromptCount)
            <> " "
            <> pluralize r.reportPromptCount "prompt" "prompts"
            <> ", all versions in sync."
        ]
  | otherwise =
      T.unlines $
        ["errors:"]
          <> map (("  " <>) . formatValidationIssue) r.reportIssues
          <> [""]
          <> [summary r]

summary :: RegistryValidationReport -> Text
summary r =
  let n = length r.reportIssues
      hasVersionDrift = any isVersionMismatch r.reportIssues
      base = T.pack (show n) <> " " <> pluralize n "error" "errors"
      tail_ =
        if hasVersionDrift
          then ". Run `seihou registry sync-versions` to fix version drift."
          else "."
   in base <> tail_
  where
    isVersionMismatch (VersionMismatch _) = True
    isVersionMismatch _ = False

pluralize :: Int -> Text -> Text -> Text
pluralize 1 s _ = s
pluralize _ _ p = p