Vars.hs

module Seihou.CLI.Vars
  ( handleVars,
  )
where

import Control.Monad (when)
import Data.Generics.Labels ()
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.CLI.ValidateRecipeReport (recipeLoadErrorText)
import Seihou.Composition.Instance (ModuleInstance (..))
import Seihou.Composition.Recipe (ExpandedRecipe (..), recipeLiteralSources)
import Seihou.Composition.RecipeChain (loadRecipeChain)
import Seihou.Composition.Resolve (PromptPermission (..), RecipeInputSpec (..), loadComposition, resolveRecipeWithSources, 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.Directory (getCurrentDirectory)
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 ^. #module_ 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 ^. #explain
        then explainMode modName vopts Nothing
        else declarationModeModule m
    Right (RunnableRecipe r dir) ->
      if not (vopts ^. #explain) && r ^. #extends == Nothing
        then declarationModeRecipe r
        else do
          root <- getCurrentDirectory
          expanded <- loadRecipeChain root searchPaths r dir
          case expanded of
            Left err -> logIO LogNormal (logError (recipeLoadErrorText err)) >> exitFailure
            Right recipe ->
              if vopts ^. #explain
                then explainMode modName vopts (Just recipe)
                else declarationModeRecipe (r & #vars .~ (recipe ^. #declarations))
    Right (RunnableBlueprint b _) ->
      if vopts ^. #explain
        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); derived callers supply their merged declaration list.
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 -> Maybe ExpandedRecipe -> IO ()
explainMode modName vopts expansion = do
  -- Load the full composition (target module + transitive dependencies)
  searchPaths <- defaultSearchPaths
  let primary = maybe modName (^. #primary) expansion
      additional = maybe [] (drop 1 . map (^. #dependency . #module_) . (^. #members)) expansion
  compositionResult <- loadComposition searchPaths primary additional
  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 ^. #vars]
      envVars = Map.fromList [(T.pack k, T.pack v) | (k, v) <- envPairs]
      namespace = fromMaybe (deriveNamespace primary) (vopts ^. #namespace)
  context <- resolveContext (vopts ^. #context) 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 <- case expansion of
      Nothing -> fmap (fmap (\values -> (Map.empty, values))) (resolveWithPrompts modulesInOrder cliOverrides envVars namespace contextName lm nm cm gm)
      Just recipe -> resolveRecipeWithSources PromptsAllowed False (RecipeInputSpec (recipe ^. #declarations) (recipe ^. #prompts) Nothing) modulesInOrder Map.empty cliOverrides (recipeLiteralSources recipe) 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 (recipeValues, resolved) -> do
      -- Modules show their target values; recipes show accepted recipe inputs
      -- and the complete consumer composition. Multiple instances merge
      -- their maps in the existing order — matching how a user
      -- reads "the variables of module X" before any disambiguation UI).
      let targetResolved =
            Map.union recipeValues $
              Map.unions
                [ vs
                | (inst, vs) <- Map.toList resolved,
                  maybe (inst ^. #module_ == modName) (const True) expansion
                ]
      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 = maybe [] (^. #declarations) expansion <> concatMap (\(_, m, _) -> m ^. #vars) modulesInOrder
          allResolved = Map.union recipeValues (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