StatusRender.hs

module Seihou.CLI.StatusRender
  ( formatStatus,
    formatArtifactChecks,
    formatBlueprintMigrations,
    ModuleAdvice (..),
  )
where

import Control.Lens (to, (^.))
import Data.Generics.Labels ()
import Data.List (intersperse, nub)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (isJust, listToMaybe, mapMaybe)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time.Format (defaultTimeLocale, formatTime)
import Seihou.CLI.ManifestGuard (ArtifactCheck, summarizeCheck)
import Seihou.CLI.Style (dim, green, red, yellow)
import Seihou.CLI.VersionCompare
  ( OutdatedEntry (..),
    OutdatedStatus (..),
  )
import Seihou.Core.Migration (MigrationPlan (..))
import Seihou.Core.Types
  ( AppliedBlueprint (..),
    AppliedBlueprintMigration (..),
    AppliedComposition (..),
    AppliedInstanceState (..),
    AppliedModule (..),
    AppliedRecipe (..),
    AppliedTarget (..),
    Manifest (..),
    ModuleName (..),
    ParentVars (..),
    RecipeName (..),
    TrackedFile (..),
    TrackedFileStatus (..),
    VarName (..),
  )
import Seihou.Core.Version (renderVersion)

-- | What action an applied module or recorded application recommends.
-- Pending migrations and ordinary version drift both route through the
-- project-aware update workflow.
data ModuleAdvice
  = AdviceNone
  | AdviceProjectUpdate Text (Maybe MigrationPlan)
  | AdviceProjectUpdateAll
  deriving stock (Eq, Show)

-- | Render the full @seihou status@ output as a single 'Text' value.
--
-- @color@ controls ANSI styling; pass 'False' for plain text (used by
-- the test suite).
formatStatus ::
  Bool ->
  Manifest ->
  [TrackedFile] ->
  Maybe [OutdatedEntry] ->
  [(ModuleName, MigrationPlan)] ->
  Text
formatStatus color manifest tracked mEntries pendings =
  T.unlines $
    ["Seihou Status:", ""]
      ++ recipeSection manifest
      ++ blueprintSection manifest
      ++ formatBlueprintMigrations (manifest ^. #blueprintMigrations)
      ++ appliedSection color manifest mEntries pendings
      ++ trackedSection color tracked
      ++ varsSection manifest
      ++ updateSummarySection mEntries
      ++ recommendedActionsSection adviceList
  where
    entryMap = case mEntries of
      Just es -> Map.fromList [(e ^. #moduleName, e) | e <- es]
      Nothing -> Map.empty
    pendingMap =
      Map.fromList [(name ^. #unModuleName, plan) | (name, plan) <- pendings]
    adviceList = projectAdviceList manifest entryMap pendingMap

-- ---------------------------------------------------------------------------
-- Section renderers
-- ---------------------------------------------------------------------------

recipeSection :: Manifest -> [Text]
recipeSection manifest = case manifest ^. #recipe of
  Nothing -> []
  Just ar ->
    [ "Recipe: "
        <> ar ^. #name . #unRecipeName
        <> maybe "" (\v -> " v" <> v) (ar ^. #recipeVersion),
      ""
    ]

-- | Render the "Blueprint:" provenance block when 'Manifest.blueprint'
-- is populated. Empty otherwise.
--
-- Header line: name, optional @vX.Y.Z@, and the applied timestamp.
-- Baseline line: comma-separated baseline module names, or one of the
-- two empty-baseline placeholders.
-- Prompt line: present only when the user passed a positional prompt.
blueprintSection :: Manifest -> [Text]
blueprintSection manifest = case manifest ^. #blueprint of
  Nothing -> []
  Just ab ->
    let header =
          "Blueprint: "
            <> ab ^. #name . #unModuleName
            <> maybe "" (\v -> " v" <> v) (ab ^. #blueprintVersion)
            <> " (applied "
            <> T.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" (ab ^. #appliedAt))
            <> ")"
        baselineLine = "  Baseline: " <> renderBaseline ab
        promptLines = case ab ^. #userPrompt of
          Nothing -> []
          Just p -> ["  Prompt: \"" <> p <> "\""]
     in [header, baselineLine] ++ promptLines ++ [""]

-- | Render durable agent-guided migration receipts. An empty ledger adds no
-- output; each populated row includes the artifact, exact edge, and timestamp.
formatBlueprintMigrations :: [AppliedBlueprintMigration] -> [Text]
formatBlueprintMigrations [] = []
formatBlueprintMigrations receipts =
  "Blueprint migrations:"
    : map renderReceipt receipts
      <> [""]
  where
    renderReceipt receipt =
      "  "
        <> receipt ^. #name . #unModuleName
        <> maybe "" (\version -> " v" <> version) (receipt ^. #blueprintVersion)
        <> ": "
        <> receipt ^. #fromVersion
        <> " -> "
        <> receipt ^. #toVersion
        <> " (applied "
        <> T.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" (receipt ^. #appliedAt))
        <> ")"

-- | Render the baseline body for the blueprint section. Three cases:
-- @--no-baseline@ was passed, the blueprint declared no baseline at
-- all, or one or more baseline modules were applied.
renderBaseline :: AppliedBlueprint -> Text
renderBaseline ab
  | (ab ^. #noBaseline) = "(none -- --no-baseline)"
  | null (ab ^. #baselineModules) = "(none declared)"
  | otherwise =
      T.intercalate ", " (map (^. #unModuleName) (ab ^. #baselineModules))

appliedSection ::
  Bool ->
  Manifest ->
  Maybe [OutdatedEntry] ->
  [(ModuleName, MigrationPlan)] ->
  [Text]
appliedSection color manifest mEntries pendings =
  "Applied modules:"
    : moduleLines
    ++ [""]
  where
    entryMap = case mEntries of
      Just es -> Map.fromList [(e ^. #moduleName, e) | e <- es]
      Nothing -> Map.empty
    pendingMap =
      Map.fromList [(name ^. #unModuleName, plan) | (name, plan) <- pendings]
    moduleLines
      | null (manifest ^. #modules) = ["  (none)"]
      | otherwise = renderRows Set.empty (manifest ^. #modules)
    renderRows _ [] = []
    renderRows seen (am : rest) =
      let name = (am ^. #name . #unModuleName)
          annotation = lookupEntry mEntries entryMap am
          headerLine = formatModuleLine color annotation am
          hintLines
            | Set.member name seen = []
            | null (manifest ^. #applications) = formatAdvice color (rowProjectAdvice entryMap pendingMap am)
            | otherwise = maybe [] (formatPendingDetail color) (Map.lookup name pendingMap)
       in headerLine : hintLines <> renderRows (Set.insert name seen) rest

trackedSection :: Bool -> [TrackedFile] -> [Text]
trackedSection color tracked =
  ("Tracked files: " <> T.pack (show (length tracked)))
    : ( if null tracked
          then ["  (none)"]
          else map (formatTrackedFile color maxPathLen maxModLen) tracked
      )
    ++ [""]
  where
    maxPathLen = maximum (map (length . (^. #path)) tracked)
    maxModLen = maximum (map (T.length . displayModuleName . (^. #moduleName)) tracked)

varsSection :: Manifest -> [Text]
varsSection manifest =
  ["Variables: " <> T.pack (show (Map.size (manifest ^. #vars))) <> " resolved"]

updateSummarySection :: Maybe [OutdatedEntry] -> [Text]
updateSummarySection Nothing = []
updateSummarySection (Just entries) =
  let total = length entries
      outdated = length (filter (\e -> e ^. #status == OutdatedSt) entries)
   in [ "",
        T.pack (show total)
          <> " module(s) checked, "
          <> T.pack (show outdated)
          <> " outdated."
      ]

-- | Print a "Recommended actions:" block listing the exact commands a
-- user should run for each problem row. Skipped when no row had an
-- actionable problem.
recommendedActionsSection :: [ModuleAdvice] -> [Text]
recommendedActionsSection advices =
  case nub [c | Just c <- map adviceCommand advices] of
    [] -> []
    cmds -> ["", "Recommended actions:"] ++ map ("  " <>) cmds

-- | Render the manifest guard's non-@ArtifactOk@ verdicts as a trailing
-- advisory block.
--
-- @seihou status@ is a reporting command and must never fail because of a
-- verdict — this block is precisely what lets a developer discover a stale or
-- mismatched module *before* @seihou run@ refuses to use it. Returns the empty
-- text when every artifact is healthy, so the section disappears entirely
-- rather than printing a reassuring "0 problems".
formatArtifactChecks :: Bool -> [ArtifactCheck] -> Text
formatArtifactChecks color checks = case mapMaybe summarizeCheck checks of
  [] -> ""
  summaries ->
    T.unlines $
      ["", applyColor color yellow "Artifacts that differ from what this project records:"]
        ++ map ("  " <>) summaries

adviceCommand :: ModuleAdvice -> Maybe Text
adviceCommand AdviceNone = Nothing
adviceCommand (AdviceProjectUpdate target _) = Just ("seihou update " <> target)
adviceCommand AdviceProjectUpdateAll = Just "seihou update"

-- ---------------------------------------------------------------------------
-- Per-row formatting
-- ---------------------------------------------------------------------------

-- | Per-row update annotation source, mirroring the previous local
-- @UpdateAnnotation@ enum in @Status.hs@.
data UpdateAnnotation
  = NoCheck
  | NoOrigin
  | Entry OutdatedEntry

lookupEntry ::
  Maybe [OutdatedEntry] ->
  Map Text OutdatedEntry ->
  AppliedModule ->
  UpdateAnnotation
lookupEntry Nothing _ _ = NoCheck
lookupEntry (Just _) m am = case Map.lookup (am ^. #name . #unModuleName) m of
  Just e -> Entry e
  Nothing -> NoOrigin

formatModuleLine :: Bool -> UpdateAnnotation -> AppliedModule -> Text
formatModuleLine color annotation am =
  let verText = case am ^. #moduleVersion of
        Just v -> "  " <> applyColor color green ("v" <> v)
        Nothing -> ""
      appliedText =
        "    (applied "
          <> T.pack (formatTime defaultTimeLocale "%Y-%m-%d" (am ^. #appliedAt))
          <> ")"
      parentVarsText =
        let m = (am ^. #parentVars . #unParentVars)
         in if Map.null m
              then ""
              else
                let pairs =
                      T.concat
                        ( intersperse
                            ", "
                            [ vn ^. #unVarName <> "=" <> v
                            | (vn, v) <- Map.toAscList m
                            ]
                        )
                    rendered = " [" <> pairs <> "]"
                 in applyColor color dim rendered
      updateText = case annotation of
        NoCheck -> ""
        NoOrigin -> "  " <> applyColor color dim "(no origin)"
        Entry e -> "  " <> renderEntry color e
   in "  "
        <> am ^. #name . #unModuleName
        <> parentVarsText
        <> verText
        <> appliedText
        <> updateText

-- | Per-row remediation hint. Indented two characters past the row's
-- two-space indentation (i.e. four spaces total) so it visually nests
-- under the module name.
formatAdvice :: Bool -> ModuleAdvice -> [Text]
formatAdvice _ AdviceNone = []
formatAdvice color (AdviceProjectUpdate target Nothing) =
  ["    " <> applyColor color yellow ("Run: seihou update " <> target)]
formatAdvice color (AdviceProjectUpdate target (Just plan)) =
  ["    " <> applyColor color yellow (projectPlanSummary target plan)]
formatAdvice color AdviceProjectUpdateAll =
  ["    " <> applyColor color yellow "Run: seihou update"]

projectPlanSummary :: Text -> MigrationPlan -> Text
projectPlanSummary target plan =
  "Pending migration: "
    <> renderVersion (plan ^. #from)
    <> " -> "
    <> renderVersion (plan ^. #to)
    <> " ("
    <> T.pack (show (length (plan ^. #steps)))
    <> " step(s)). Run: seihou update "
    <> target

formatPendingDetail :: Bool -> MigrationPlan -> [Text]
formatPendingDetail color plan =
  [ "    "
      <> applyColor
        color
        yellow
        ( "Pending migration: "
            <> renderVersion (plan ^. #from)
            <> " -> "
            <> renderVersion (plan ^. #to)
            <> " ("
            <> T.pack (show (length (plan ^. #steps)))
            <> " step(s))"
        )
  ]

rowProjectAdvice ::
  Map Text OutdatedEntry ->
  Map Text MigrationPlan ->
  AppliedModule ->
  ModuleAdvice
rowProjectAdvice entryMap pendingMap applied =
  if actionable
    then AdviceProjectUpdate name pending
    else AdviceNone
  where
    name = (applied ^. #name . #unModuleName)
    pending = Map.lookup name pendingMap
    outdated = maybe False ((== OutdatedSt) . (^. #status)) (Map.lookup name entryMap)
    actionable = outdated || isJust pending

projectAdviceList ::
  Manifest ->
  Map Text OutdatedEntry ->
  Map Text MigrationPlan ->
  [ModuleAdvice]
projectAdviceList manifest entryMap pendingMap
  | null (manifest ^. #applications) =
      map (rowProjectAdvice entryMap pendingMap) (deduplicateModules (manifest ^. #modules))
  | otherwise =
      let applicationAdvice = mapMaybe adviceForApplication (manifest ^. #applications)
       in applicationAdvice <> [AdviceProjectUpdateAll | length applicationAdvice > 1]
  where
    adviceForApplication application =
      let names = map (^. #name . #unModuleName) (application ^. #instances)
          pending = listToMaybe (mapMaybe (`Map.lookup` pendingMap) names)
          outdated = any (maybe False ((== OutdatedSt) . (^. #status)) . (`Map.lookup` entryMap)) names
       in if outdated || isJust pending
            then Just (AdviceProjectUpdate (targetText (application ^. #target)) pending)
            else Nothing

deduplicateModules :: [AppliedModule] -> [AppliedModule]
deduplicateModules = Map.elems . Map.fromList . map (\applied -> (applied ^. #name . #unModuleName, applied))

targetText :: AppliedTarget -> Text
targetText (AppliedModuleTarget name) = (name ^. #unModuleName)
targetText (AppliedRecipeTarget name) = (name ^. #unRecipeName)

renderEntry :: Bool -> OutdatedEntry -> Text
renderEntry color e = case e ^. #status of
  UpToDate -> applyColor color dim "up to date"
  OutdatedSt ->
    let avail = maybe "?" id (e ^. #availableVersion)
        txt = "outdated: " <> avail <> " available"
     in applyColor color red txt
  Unversioned -> applyColor color dim "unversioned"
  Unreachable -> applyColor color yellow "unreachable"

formatTrackedFile :: Bool -> Int -> Int -> TrackedFile -> Text
formatTrackedFile color maxPathLen maxModLen tf =
  let path = T.pack (tf ^. #path)
      modName = displayModuleName (tf ^. #moduleName)
      paddedPath = path <> T.replicate (maxPathLen - T.length path + 3) " "
      paddedMod = modName <> T.replicate (maxModLen - T.length modName + 3) " "
      label = statusLabel (tf ^. #status)
      colored = applyColor color (statusColor (tf ^. #status)) label
   in "  " <> paddedPath <> paddedMod <> colored

displayModuleName :: ModuleName -> Text
displayModuleName (ModuleName n) = T.takeWhile (/= '#') n

statusLabel :: TrackedFileStatus -> Text
statusLabel TfsUnchanged = "unchanged"
statusLabel TfsModified = "modified by user"
statusLabel TfsDeleted = "deleted by user"

statusColor :: TrackedFileStatus -> Text -> Text
statusColor TfsUnchanged = dim
statusColor TfsModified = yellow
statusColor TfsDeleted = red

applyColor :: Bool -> (Text -> Text) -> Text -> Text
applyColor True f = f
applyColor False _ = id