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

{- | PyPI first-party ownership by exact project name or separator-delimited prefix.
Exact declarations share the routed grammar in "Ecluse.Core.Registry.PyPI.Project".
-}
module Ecluse.Core.Registry.PyPI.FirstParty (
    -- * Name prefixes
    PyPIPrefix,
    mkPyPIPrefix,
    underPyPIPrefix,

    -- * First-party declarations
    PyPIFirstParty (..),
    projectFirstPartyEntry,
    pypiFirstPartyName,
) where

import Data.Char (isAlphaNum, isAscii)
import Data.Text qualified as T
import Data.Text.Short (ShortText)
import Data.Text.Short qualified as TS

import Ecluse.Core.Ecosystem (Ecosystem (PyPI))
import Ecluse.Core.Package (PackageName, canonicalise, pkgCanonical, pkgEcosystem)
import Ecluse.Core.Registry (ParseError (..))
import Ecluse.Core.Registry.PyPI.Project (isNameSeparator, projectName)
import Ecluse.Core.Registry.WireSupport (parseNameComponent)

-- | A distribution-name prefix in PEP 503 canonical form.
newtype PyPIPrefix = PyPIPrefix ShortText
    deriving stock (PyPIPrefix -> PyPIPrefix -> Bool
(PyPIPrefix -> PyPIPrefix -> Bool)
-> (PyPIPrefix -> PyPIPrefix -> Bool) -> Eq PyPIPrefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PyPIPrefix -> PyPIPrefix -> Bool
== :: PyPIPrefix -> PyPIPrefix -> Bool
$c/= :: PyPIPrefix -> PyPIPrefix -> Bool
/= :: PyPIPrefix -> PyPIPrefix -> Bool
Eq, Int -> PyPIPrefix -> ShowS
[PyPIPrefix] -> ShowS
PyPIPrefix -> String
(Int -> PyPIPrefix -> ShowS)
-> (PyPIPrefix -> String)
-> ([PyPIPrefix] -> ShowS)
-> Show PyPIPrefix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PyPIPrefix -> ShowS
showsPrec :: Int -> PyPIPrefix -> ShowS
$cshow :: PyPIPrefix -> String
show :: PyPIPrefix -> String
$cshowList :: [PyPIPrefix] -> ShowS
showList :: [PyPIPrefix] -> ShowS
Show)

{- | Build a canonical prefix, accepting terminal separators.
Empty, separator-only, or non-name text yields 'Nothing'.
-}
mkPyPIPrefix :: Text -> Maybe PyPIPrefix
mkPyPIPrefix :: Text -> Maybe PyPIPrefix
mkPyPIPrefix Text
raw = do
    canonical <- Either NameRefusal Text -> Maybe Text
forall l r. Either l r -> Maybe r
rightToMaybe (Text -> Either NameRefusal Text
parseNameComponent (Ecosystem -> Text -> Text
canonicalise Ecosystem
PyPI Text
raw))
    guard (T.all canonicalPyPIChar canonical)
    pure (PyPIPrefix (TS.fromText canonical))

-- PEP 503's canonical alphabet, the form the PyPI canonicaliser leaves a legal name in.
canonicalPyPIChar :: Char -> Bool
canonicalPyPIChar :: Char -> Bool
canonicalPyPIChar Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| (Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c)

-- | Match at a separator: @acme@ covers @acme-tools@, excluding @acmeco@ and bare @acme@.
underPyPIPrefix :: PyPIPrefix -> PackageName -> Bool
underPyPIPrefix :: PyPIPrefix -> PackageName -> Bool
underPyPIPrefix (PyPIPrefix ShortText
prefix) PackageName
name =
    PackageName -> Ecosystem
pkgEcosystem PackageName
name Ecosystem -> Ecosystem -> Bool
forall a. Eq a => a -> a -> Bool
== Ecosystem
PyPI Bool -> Bool -> Bool
&& ShortText -> ShortText -> Bool
TS.isPrefixOf (ShortText
prefix ShortText -> ShortText -> ShortText
forall a. Semigroup a => a -> a -> a
<> ShortText
"-") (PackageName -> ShortText
pkgCanonical PackageName
name)

-- | A distribution or a prefix owned by the deployment.
data PyPIFirstParty
    = -- | A distribution the deployment owns, matched on its PEP 503 canonical name.
      PyPIOwnedName PackageName
    | -- | A prefix the deployment owns, matched at PEP 503's separator boundary.
      PyPIOwnedPrefix PyPIPrefix
    deriving stock (PyPIFirstParty -> PyPIFirstParty -> Bool
(PyPIFirstParty -> PyPIFirstParty -> Bool)
-> (PyPIFirstParty -> PyPIFirstParty -> Bool) -> Eq PyPIFirstParty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PyPIFirstParty -> PyPIFirstParty -> Bool
== :: PyPIFirstParty -> PyPIFirstParty -> Bool
$c/= :: PyPIFirstParty -> PyPIFirstParty -> Bool
/= :: PyPIFirstParty -> PyPIFirstParty -> Bool
Eq, Int -> PyPIFirstParty -> ShowS
[PyPIFirstParty] -> ShowS
PyPIFirstParty -> String
(Int -> PyPIFirstParty -> ShowS)
-> (PyPIFirstParty -> String)
-> ([PyPIFirstParty] -> ShowS)
-> Show PyPIFirstParty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PyPIFirstParty -> ShowS
showsPrec :: Int -> PyPIFirstParty -> ShowS
$cshow :: PyPIFirstParty -> String
show :: PyPIFirstParty -> String
$cshowList :: [PyPIFirstParty] -> ShowS
showList :: [PyPIFirstParty] -> ShowS
Show)

{- | Parse an exact 'projectName' or a prefix ending in a separator then @*@.
Refuse @acme*@, which would otherwise claim names such as @acmeco@.
-}
projectFirstPartyEntry :: Text -> Either ParseError PyPIFirstParty
projectFirstPartyEntry :: Text -> Either ParseError PyPIFirstParty
projectFirstPartyEntry Text
entry = case Text -> Text -> Maybe Text
T.stripSuffix Text
"*" Text
entry of
    Just Text
prefix
        | Text -> Bool
endsAtSeparator Text
prefix -> Either ParseError PyPIFirstParty
-> (PyPIPrefix -> Either ParseError PyPIFirstParty)
-> Maybe PyPIPrefix
-> Either ParseError PyPIFirstParty
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either ParseError PyPIFirstParty
forall a. Either ParseError a
invalid (PyPIFirstParty -> Either ParseError PyPIFirstParty
forall a b. b -> Either a b
Right (PyPIFirstParty -> Either ParseError PyPIFirstParty)
-> (PyPIPrefix -> PyPIFirstParty)
-> PyPIPrefix
-> Either ParseError PyPIFirstParty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PyPIPrefix -> PyPIFirstParty
PyPIOwnedPrefix) (Text -> Maybe PyPIPrefix
mkPyPIPrefix Text
prefix)
        | Bool
otherwise -> Either ParseError PyPIFirstParty
forall a. Either ParseError a
invalid
    Maybe Text
Nothing -> (ParseError -> Either ParseError PyPIFirstParty)
-> (PackageName -> Either ParseError PyPIFirstParty)
-> Either ParseError PackageName
-> Either ParseError PyPIFirstParty
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either ParseError PyPIFirstParty
-> ParseError -> Either ParseError PyPIFirstParty
forall a b. a -> b -> a
const Either ParseError PyPIFirstParty
forall a. Either ParseError a
invalid) (PyPIFirstParty -> Either ParseError PyPIFirstParty
forall a b. b -> Either a b
Right (PyPIFirstParty -> Either ParseError PyPIFirstParty)
-> (PackageName -> PyPIFirstParty)
-> PackageName
-> Either ParseError PyPIFirstParty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> PyPIFirstParty
PyPIOwnedName) (Text -> Either ParseError PackageName
projectName Text
entry)
  where
    invalid :: Either ParseError a
    invalid :: forall a. Either ParseError a
invalid = ParseError -> Either ParseError a
forall a b. a -> Either a b
Left (Text -> ParseError
ParseError (Text
"invalid PyPI first-party entry: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall b a. (Show a, IsString b) => a -> b
show Text
entry))

endsAtSeparator :: Text -> Bool
endsAtSeparator :: Text -> Bool
endsAtSeparator Text
prefix = Bool -> ((Text, Char) -> Bool) -> Maybe (Text, Char) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Char -> Bool
isNameSeparator (Char -> Bool) -> ((Text, Char) -> Char) -> (Text, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Char) -> Char
forall a b. (a, b) -> b
snd) (Text -> Maybe (Text, Char)
T.unsnoc Text
prefix)

-- | Match an exact canonical name or a declared prefix. Deny by default.
pypiFirstPartyName :: NonEmpty PyPIFirstParty -> PackageName -> Bool
pypiFirstPartyName :: NonEmpty PyPIFirstParty -> PackageName -> Bool
pypiFirstPartyName NonEmpty PyPIFirstParty
entries PackageName
name = (PyPIFirstParty -> Bool) -> NonEmpty PyPIFirstParty -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (PyPIFirstParty -> PackageName -> Bool
`owns` PackageName
name) NonEmpty PyPIFirstParty
entries

owns :: PyPIFirstParty -> PackageName -> Bool
owns :: PyPIFirstParty -> PackageName -> Bool
owns = \case
    PyPIOwnedName PackageName
owned -> (PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
owned)
    PyPIOwnedPrefix PyPIPrefix
prefix -> PyPIPrefix -> PackageName -> Bool
underPyPIPrefix PyPIPrefix
prefix