PendingMigrations.hs

module Seihou.CLI.PendingMigrations
  ( detectPendingMigrations,
    formatRefusalMessage,
  )
where

import Data.Generics.Labels ()
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text qualified as T
import Seihou.CLI.Migrate (pendingChainFor)
import Seihou.CLI.Shared (resolveAppliedArtifactDir)
import Seihou.Core.Migration (MigrationPlan (..))
import Seihou.Core.Types
  ( AppliedModule (..),
    Manifest (..),
    ModuleName (..),
  )
import Seihou.Core.Version (renderVersion)
import Seihou.Dhall.Eval (evalModuleFromFile)
import Seihou.Prelude

-- | Detect pending migrations across applied modules in a manifest.
--
-- For each applied module whose installed @module.dhall@ declares a
-- newer version than the manifest's recorded version, return the
-- migration plan that describes the gap. Under the gap-tolerant
-- planner the plan always advances the manifest to the supplied
-- target on apply; the carried 'planSteps' may be empty (a pure
-- version bump where no declared migration falls in the window) or
-- non-empty.
--
-- IO failures (missing @module.dhall@, eval errors, parse failures) are
-- silently skipped: pending-migration reporting is best-effort and never
-- raises.
--
-- The optional filter restricts detection to a subset of module names.
-- 'Nothing' means "consider every applied module" (used by @seihou
-- status@). @'Just' names@ keeps only modules whose name is in the set
-- (used by @seihou run@, which only blocks when a module it is about
-- to write into has a pending plan).
detectPendingMigrations ::
  Manifest ->
  Maybe (Set ModuleName) ->
  IO [(ModuleName, MigrationPlan)]
detectPendingMigrations manifest mFilter =
  fmap
    (\xs -> [(name, p) | (name, Just p) <- xs])
    (mapM check candidates)
  where
    candidates = case mFilter of
      Nothing -> (manifest ^. #modules)
      Just names -> filter (\am -> Set.member (am ^. #name) names) (manifest ^. #modules)

    -- The manifest records a portable origin, so the module has to be located
    -- on this machine first. A module that does not resolve here is skipped
    -- like any other read failure: detection is best-effort, and the command
    -- that actually needs the module reports the resolution error properly.
    check am = do
      resolved <- resolveAppliedArtifactDir "module.dhall" (am ^. #origin)
      case resolved of
        Left _ -> pure (am ^. #name, Nothing)
        Right directory -> do
          let dhallFile = directory </> "module.dhall"
          r <- evalModuleFromFile dhallFile
          case r of
            Left _ -> pure (am ^. #name, Nothing)
            Right installed -> pure (am ^. #name, pendingChainFor am installed)

-- | Format the user-facing refusal message that @seihou run@ prints
-- when it detects pending migrations and the user has not opted into
-- @--with-migrations@. Each row reports the module, the version range
-- the migration would cover, and how many migration ops it would run
-- (which may be zero — a pure version bump).
formatRefusalMessage :: [(ModuleName, MigrationPlan)] -> Text
formatRefusalMessage pendings =
  T.unlines $
    "Pending migrations detected:"
      : map renderEntry pendings
      ++ [ "",
           "For a recorded project application, run 'seihou update <target>'.",
           "For focused recovery, run 'seihou migrate <module>' for each, or pass --with-migrations to this explicit reconfiguration run."
         ]
  where
    renderEntry (name, plan) =
      "  "
        <> name ^. #unModuleName
        <> ": "
        <> renderVersion (plan ^. #from)
        <> " -> "
        <> renderVersion (plan ^. #to)
        <> " ("
        <> T.pack (show (length (plan ^. #steps)))
        <> " step(s))"