packages feed

seihou-cli-0.4.0.0: src-exe/Seihou/CLI/Vars.hs

module Seihou.CLI.Vars
  ( handleVars,
  )
where

import Control.Monad (when)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Seihou.CLI.Commands (VarsOpts (..))
import Seihou.CLI.Shared (deriveNamespace, formatVarError, logIO, toVarNameMap, unwrapConfig)
import Seihou.Composition.Instance (ModuleInstance (..))
import Seihou.Composition.Resolve (loadComposition, resolveWithPrompts)
import Seihou.Core.Context (resolveContext)
import Seihou.Core.Module (defaultSearchPaths, discoverRunnable)
import Seihou.Core.Types
import Seihou.Core.Variable (diagnoseResolution, formatDeclarations, formatExplain)
import Seihou.Effect.ConfigReader (readContextConfig, readGlobalConfig, readLocalConfig, readNamespaceConfig)
import Seihou.Effect.ConfigReaderInterp (runConfigReader)
import Seihou.Effect.ConsoleInterp (runConsole)
import Seihou.Effect.FzfInterp (runFzfIO)
import Seihou.Effect.Logger (logError, logInfo)
import Seihou.Fzf (FzfResult (..), detectFzfConfig, isFzfUsable)
import Seihou.Fzf.Selector (selectModule)
import Seihou.Prelude
import System.Environment (getEnvironment)
import System.Exit (ExitCode (..), exitFailure, exitWith)

handleVars :: VarsOpts -> IO ()
handleVars vopts = do
  -- Resolve module name (from argument or fzf picker)
  modName <- case vopts.varsModule of
    Just name -> pure name
    Nothing -> do
      fzfCfg <- detectFzfConfig
      if isFzfUsable fzfCfg
        then do
          result <- runEff $ runFzfIO fzfCfg $ selectModule
          case result of
            FzfSelected name -> pure name
            FzfCancelled -> exitWith ExitSuccess
            FzfNoMatch -> do
              logIO LogNormal (logError "No modules found.")
              exitFailure
            FzfError err -> do
              logIO LogNormal (logError $ "fzf error: " <> err)
              exitFailure
        else do
          logIO LogNormal (logError "MODULE argument is required when fzf is not available.")
          exitFailure

  -- Resolve the runnable's kind first so we can dispatch correctly:
  -- modules go through the existing module/composition pipeline,
  -- recipes show their declared vars in declaration mode, and
  -- blueprints get their own declaration-mode formatter and refuse
  -- @--explain@ entirely (resolving a blueprint's variables is the
  -- agent runner's job, not vars').
  searchPaths <- defaultSearchPaths
  discResult <- discoverRunnable searchPaths modName
  case discResult of
    Left (ModuleNotFound _ searched) -> do
      logIO LogNormal $ do
        logError $ "Module '" <> modName.unModuleName <> "' not found."
        logError "Searched in:"
        mapM_ (\p -> logError $ "  " <> T.pack p) searched
      exitFailure
    Left err -> do
      logIO LogNormal (logError $ T.pack (show err))
      exitFailure
    Right (RunnableModule m _) ->
      if vopts.varsExplain
        then explainMode modName vopts
        else declarationModeModule m
    Right (RunnableRecipe r _) ->
      if vopts.varsExplain
        then explainMode modName vopts
        else declarationModeRecipe r
    Right (RunnableBlueprint b _) ->
      if vopts.varsExplain
        then do
          logIO LogNormal $ do
            logError $ "'" <> modName.unModuleName <> "' is a blueprint; --explain is not supported in this release."
            logError "Resolving a blueprint's variables requires the agent runner."
            logError "Run `seihou agent run <blueprint>` instead (when EP-31 ships)."
            logError "For a read-only listing of declared variables, omit --explain."
          exitFailure
        else declarationModeBlueprint b

-- | Declaration mode for a module: list declared variables.
declarationModeModule :: Module -> IO ()
declarationModeModule modul = do
  let vs = modul.vars
  if null vs
    then TIO.putStrLn "No variables declared."
    else do
      TIO.putStrLn $ "Variables for " <> modul.name.unModuleName <> ":"
      TIO.putStrLn ""
      TIO.putStr (formatDeclarations vs)

-- | Declaration mode for a recipe: list its declared variables. Recipes
-- carry their own @vars@ list (separately from the modules they
-- compose); this prints those without expanding the recipe.
declarationModeRecipe :: Recipe -> IO ()
declarationModeRecipe r = do
  let vs = r.vars
  if null vs
    then TIO.putStrLn "No variables declared."
    else do
      TIO.putStrLn $ "Variables for " <> r.name.unRecipeName <> " (recipe):"
      TIO.putStrLn ""
      TIO.putStr (formatDeclarations vs)

-- | Declaration mode for a blueprint: list its declared variables. The
-- blueprint kind is surfaced in the heading so users can tell at a
-- glance that this is the agent-driven runnable, not a module/recipe.
declarationModeBlueprint :: Blueprint -> IO ()
declarationModeBlueprint b = do
  let vs = b.vars
  if null vs
    then TIO.putStrLn "No variables declared."
    else do
      TIO.putStrLn $ "Variables for " <> b.name.unModuleName <> " (blueprint):"
      TIO.putStrLn ""
      TIO.putStr (formatDeclarations vs)

-- | Explain mode: load full composition, resolve variables with exports, show provenance
explainMode :: ModuleName -> VarsOpts -> IO ()
explainMode modName vopts = do
  -- Load the full composition (target module + transitive dependencies)
  searchPaths <- defaultSearchPaths
  compositionResult <- loadComposition searchPaths modName []
  modulesInOrder <- case compositionResult of
    Left (ModuleNotFound name searched) -> do
      logIO LogNormal $ do
        logError $ "Module '" <> name.unModuleName <> "' not found."
        logError "Searched in:"
        mapM_ (\p -> logError $ "  " <> T.pack p) searched
      exitFailure
    Left (CircularDependency names) -> do
      logIO LogNormal $ do
        logError "Circular dependency detected:"
        logError $ "  " <> T.intercalate " -> " (map (.unModuleName) names)
      exitFailure
    Left err -> do
      logIO LogNormal (logError $ T.pack (show err))
      exitFailure
    Right ms -> pure ms

  -- Report composition when multiple modules are involved
  when (length modulesInOrder > 1) $
    logIO LogNormal $
      logInfo $
        "Resolving with "
          <> T.pack (show (length modulesInOrder))
          <> " modules in composition"

  -- Resolve variables with the full composition pipeline
  envPairs <- getEnvironment
  let cliOverrides = Map.fromList [(VarName k, v) | (k, v) <- vopts.varsVars]
      envVars = Map.fromList [(T.pack k, T.pack v) | (k, v) <- envPairs]
      namespace = fromMaybe (deriveNamespace modName) vopts.varsNamespace
  context <- resolveContext vopts.varsContext envVars
  let contextName = fromMaybe "" context
  (resolveResult, localMap, nsMap, ctxMap, globalMap) <- runEff $ runConfigReader $ runConsole $ do
    localCfg <- readLocalConfig >>= unwrapConfig LogNormal
    namespaceCfg <- readNamespaceConfig namespace >>= unwrapConfig LogNormal
    contextCfg <- readContextConfig contextName >>= unwrapConfig LogNormal
    globalCfg <- readGlobalConfig >>= unwrapConfig LogNormal
    let lm = toVarNameMap localCfg
        nm = toVarNameMap namespaceCfg
        cm = toVarNameMap contextCfg
        gm = toVarNameMap globalCfg
    r <- resolveWithPrompts modulesInOrder cliOverrides envVars namespace contextName lm nm cm gm
    pure (r, lm, nm, cm, gm)
  case resolveResult of
    Left errs -> do
      logIO LogNormal $ do
        logError "Error resolving variables:"
        mapM_ (logError . ("  " <>) . formatVarError) errs
      exitFailure
    Right resolved -> do
      -- Show only the target module's resolved variables. `seihou vars` is
      -- scoped to a module name, so if multiple instances exist we merge
      -- their resolved maps (last wins on overlap — matches how a user
      -- reads "the variables of module X" before any disambiguation UI).
      let targetResolved =
            Map.unions
              [ vs
              | (inst, vs) <- Map.toList resolved,
                inst.instanceModule == modName
              ]
      TIO.putStrLn $ "Variables for " <> modName.unModuleName <> ":"
      TIO.putStrLn ""
      if Map.null targetResolved
        then TIO.putStrLn "  (no variables resolved)"
        else TIO.putStr (formatExplain targetResolved)

      -- Show diagnostics
      let allDecls = concatMap (\(_, m, _) -> m.vars) modulesInOrder
          allResolved = Map.unions [vs | vs <- Map.elems resolved]
          (unusedKeys, unresolvedOpt) = diagnoseResolution allResolved allDecls localMap nsMap ctxMap globalMap
      when (not (null unusedKeys)) $ do
        TIO.putStrLn ""
        TIO.putStrLn "Unused config keys (not matching any declared variable):"
        mapM_ (\(VarName n) -> TIO.putStrLn $ "  " <> n) unusedKeys
      when (not (null unresolvedOpt)) $ do
        TIO.putStrLn ""
        TIO.putStrLn "Unresolved optional variables:"
        mapM_ (\(VarName n) -> TIO.putStrLn $ "  " <> n) unresolvedOpt