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

{- | Opaque serving documents with ecosystem-specific inject/project pairs.
The pipeline carries source snapshot scope separately and delegates wire access to adapters.
-}
module Ecluse.Core.Registry.CachedDocument (
    CachedDoc,
    weighCachedDoc,
    estimateValueBytes,
    npmCached,
    pypiSimpleCached,

    -- * npm's packed full reads and their renders
    npmPacked,
    npmRendered,
) where

import Data.Aeson (Value (..))
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Scientific (coefficient)
import Data.Text.Internal qualified as Text
import Math.NumberTheory.Logarithms (integerLog2)

import Ecluse.Core.Registry.Json.Packed (RenderPlan (planMembers), planResident, planValue)
import Ecluse.Core.Registry.Npm.Document (PackedPackument (packumentTop), packumentResident, packumentValue)
import Ecluse.Core.Registry.PyPI.Document (SimpleDocument, simpleEnvelope, simpleFiles)
import Ecluse.Core.Server.MemoryModel (chargeForResident)

{- | A serving document the pipeline threads and permitted caches hold. The derived 'Show' and 'Eq' are a
debug and test affordance, not a projection.
-}
data CachedDoc
    = CachedNpm Value ~Int64
    | CachedPyPISimple SimpleDocument ~Int64
    | PackedNpm PackedPackument
    | RenderedNpm RenderPlan
    deriving stock (CachedDoc -> CachedDoc -> Bool
(CachedDoc -> CachedDoc -> Bool)
-> (CachedDoc -> CachedDoc -> Bool) -> Eq CachedDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CachedDoc -> CachedDoc -> Bool
== :: CachedDoc -> CachedDoc -> Bool
$c/= :: CachedDoc -> CachedDoc -> Bool
/= :: CachedDoc -> CachedDoc -> Bool
Eq, Int -> CachedDoc -> ShowS
[CachedDoc] -> ShowS
CachedDoc -> String
(Int -> CachedDoc -> ShowS)
-> (CachedDoc -> String)
-> ([CachedDoc] -> ShowS)
-> Show CachedDoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CachedDoc -> ShowS
showsPrec :: Int -> CachedDoc -> ShowS
$cshow :: CachedDoc -> String
show :: CachedDoc -> String
$cshowList :: [CachedDoc] -> ShowS
showList :: [CachedDoc] -> ShowS
Show)

{- | Cached estimate of compact bytes. This is an accounting input, not measured resident memory. A
packed form charges the heap bytes it holds, in the compact units a consumer expands.
-}
weighCachedDoc :: CachedDoc -> Int64
weighCachedDoc :: CachedDoc -> Int64
weighCachedDoc = \case
    CachedNpm Value
_ Int64
charge -> Int64
charge
    CachedPyPISimple SimpleDocument
_ Int64
charge -> Int64
charge
    PackedNpm PackedPackument
packed -> Value -> Int64
estimateValueBytes (Object -> Value
Object (PackedPackument -> Object
packumentTop PackedPackument
packed)) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int
chargeForResident (PackedPackument -> Int
packumentResident PackedPackument
packed))
    RenderedNpm RenderPlan
plan -> Value -> Int64
estimateValueBytes (Object -> Value
Object (RenderPlan -> Object
planMembers RenderPlan
plan)) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int
chargeForResident (RenderPlan -> Int
planResident RenderPlan
plan))

{- | npm's boundary pair. Every arm is spelled out, so a third ecosystem fails to compile here. A packed
or rendered document projects as its tree, or as 'Nothing' when it names a string or table it lacks.
-}
npmCached :: (Value -> CachedDoc, CachedDoc -> Maybe Value)
npmCached :: (Value -> CachedDoc, CachedDoc -> Maybe Value)
npmCached = (\Value
v -> Value -> Int64 -> CachedDoc
CachedNpm Value
v (Value -> Int64
estimateValueBytes Value
v), CachedDoc -> Maybe Value
project)
  where
    project :: CachedDoc -> Maybe Value
project = \case
        CachedNpm Value
v Int64
_ -> Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v
        PackedNpm PackedPackument
packed -> PackedPackument -> Maybe Value
packumentValue PackedPackument
packed
        RenderedNpm RenderPlan
plan -> RenderPlan -> Maybe Value
planValue RenderPlan
plan
        CachedPyPISimple SimpleDocument
_ Int64
_ -> Maybe Value
forall a. Maybe a
Nothing

-- | PyPI's boundary pair, spelled out arm by arm for the same reason as 'npmCached'.
pypiSimpleCached :: (SimpleDocument -> CachedDoc, CachedDoc -> Maybe SimpleDocument)
pypiSimpleCached :: (SimpleDocument -> CachedDoc, CachedDoc -> Maybe SimpleDocument)
pypiSimpleCached = (\SimpleDocument
v -> SimpleDocument -> Int64 -> CachedDoc
CachedPyPISimple SimpleDocument
v (SimpleDocument -> Int64
simpleBytes SimpleDocument
v), CachedDoc -> Maybe SimpleDocument
project)
  where
    project :: CachedDoc -> Maybe SimpleDocument
project = \case
        CachedPyPISimple SimpleDocument
v Int64
_ -> SimpleDocument -> Maybe SimpleDocument
forall a. a -> Maybe a
Just SimpleDocument
v
        CachedNpm Value
_ Int64
_ -> Maybe SimpleDocument
forall a. Maybe a
Nothing
        PackedNpm PackedPackument
_ -> Maybe SimpleDocument
forall a. Maybe a
Nothing
        RenderedNpm RenderPlan
_ -> Maybe SimpleDocument
forall a. Maybe a
Nothing

-- | npm's packed full read, and its packed form when the document is one.
npmPacked :: (PackedPackument -> CachedDoc, CachedDoc -> Maybe PackedPackument)
npmPacked :: (PackedPackument -> CachedDoc, CachedDoc -> Maybe PackedPackument)
npmPacked = (PackedPackument -> CachedDoc
PackedNpm, \case PackedNpm PackedPackument
packed -> PackedPackument -> Maybe PackedPackument
forall a. a -> Maybe a
Just PackedPackument
packed; CachedDoc
_ -> Maybe PackedPackument
forall a. Maybe a
Nothing)

-- | An assembled npm listing that renders from packed releases, and its plan when the document is one.
npmRendered :: (RenderPlan -> CachedDoc, CachedDoc -> Maybe RenderPlan)
npmRendered :: (RenderPlan -> CachedDoc, CachedDoc -> Maybe RenderPlan)
npmRendered = (RenderPlan -> CachedDoc
RenderedNpm, \case RenderedNpm RenderPlan
plan -> RenderPlan -> Maybe RenderPlan
forall a. a -> Maybe a
Just RenderPlan
plan; CachedDoc
_ -> Maybe RenderPlan
forall a. Maybe a
Nothing)

simpleBytes :: SimpleDocument -> Int64
simpleBytes :: SimpleDocument -> Int64
simpleBytes SimpleDocument
document = Value -> Int64
estimateValueBytes (Object -> Value
Object (SimpleDocument -> Object
simpleEnvelope SimpleDocument
document)) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
12 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ [Int64] -> Int64
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum [Int64
32 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Value -> Int64
estimateValueBytes Value
value | (EntryKey
_, Value
value) <- SimpleDocument -> [(EntryKey, Value)]
simpleFiles SimpleDocument
document]

-- | Estimate accounting bytes without encoding. This is neither measured heap nor exact JSON length.
estimateValueBytes :: Value -> Int64
estimateValueBytes :: Value -> Int64
estimateValueBytes = \case
    Object Object
fields -> Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ [Int64] -> Int64
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum [Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Text -> Int64
textBytes (Key -> Text
Key.toText Key
key) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Value -> Int64
estimateValueBytes Value
value | (Key
key, Value
value) <- Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Object
fields]
    Array Array
items -> Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ [Int64] -> Int64
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum [Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Value -> Int64
estimateValueBytes Value
value | Value
value <- Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
items]
    String Text
value -> Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Text -> Int64
textBytes Text
value
    Number Scientific
number -> Int64
24 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Integer -> Int64
integerBytes (Scientific -> Integer
coefficient Scientific
number)
    Bool Bool
_ -> Int64
5
    Value
Null -> Int64
4

textBytes :: Text -> Int64
textBytes :: Text -> Int64
textBytes (Text.Text Array
_ Int
_ Int
len) = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len

integerBytes :: Integer -> Int64
integerBytes :: Integer -> Int64
integerBytes Integer
value
    | Integer
value Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Int64
8
    | Bool
otherwise = Int64
8 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* (Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int
integerLog2 (Integer -> Integer
forall a. Num a => a -> a
abs Integer
value) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
64))