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

{- | The boot lines the memory plan emits: one per resolved bound, tagged with its
provenance, and one warning per rung the shed ladder took. The boot logs them and the
dry-run checker ('Ecluse.CheckConfig.runCheckConfig') prints the same text, so an operator
reads one plan whichever path produced it.
-}
module Ecluse.Composition.MemoryPlan.Render (
    renderPlanLines,
    localCachePolicyLine,
    renderDegradations,
    renderControlWarnings,
) where

import Ecluse.Composition.MemoryPlan.Internal (
    OverridePins (opAdmission, opArtifact, opCache, opDepth, opRequest, opResponse),
    PlanInputs (piCeilingClause, piCpuAdmissionLine),
    ShedOutcomes (..),
    TenantDemands (..),
 )
import Ecluse.Composition.MemoryPlan.Override (overrideFreeOvershoot)
import Ecluse.Composition.MemoryPlan.Shed (cacheEntryBound)
import Ecluse.Composition.Sizing (renderSized)

-- | The local backend's retention capabilities, independent of capacity overrides.
localCachePolicyLine :: Text
localCachePolicyLine :: Text
localCachePolicyLine = Text
"metadata cache: local backend, full retention disabled, selected-version and assembled retention enabled"

{- | The ordered boot lines check-config prints: one per resolved bound, tagged with its
provenance (an explicit config value, or the ceiling it was computed from).
-}
renderPlanLines :: PlanInputs -> TenantDemands -> ShedOutcomes -> [Text]
renderPlanLines :: PlanInputs -> TenantDemands -> ShedOutcomes -> [Text]
renderPlanLines PlanInputs
inputs TenantDemands
d ShedOutcomes
o =
    [ Text -> Int -> Maybe Int -> Text
forall {a}. Show a => Text -> a -> Maybe a -> Text
planLine Text
"runtime reserve" (TenantDemands -> Int
tdReserve TenantDemands
d) Maybe Int
forall a. Maybe a
Nothing
    , PlanInputs -> Text
piCpuAdmissionLine PlanInputs
inputs
    , Text -> Int -> Maybe Int -> Text -> Text
forall a. Show a => Text -> a -> Maybe a -> Text -> Text
renderSized Text
"memory plan: metadata ingest ceiling" (ShedOutcomes -> Int
soResponseFinal ShedOutcomes
o) (OverridePins -> Maybe Int
opResponse OverridePins
pins) Text
"built-in default, independent of heap and CPU"
    , Text -> Int -> Maybe Int -> Text
forall {a}. Show a => Text -> a -> Maybe a -> Text
planLine Text
"request byte cap" (TenantDemands -> Int
tdRequestFinal TenantDemands
d) (OverridePins -> Maybe Int
opRequest OverridePins
pins)
    , Text
localCachePolicyLine
    , Text -> Int -> Maybe Int -> Text
forall {a}. Show a => Text -> a -> Maybe a -> Text
planLine Text
"cache byte bound" (ShedOutcomes -> Int
soCacheFinal ShedOutcomes
o) (OverridePins -> Maybe Int
opCache OverridePins
pins)
    , Text -> Int -> Maybe Int -> Text
forall {a}. Show a => Text -> a -> Maybe a -> Text
planLine Text
"cache entry bound" (TenantDemands -> ShedOutcomes -> Int
cacheEntryBound TenantDemands
d ShedOutcomes
o) (TenantDemands -> Maybe Int
tdCacheEntriesExplicit TenantDemands
d)
    ]
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text -> Int -> Maybe Int -> Text
forall {a}. Show a => Text -> a -> Maybe a -> Text
planLine Text
"publish aggregate" (ShedOutcomes -> Int
soPublishFinal ShedOutcomes
o) Maybe Int
forall a. Maybe a
Nothing | TenantDemands -> Bool
tdPublishConfigured TenantDemands
d]
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text -> Int -> Maybe Int -> Text
forall {a}. Show a => Text -> a -> Maybe a -> Text
planLine Text
"memory-queue depth" (ShedOutcomes -> Int
soDepthFinal ShedOutcomes
o) (OverridePins -> Maybe Int
opDepth OverridePins
pins) | TenantDemands -> Bool
tdMemoryBacked TenantDemands
d]
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text -> Int -> Maybe Int -> Text
forall {a}. Show a => Text -> a -> Maybe a -> Text
planLine Text
"mirror artifact byte cap" (ShedOutcomes -> Int
soArtifactCapFinal ShedOutcomes
o) (OverridePins -> Maybe Int
opArtifact OverridePins
pins) | TenantDemands -> Bool
tdMirrors TenantDemands
d]
  where
    pins :: OverridePins
pins = TenantDemands -> OverridePins
tdPins TenantDemands
d
    planLine :: Text -> a -> Maybe a -> Text
planLine Text
name a
value Maybe a
explicit = Text -> a -> Maybe a -> Text -> Text
forall a. Show a => Text -> a -> Maybe a -> Text -> Text
renderSized (Text
"memory plan: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) a
value Maybe a
explicit Text
computedClause
    computedClause :: Text
computedClause = Text
"computed from heap ceiling " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (TenantDemands -> Int
tdCeiling TenantDemands
d) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PlanInputs -> Text
piCeilingClause PlanInputs
inputs

-- | The shed-ladder warnings, in ladder order, each naming what was given up and why.
renderDegradations :: TenantDemands -> ShedOutcomes -> [Text]
renderDegradations :: TenantDemands -> ShedOutcomes -> [Text]
renderDegradations TenantDemands
d ShedOutcomes
o =
    [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes
        [ Text -> Int -> Int -> Text -> Text
shedWarning Text
"mirror artifact byte cap" (TenantDemands -> Int
tdArtifactCapDesired TenantDemands
d) (ShedOutcomes -> Int
soArtifactCapFinal ShedOutcomes
o) Text
"this pod mirrors no artifact it cannot buffer safely"
            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 (ShedOutcomes -> Int
soMirrorShed ShedOutcomes
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        , Text -> Int -> Int -> Text -> Text
shedWarning Text
"cache aggregate" (TenantDemands -> Int
tdCacheDesired TenantDemands
d) (ShedOutcomes -> Int
soCacheFinal ShedOutcomes
o) Text
"the proxy serves uncached"
            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 (ShedOutcomes -> Int
soCacheShed ShedOutcomes
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        , Text
"memory plan: publish aggregate shed to one maximum request ("
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (ShedOutcomes -> Int
soPublishFinal ShedOutcomes
o)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bytes)"
            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 (ShedOutcomes -> Int
soPublishShed ShedOutcomes
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        , Text
"memory plan: memory-queue depth shed to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (ShedOutcomes -> Int
soDepthFinal ShedOutcomes
o) 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 (ShedOutcomes -> Int
soQueueShedBytes ShedOutcomes
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        , Int -> Text
irreducibleMinimumWarning Int
freeOvershoot 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 (ShedOutcomes -> Int
soResidualOvershoot ShedOutcomes
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
freeOvershoot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
        ]
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> OverridePins -> Int -> Int -> [Text]
renderControlWarnings (TenantDemands -> OverridePins
tdPins TenantDemands
d) (ShedOutcomes -> Int
soAdmissionFinal ShedOutcomes
o) (ShedOutcomes -> Int
soResponseFinal ShedOutcomes
o)
  where
    freeOvershoot :: Int
freeOvershoot = TenantDemands -> Int
overrideFreeOvershoot TenantDemands
d

-- A tenant that gave up bytes, with the consequence it carries once it reaches zero.
shedWarning :: Text -> Int -> Int -> Text -> Text
shedWarning :: Text -> Int -> Int -> Text -> Text
shedWarning Text
tenant Int
desired Int
final Text
atZero =
    Text
"memory plan: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tenant
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" shed from "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
desired
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
final
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bytes to fit the heap ceiling"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Int
final Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
atZero Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")" else Text
"")

irreducibleMinimumWarning :: Int -> Text
irreducibleMinimumWarning :: Int -> Text
irreducibleMinimumWarning Int
overshoot =
    Text
"memory plan: the irreducible minimum for the configured tenants still exceeds the heap ceiling by "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
overshoot
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bytes. Booting with the container limit as the backstop. Increase the memory limit"

-- | Explain exact operator pins, which carry no memory guarantee.
renderControlWarnings :: OverridePins -> Int -> Int -> [Text]
renderControlWarnings :: OverridePins -> Int -> Int -> [Text]
renderControlWarnings OverridePins
pins Int
admission Int
response =
    [ Text
"metadata admission: preserving configured CPU capacity "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
admission
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". CPU capacity does not bound heap use"
    | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (OverridePins -> Maybe Int
opAdmission OverridePins
pins)
    ]
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [ Text
"metadata admission: preserving configured metadata ingest ceiling "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
response
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bytes. Body admissibility does not guarantee materialisation fits the heap"
           | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (OverridePins -> Maybe Int
opResponse OverridePins
pins)
           ]