packages feed

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

module Seihou.CLI.Status
  ( handleStatus,
  )
where

import Control.Exception (SomeException, try)
import Data.Text.IO qualified as TIO
import Seihou.CLI.Commands (StatusOpts (..))
import Seihou.CLI.Outdated (checkInstalledModulesForUpdates)
import Seihou.CLI.PendingMigrations (detectPendingMigrations)
import Seihou.CLI.Shared (logIO)
import Seihou.CLI.StatusRender (formatStatus)
import Seihou.CLI.Style (useColor)
import Seihou.CLI.VersionCompare (OutdatedEntry (..))
import Seihou.Core.Module (defaultSearchPaths, discoverAllModules)
import Seihou.Core.Status (computeTrackedFileStatuses)
import Seihou.Core.Types
import Seihou.Effect.FilesystemInterp (runFilesystem)
import Seihou.Effect.Logger (logError)
import Seihou.Effect.ManifestStore (readManifest)
import Seihou.Effect.ManifestStoreInterp (runManifestStore)
import Seihou.Prelude
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)

handleStatus :: StatusOpts -> IO ()
handleStatus opts = do
  let manifestPath = ".seihou" </> "manifest.json"

  -- Run both manifest read and file status computation in the same effect block.
  result <- runEff $ runFilesystem $ runManifestStore manifestPath $ do
    mResult <- readManifest
    case mResult of
      Left err -> pure (Left err)
      Right Nothing -> pure (Right Nothing)
      Right (Just manifest) -> do
        tracked <- computeTrackedFileStatuses manifest
        pure (Right (Just (manifest, tracked)))

  colorEnabled <- useColor

  case result of
    Left err -> do
      logIO LogNormal (logError $ "Error reading manifest: " <> err)
      exitFailure
    Right Nothing ->
      TIO.putStrLn "No Seihou manifest found. Run 'seihou run <module>' to generate a project."
    Right (Just (manifest, tracked)) -> do
      mEntries <-
        if opts.statusCheckUpdates && not (null manifest.modules)
          then fetchUpdateEntries
          else pure Nothing
      pendings <- detectPendingMigrations manifest Nothing
      TIO.putStr (formatStatus colorEnabled manifest tracked mEntries pendings)

-- | Run the update check, catching any IO failure so status still renders.
fetchUpdateEntries :: IO (Maybe [OutdatedEntry])
fetchUpdateEntries = do
  outcome <- try $ do
    searchPaths <- defaultSearchPaths
    modules <- discoverAllModules searchPaths
    checkInstalledModulesForUpdates modules
  case outcome of
    Left (e :: SomeException) -> do
      hPutStrLn stderr $
        "warning: update check failed: " <> show e
      pure Nothing
    Right (entries, _stats) -> pure (Just entries)