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

{- | The buckets a store's name space is walked in.

A bucket is a leading-character prefix of a package's base name, so the buckets of one alphabet
are disjoint and cover every permitted name. A backend that cannot filter its listing takes the
empty alphabet, whose single bucket is the whole store.
-}
module Ecluse.Core.Registry.Maintenance.NameSpace (
    NameAlphabet,
    mkNameAlphabet,
    noNameAlphabet,
    NamePrefix,
    wholeNameSpace,
    renderNamePrefix,
    parseNamePrefix,
    initialBuckets,
    extendBucket,
    inBucket,
) where

import Data.Text qualified as T

import Ecluse.Core.Package (PackageName, unscopedName)

-- | Permitted leading characters of ecosystem package names.
newtype NameAlphabet = NameAlphabet [Char]
    deriving stock (NameAlphabet -> NameAlphabet -> Bool
(NameAlphabet -> NameAlphabet -> Bool)
-> (NameAlphabet -> NameAlphabet -> Bool) -> Eq NameAlphabet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameAlphabet -> NameAlphabet -> Bool
== :: NameAlphabet -> NameAlphabet -> Bool
$c/= :: NameAlphabet -> NameAlphabet -> Bool
/= :: NameAlphabet -> NameAlphabet -> Bool
Eq, Int -> NameAlphabet -> ShowS
[NameAlphabet] -> ShowS
NameAlphabet -> [Char]
(Int -> NameAlphabet -> ShowS)
-> (NameAlphabet -> [Char])
-> ([NameAlphabet] -> ShowS)
-> Show NameAlphabet
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameAlphabet -> ShowS
showsPrec :: Int -> NameAlphabet -> ShowS
$cshow :: NameAlphabet -> [Char]
show :: NameAlphabet -> [Char]
$cshowList :: [NameAlphabet] -> ShowS
showList :: [NameAlphabet] -> ShowS
Show)

-- | Build an alphabet, dropping repeats and keeping the order given.
mkNameAlphabet :: [Char] -> NameAlphabet
mkNameAlphabet :: [Char] -> NameAlphabet
mkNameAlphabet = [Char] -> NameAlphabet
NameAlphabet ([Char] -> NameAlphabet) -> ShowS -> [Char] -> NameAlphabet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Ord a => [a] -> [a]
ordNub

-- | Use a single whole-store bucket when the backend cannot filter its listing.
noNameAlphabet :: NameAlphabet
noNameAlphabet :: NameAlphabet
noNameAlphabet = [Char] -> NameAlphabet
NameAlphabet []

-- | A bucket prefix addresses the package's base name, excluding its namespace.
newtype NamePrefix = NamePrefix Text
    deriving stock (NamePrefix -> NamePrefix -> Bool
(NamePrefix -> NamePrefix -> Bool)
-> (NamePrefix -> NamePrefix -> Bool) -> Eq NamePrefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NamePrefix -> NamePrefix -> Bool
== :: NamePrefix -> NamePrefix -> Bool
$c/= :: NamePrefix -> NamePrefix -> Bool
/= :: NamePrefix -> NamePrefix -> Bool
Eq, Eq NamePrefix
Eq NamePrefix =>
(NamePrefix -> NamePrefix -> Ordering)
-> (NamePrefix -> NamePrefix -> Bool)
-> (NamePrefix -> NamePrefix -> Bool)
-> (NamePrefix -> NamePrefix -> Bool)
-> (NamePrefix -> NamePrefix -> Bool)
-> (NamePrefix -> NamePrefix -> NamePrefix)
-> (NamePrefix -> NamePrefix -> NamePrefix)
-> Ord NamePrefix
NamePrefix -> NamePrefix -> Bool
NamePrefix -> NamePrefix -> Ordering
NamePrefix -> NamePrefix -> NamePrefix
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NamePrefix -> NamePrefix -> Ordering
compare :: NamePrefix -> NamePrefix -> Ordering
$c< :: NamePrefix -> NamePrefix -> Bool
< :: NamePrefix -> NamePrefix -> Bool
$c<= :: NamePrefix -> NamePrefix -> Bool
<= :: NamePrefix -> NamePrefix -> Bool
$c> :: NamePrefix -> NamePrefix -> Bool
> :: NamePrefix -> NamePrefix -> Bool
$c>= :: NamePrefix -> NamePrefix -> Bool
>= :: NamePrefix -> NamePrefix -> Bool
$cmax :: NamePrefix -> NamePrefix -> NamePrefix
max :: NamePrefix -> NamePrefix -> NamePrefix
$cmin :: NamePrefix -> NamePrefix -> NamePrefix
min :: NamePrefix -> NamePrefix -> NamePrefix
Ord, Int -> NamePrefix -> ShowS
[NamePrefix] -> ShowS
NamePrefix -> [Char]
(Int -> NamePrefix -> ShowS)
-> (NamePrefix -> [Char])
-> ([NamePrefix] -> ShowS)
-> Show NamePrefix
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamePrefix -> ShowS
showsPrec :: Int -> NamePrefix -> ShowS
$cshow :: NamePrefix -> [Char]
show :: NamePrefix -> [Char]
$cshowList :: [NamePrefix] -> ShowS
showList :: [NamePrefix] -> ShowS
Show)

-- | The unfiltered whole-store bucket.
wholeNameSpace :: NamePrefix
wholeNameSpace :: NamePrefix
wholeNameSpace = Text -> NamePrefix
NamePrefix Text
""

-- | The prefix as a store filter and a walk cursor spell it. Empty stands for no filter at all.
renderNamePrefix :: NamePrefix -> Text
renderNamePrefix :: NamePrefix -> Text
renderNamePrefix (NamePrefix Text
raw) = Text
raw

-- | Reject prefixes outside the current alphabet so an incompatible cursor restarts the walk.
parseNamePrefix :: NameAlphabet -> Text -> Maybe NamePrefix
parseNamePrefix :: NameAlphabet -> Text -> Maybe NamePrefix
parseNamePrefix (NameAlphabet [Char]
chars) Text
raw
    | (Char -> Bool) -> Text -> Bool
T.all (Char -> [Char] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Char]
chars) Text
raw = NamePrefix -> Maybe NamePrefix
forall a. a -> Maybe a
Just (Text -> NamePrefix
NamePrefix Text
raw)
    | Bool
otherwise = Maybe NamePrefix
forall a. Maybe a
Nothing

-- | Partition the store into disjoint buckets that cover every permitted name.
initialBuckets :: NameAlphabet -> NonEmpty NamePrefix
initialBuckets :: NameAlphabet -> NonEmpty NamePrefix
initialBuckets (NameAlphabet [Char]
chars) =
    NonEmpty NamePrefix
-> (NonEmpty Char -> NonEmpty NamePrefix)
-> Maybe (NonEmpty Char)
-> NonEmpty NamePrefix
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (NamePrefix
wholeNameSpace NamePrefix -> [NamePrefix] -> NonEmpty NamePrefix
forall a. a -> [a] -> NonEmpty a
:| []) ((Char -> NamePrefix) -> NonEmpty Char -> NonEmpty NamePrefix
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> NamePrefix
NamePrefix (Text -> NamePrefix) -> (Char -> Text) -> Char -> NamePrefix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton)) ([Char] -> Maybe (NonEmpty Char)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Char]
chars)

-- | Subdivide an oversized bucket. An empty alphabet permits no subdivision.
extendBucket :: NameAlphabet -> NamePrefix -> [NamePrefix]
extendBucket :: NameAlphabet -> NamePrefix -> [NamePrefix]
extendBucket (NameAlphabet [Char]
chars) (NamePrefix Text
raw) =
    [Text -> NamePrefix
NamePrefix (Text
raw Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
ch) | Char
ch <- [Char]
chars]

-- | Whether a name falls in a bucket, for a store whose listing has no prefix filter of its own.
inBucket :: NamePrefix -> PackageName -> Bool
inBucket :: NamePrefix -> PackageName -> Bool
inBucket (NamePrefix Text
raw) PackageName
name = Text
raw Text -> Text -> Bool
`T.isPrefixOf` PackageName -> Text
unscopedName PackageName
name