-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT

{- | The Dredger's pure decisions over its resolved configuration and its invocation, so
"Ecluse.Dredger" dispatches on their results instead of branching inside 'IO'.
-}
module Ecluse.Dredger.Plan (
    DredgerOptions (..),
    SweepMode (..),
    SweepRepetition (..),
    dredgerBootRole,
    sweepPacingFor,
    sweepReportFor,
    waitsForAdvisories,
    advisoryWaitAttempts,
    advisoryPollMicros,
    cycleEnding,
    haltDetail,
) where

import Data.Text qualified as T

import Ecluse.Composition.Sizing (resolveSized)
import Ecluse.Composition.Types (BootRole (BootStorePreview, BootStorePruner))
import Ecluse.Config (
    AppConfig (cfgDredger),
    DredgerSettings (drgChunkPause, drgChunkSize, drgCyclePause, drgDeletionCap, drgFullWalk, drgRequestBudgetFraction, drgTargetCycleWindow),
 )
import Ecluse.Core.Clock (secondsToMicros)
import Ecluse.Core.Registry.Sweep.Outcome (
    CycleHalt,
    CycleOutcome (outcomeEvidence, outcomeHalt),
    evidenceComplete,
    outcomeComplete,
    renderCycleHalt,
    renderEvidenceGaps,
 )
import Ecluse.Core.Registry.Sweep.Pacing (defaultCycleWindow)
import Ecluse.Core.Registry.Sweep.Types (
    SweepMount (smConfigured),
    SweepPacing (SweepPacing, swpBudgetFraction, swpChunkPause, swpChunkSize, swpCyclePause, swpCycleWindow, swpDeletionCap, swpShape),
    SweepReport (SweepReport, reportCapHalts, reportOpening, reportRemoval),
    SweepShape (SweepCandidates, SweepEverything),
    deletionCapPerStore,
 )
import Ecluse.Core.Rules.Types (readsAdvisories)
import Ecluse.Core.Telemetry.Metrics (SweepResult (SweepDeleted, SweepWouldDelete))

-- | Whether the run deletes, or previews what a run that deletes would reach.
data SweepMode
    = -- | Versions a named decisive deny condemns are deleted.
      SweepDeletes
    | -- | Nothing is deleted, because the run holds no capability that could.
      SweepPreviews
    deriving stock (SweepMode -> SweepMode -> Bool
(SweepMode -> SweepMode -> Bool)
-> (SweepMode -> SweepMode -> Bool) -> Eq SweepMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SweepMode -> SweepMode -> Bool
== :: SweepMode -> SweepMode -> Bool
$c/= :: SweepMode -> SweepMode -> Bool
/= :: SweepMode -> SweepMode -> Bool
Eq, Int -> SweepMode -> ShowS
[SweepMode] -> ShowS
SweepMode -> String
(Int -> SweepMode -> ShowS)
-> (SweepMode -> String)
-> ([SweepMode] -> ShowS)
-> Show SweepMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SweepMode -> ShowS
showsPrec :: Int -> SweepMode -> ShowS
$cshow :: SweepMode -> String
show :: SweepMode -> String
$cshowList :: [SweepMode] -> ShowS
showList :: [SweepMode] -> ShowS
Show)

{- | The role a Dredger invocation boots under, settled from its own flags before the boot's
vetting pass runs, so the pass and the runtime agree on what the process may do to a store.
-}
dredgerBootRole :: SweepMode -> BootRole
dredgerBootRole :: SweepMode -> BootRole
dredgerBootRole = \case
    SweepMode
SweepDeletes -> BootRole
BootStorePruner
    SweepMode
SweepPreviews -> BootRole
BootStorePreview

-- | Whether the role cycles for the life of the process, or runs one cycle and exits.
data SweepRepetition
    = -- | Cycle, pause, cycle again, under supervision. The shipped invocation.
      SweepContinuously
    | -- | One cycle, then exit with what that cycle did. @--once@, which the harness drives.
      SweepOnce
    deriving stock (SweepRepetition -> SweepRepetition -> Bool
(SweepRepetition -> SweepRepetition -> Bool)
-> (SweepRepetition -> SweepRepetition -> Bool)
-> Eq SweepRepetition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SweepRepetition -> SweepRepetition -> Bool
== :: SweepRepetition -> SweepRepetition -> Bool
$c/= :: SweepRepetition -> SweepRepetition -> Bool
/= :: SweepRepetition -> SweepRepetition -> Bool
Eq, Int -> SweepRepetition -> ShowS
[SweepRepetition] -> ShowS
SweepRepetition -> String
(Int -> SweepRepetition -> ShowS)
-> (SweepRepetition -> String)
-> ([SweepRepetition] -> ShowS)
-> Show SweepRepetition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SweepRepetition -> ShowS
showsPrec :: Int -> SweepRepetition -> ShowS
$cshow :: SweepRepetition -> String
show :: SweepRepetition -> String
$cshowList :: [SweepRepetition] -> ShowS
showList :: [SweepRepetition] -> ShowS
Show)

-- | What @ecluse dredger@'s own flags settled, carried from the command line to the sweep.
data DredgerOptions = DredgerOptions
    { DredgerOptions -> SweepMode
doMode :: SweepMode
    -- ^ Whether the sweep deletes (@--dry-run@ previews instead).
    , DredgerOptions -> SweepRepetition
doRepetition :: SweepRepetition
    -- ^ Whether it cycles for the life of the process (@--once@ runs one cycle).
    }
    deriving stock (DredgerOptions -> DredgerOptions -> Bool
(DredgerOptions -> DredgerOptions -> Bool)
-> (DredgerOptions -> DredgerOptions -> Bool) -> Eq DredgerOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DredgerOptions -> DredgerOptions -> Bool
== :: DredgerOptions -> DredgerOptions -> Bool
$c/= :: DredgerOptions -> DredgerOptions -> Bool
/= :: DredgerOptions -> DredgerOptions -> Bool
Eq, Int -> DredgerOptions -> ShowS
[DredgerOptions] -> ShowS
DredgerOptions -> String
(Int -> DredgerOptions -> ShowS)
-> (DredgerOptions -> String)
-> ([DredgerOptions] -> ShowS)
-> Show DredgerOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DredgerOptions -> ShowS
showsPrec :: Int -> DredgerOptions -> ShowS
$cshow :: DredgerOptions -> String
show :: DredgerOptions -> String
$cshowList :: [DredgerOptions] -> ShowS
showList :: [DredgerOptions] -> ShowS
Show)

{- | The pacing, the per-cycle cap, and the shape the @dredger@ group settled over the stores a
cycle sweeps, beside the boot lines naming where each resolved bound came from.
-}
sweepPacingFor :: AppConfig -> Int -> (SweepPacing, [Text])
sweepPacingFor :: AppConfig -> Int -> (SweepPacing, [Text])
sweepPacingFor AppConfig
appConfig Int
stores =
    ( SweepPacing
        { swpChunkSize :: Int
swpChunkSize = DredgerSettings -> Int
drgChunkSize DredgerSettings
dredger
        , swpChunkPause :: NominalDiffTime
swpChunkPause = DredgerSettings -> NominalDiffTime
drgChunkPause DredgerSettings
dredger
        , swpCyclePause :: NominalDiffTime
swpCyclePause = DredgerSettings -> NominalDiffTime
drgCyclePause DredgerSettings
dredger
        , swpCycleWindow :: NominalDiffTime
swpCycleWindow = NominalDiffTime
window
        , swpBudgetFraction :: Maybe Rational
swpBudgetFraction = DredgerSettings -> Maybe Rational
drgRequestBudgetFraction DredgerSettings
dredger
        , swpDeletionCap :: Int
swpDeletionCap = Int
cap
        , swpShape :: SweepShape
swpShape = if DredgerSettings -> Bool
drgFullWalk DredgerSettings
dredger then SweepShape
SweepEverything else SweepShape
SweepCandidates
        }
    , [Text
capLine, Text
windowLine]
    )
  where
    dredger :: DredgerSettings
dredger = AppConfig -> DredgerSettings
cfgDredger AppConfig
appConfig
    (Int
cap, Text
capLine) =
        Text -> Maybe Int -> Int -> Text -> (Int, Text)
forall a. Show a => Text -> Maybe a -> a -> Text -> (a, Text)
resolveSized
            Text
"dredger: deletion cap"
            (DredgerSettings -> Maybe Int
drgDeletionCap DredgerSettings
dredger)
            (Int
deletionCapPerStore Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
stores)
            (Text
"computed as " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
deletionCapPerStore Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" per sweepable mirror store")
    (NominalDiffTime
window, Text
windowLine) =
        Text
-> Maybe NominalDiffTime
-> NominalDiffTime
-> Text
-> (NominalDiffTime, Text)
forall a. Show a => Text -> Maybe a -> a -> Text -> (a, Text)
resolveSized
            Text
"dredger: target cycle window"
            (DredgerSettings -> Maybe NominalDiffTime
drgTargetCycleWindow DredgerSettings
dredger)
            (NominalDiffTime -> NominalDiffTime
defaultCycleWindow (DredgerSettings -> NominalDiffTime
drgCyclePause DredgerSettings
dredger))
            Text
"computed as three cycle pauses"

{- | The detail a halted one-shot run reports as its own non-zero ending, so a scheduler reads
the outcome from the status and the reason from the same line.
-}
haltDetail :: CycleHalt -> Text
haltDetail :: CycleHalt -> Text
haltDetail CycleHalt
halt = Text
"the mirror sweep cycle halted: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CycleHalt -> Text
renderCycleHalt CycleHalt
halt

{- | How a run reports what it removed. A preview counts under its own arm and past the cap, so it
reports the full reach a real run would have rather than stopping at the breaker.
-}
sweepReportFor :: SweepMode -> SweepReport
sweepReportFor :: SweepMode -> SweepReport
sweepReportFor = \case
    SweepMode
SweepDeletes -> SweepReport{reportRemoval :: SweepResult
reportRemoval = SweepResult
SweepDeleted, reportOpening :: Text
reportOpening = Text
"deleting ", reportCapHalts :: Bool
reportCapHalts = Bool
True}
    SweepMode
SweepPreviews ->
        SweepReport{reportRemoval :: SweepResult
reportRemoval = SweepResult
SweepWouldDelete, reportOpening :: Text
reportOpening = Text
"dry run, would delete ", reportCapHalts :: Bool
reportCapHalts = Bool
False}

{- | What a one-shot run reports as its own ending, or 'Nothing' where it ends cleanly. A run that
deletes ends on the halt its cycle raised, and a preview ends on completeness alone.
-}
cycleEnding :: SweepMode -> CycleOutcome -> Maybe Text
cycleEnding :: SweepMode -> CycleOutcome -> Maybe Text
cycleEnding = \case
    SweepMode
SweepDeletes -> (CycleHalt -> Text) -> Maybe CycleHalt -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CycleHalt -> Text
haltDetail (Maybe CycleHalt -> Maybe Text)
-> (CycleOutcome -> Maybe CycleHalt) -> CycleOutcome -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CycleOutcome -> Maybe CycleHalt
outcomeHalt
    SweepMode
SweepPreviews -> CycleOutcome -> Maybe Text
previewEnding

{- The preview's own ending. Its counts describe part of the store, so a scheduler reads that from
the status rather than from the counts, which report every candidate the cycle did gather. -}
previewEnding :: CycleOutcome -> Maybe Text
previewEnding :: CycleOutcome -> Maybe Text
previewEnding CycleOutcome
outcome
    | CycleOutcome -> Bool
outcomeComplete CycleOutcome
outcome = Maybe Text
forall a. Maybe a
Nothing
    | Bool
otherwise = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"the mirror sweep preview counted from part of the store: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
partial)
  where
    gaps :: EvidenceGaps
gaps = CycleOutcome -> EvidenceGaps
outcomeEvidence CycleOutcome
outcome
    partial :: Text
partial =
        Text -> [Text] -> Text
T.intercalate
            Text
"; "
            ([Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [CycleHalt -> Text
renderCycleHalt (CycleHalt -> Text) -> Maybe CycleHalt -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CycleOutcome -> Maybe CycleHalt
outcomeHalt CycleOutcome
outcome, EvidenceGaps -> Text
renderEvidenceGaps EvidenceGaps
gaps Text -> Maybe () -> Maybe Text
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (EvidenceGaps -> Bool
evidenceComplete EvidenceGaps
gaps))])

{- | Whether a first cycle waits for the first advisory sync. A rule set with no advisory rule
never needs one, so it starts at once.
-}
waitsForAdvisories :: [SweepMount] -> Bool
waitsForAdvisories :: [SweepMount] -> Bool
waitsForAdvisories = (SweepMount -> Bool) -> [SweepMount] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Rule -> Bool) -> [Rule] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Rule -> Bool
readsAdvisories ([Rule] -> Bool) -> (SweepMount -> [Rule]) -> SweepMount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SweepMount -> [Rule]
smConfigured)

{- | How many times a first cycle checks for the advisory sync before it starts anyway. The bound
is the cycle pause, so waiting never costs more than one cycle's worth of time.
-}
advisoryWaitAttempts :: SweepPacing -> Int
advisoryWaitAttempts :: SweepPacing -> Int
advisoryWaitAttempts SweepPacing
pacing = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (NominalDiffTime -> Int
secondsToMicros (SweepPacing -> NominalDiffTime
swpCyclePause SweepPacing
pacing) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
advisoryPollMicros)

-- | How long the first cycle waits between checks for the advisory sync.
advisoryPollMicros :: Int
advisoryPollMicros :: Int
advisoryPollMicros = Int
500_000