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

{- | Version identity and ordering.

A 'Version' keeps the raw text verbatim, because version strings are embedded in artifact
URLs and re-served. Ordering goes through 'compareVersions' on the parsed 'VersionKey',
which exists only when the raw text parses for its ecosystem, so non-canonical text can
never reach a comparator. Parsing is per-ecosystem and the grammar modules stay private:
callers build with 'mkVersion' or 'parseVersionKey'. See
@docs\/architecture\/domain-model.md@, "Version".
-}
module Ecluse.Core.Version (
    -- * Versions
    Version,
    versionKey,
    versionKeyIn,
    mkVersion,
    renderVersion,
    compareVersions,

    -- * Canonical ordering keys
    VersionKey,
    parseVersionKey,
    VersionError (..),
    isStable,

    -- * Canonical PEP 440 spelling
    canonicalPep440,

    -- * Resolving @dist-tags.latest@
    selectLatest,
) where

import Data.Foldable (maximumBy)
import Data.List.NonEmpty qualified as NE

import Ecluse.Core.Ecosystem (Ecosystem (..))
import Ecluse.Core.Version.Gem (GemKey, isGemStable, parseGem)
import Ecluse.Core.Version.Pep440 (Pep440Key, isPep440Stable, parsePep440, renderPep440)
import Ecluse.Core.Version.Semver (SemverKey, isSemverStable, parseSemver)

{- | A package version: the raw text as published, plus the parsed ordering key when the text
parses. There is deliberately __no__ 'Ord'. Comparison goes through 'compareVersions'.
-}
data Version = Version
    { -- The version as published: for rendering and round-tripping, never for ordering.
      Version -> Text
versionRaw :: Text
    , -- Private, so the key a version carries is always the one 'mkVersion' parsed from its text.
      Version -> Maybe VersionKey
versionKeyField :: Maybe VersionKey
    }
    deriving stock (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
Eq, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Version -> ShowS
showsPrec :: Int -> Version -> ShowS
$cshow :: Version -> String
show :: Version -> String
$cshowList :: [Version] -> ShowS
showList :: [Version] -> ShowS
Show)

{- | Build a 'Version', parsing and evaluating a canonical key when possible. Total: an
unparseable version is still represented, keyless, so a proxy never drops one over a parser gap.
-}
mkVersion :: Ecosystem -> Text -> Version
mkVersion :: Ecosystem -> Text -> Version
mkVersion Ecosystem
eco Text
raw = Text -> Maybe VersionKey -> Version
Version Text
raw (Maybe VersionKey -> Version) -> Maybe VersionKey -> Version
forall a b. (a -> b) -> a -> b
$ case Ecosystem -> Text -> Either VersionError VersionKey
parseVersionKey Ecosystem
eco Text
raw of
    Right VersionKey
key -> VersionKey -> Maybe VersionKey
forall a. a -> Maybe a
Just (VersionKey -> Maybe VersionKey) -> VersionKey -> Maybe VersionKey
forall a b. (a -> b) -> a -> b
$! VersionKey
key
    Left VersionError
_ -> Maybe VersionKey
forall a. Maybe a
Nothing

-- | Render a version in wire form: the raw text, verbatim as published.
renderVersion :: Version -> Text
renderVersion :: Version -> Text
renderVersion = Version -> Text
versionRaw

{- | The parsed, canonical ordering key. 'Nothing' if the raw text did not parse for its
ecosystem, in which case ordering rules abstain.
-}
versionKey :: Version -> Maybe VersionKey
versionKey :: Version -> Maybe VersionKey
versionKey = Version -> Maybe VersionKey
versionKeyField

{- | The version's key under an ecosystem's grammar, as 'mkVersion' for that ecosystem builds it.
It reuses the key the version carries when that key is the ecosystem's, and parses otherwise.
-}
versionKeyIn :: Ecosystem -> Version -> Maybe VersionKey
versionKeyIn :: Ecosystem -> Version -> Maybe VersionKey
versionKeyIn Ecosystem
eco Version
version = case Version -> Maybe VersionKey
versionKey Version
version of
    Just VersionKey
key | VersionKey -> Ecosystem
keyEcosystem VersionKey
key Ecosystem -> Ecosystem -> Bool
forall a. Eq a => a -> a -> Bool
== Ecosystem
eco -> VersionKey -> Maybe VersionKey
forall a. a -> Maybe a
Just VersionKey
key
    Maybe VersionKey
_ -> Either VersionError VersionKey -> Maybe VersionKey
forall l r. Either l r -> Maybe r
rightToMaybe (Ecosystem -> Text -> Either VersionError VersionKey
parseVersionKey Ecosystem
eco (Version -> Text
versionRaw Version
version))

{- | Compare two versions by their canonical keys. 'Nothing' when either version has no
key, in which case an ordering-based rule abstains.
-}
compareVersions :: Version -> Version -> Maybe Ordering
compareVersions :: Version -> Version -> Maybe Ordering
compareVersions Version
a Version
b = VersionKey -> VersionKey -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (VersionKey -> VersionKey -> Ordering)
-> Maybe VersionKey -> Maybe (VersionKey -> Ordering)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Maybe VersionKey
versionKey Version
a Maybe (VersionKey -> Ordering)
-> Maybe VersionKey -> Maybe Ordering
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Version -> Maybe VersionKey
versionKey Version
b

{- | The parsed, canonical, comparable form of a version. The type is __opaque__ and
'parseVersionKey' is its only constructor, so the comparator cannot see non-canonical input.
-}
data VersionKey
    = NpmKey SemverKey
    | PyPIKey Pep440Key
    | RubyGemsKey GemKey
    deriving stock (VersionKey -> VersionKey -> Bool
(VersionKey -> VersionKey -> Bool)
-> (VersionKey -> VersionKey -> Bool) -> Eq VersionKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionKey -> VersionKey -> Bool
== :: VersionKey -> VersionKey -> Bool
$c/= :: VersionKey -> VersionKey -> Bool
/= :: VersionKey -> VersionKey -> Bool
Eq, Eq VersionKey
Eq VersionKey =>
(VersionKey -> VersionKey -> Ordering)
-> (VersionKey -> VersionKey -> Bool)
-> (VersionKey -> VersionKey -> Bool)
-> (VersionKey -> VersionKey -> Bool)
-> (VersionKey -> VersionKey -> Bool)
-> (VersionKey -> VersionKey -> VersionKey)
-> (VersionKey -> VersionKey -> VersionKey)
-> Ord VersionKey
VersionKey -> VersionKey -> Bool
VersionKey -> VersionKey -> Ordering
VersionKey -> VersionKey -> VersionKey
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 :: VersionKey -> VersionKey -> Ordering
compare :: VersionKey -> VersionKey -> Ordering
$c< :: VersionKey -> VersionKey -> Bool
< :: VersionKey -> VersionKey -> Bool
$c<= :: VersionKey -> VersionKey -> Bool
<= :: VersionKey -> VersionKey -> Bool
$c> :: VersionKey -> VersionKey -> Bool
> :: VersionKey -> VersionKey -> Bool
$c>= :: VersionKey -> VersionKey -> Bool
>= :: VersionKey -> VersionKey -> Bool
$cmax :: VersionKey -> VersionKey -> VersionKey
max :: VersionKey -> VersionKey -> VersionKey
$cmin :: VersionKey -> VersionKey -> VersionKey
min :: VersionKey -> VersionKey -> VersionKey
Ord, Int -> VersionKey -> ShowS
[VersionKey] -> ShowS
VersionKey -> String
(Int -> VersionKey -> ShowS)
-> (VersionKey -> String)
-> ([VersionKey] -> ShowS)
-> Show VersionKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionKey -> ShowS
showsPrec :: Int -> VersionKey -> ShowS
$cshow :: VersionKey -> String
show :: VersionKey -> String
$cshowList :: [VersionKey] -> ShowS
showList :: [VersionKey] -> ShowS
Show)

{- | Parse raw version text into a canonical 'VersionKey' for its ecosystem, or report why it
did not parse. The 'Ord' on the result is meaningful only within one ecosystem.
-}
parseVersionKey :: Ecosystem -> Text -> Either VersionError VersionKey
parseVersionKey :: Ecosystem -> Text -> Either VersionError VersionKey
parseVersionKey Ecosystem
eco Text
raw = case Ecosystem
eco of
    Ecosystem
Npm -> Maybe VersionKey -> Either VersionError VersionKey
forall {b}. Maybe b -> Either VersionError b
note (SemverKey -> VersionKey
NpmKey (SemverKey -> VersionKey) -> Maybe SemverKey -> Maybe VersionKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe SemverKey
parseSemver Text
raw)
    Ecosystem
PyPI -> Maybe VersionKey -> Either VersionError VersionKey
forall {b}. Maybe b -> Either VersionError b
note (Pep440Key -> VersionKey
PyPIKey (Pep440Key -> VersionKey) -> Maybe Pep440Key -> Maybe VersionKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Pep440Key
parsePep440 Text
raw)
    Ecosystem
RubyGems -> Maybe VersionKey -> Either VersionError VersionKey
forall {b}. Maybe b -> Either VersionError b
note (GemKey -> VersionKey
RubyGemsKey (GemKey -> VersionKey) -> Maybe GemKey -> Maybe VersionKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe GemKey
parseGem Text
raw)
  where
    note :: Maybe b -> Either VersionError b
note = Either VersionError b
-> (b -> Either VersionError b) -> Maybe b -> Either VersionError b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (VersionError -> Either VersionError b
forall a b. a -> Either a b
Left (Text -> VersionError
VersionError (Text
"unparseable version: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
raw))) b -> Either VersionError b
forall a b. b -> Either a b
Right

-- 'parseVersionKey' builds each ecosystem's key with its own constructor.
keyEcosystem :: VersionKey -> Ecosystem
keyEcosystem :: VersionKey -> Ecosystem
keyEcosystem = \case
    NpmKey SemverKey
_ -> Ecosystem
Npm
    PyPIKey Pep440Key
_ -> Ecosystem
PyPI
    RubyGemsKey GemKey
_ -> Ecosystem
RubyGems

-- | Why a version string failed to parse.
newtype VersionError = VersionError
    { VersionError -> Text
versionErrorMessage :: Text
    }
    deriving stock (VersionError -> VersionError -> Bool
(VersionError -> VersionError -> Bool)
-> (VersionError -> VersionError -> Bool) -> Eq VersionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionError -> VersionError -> Bool
== :: VersionError -> VersionError -> Bool
$c/= :: VersionError -> VersionError -> Bool
/= :: VersionError -> VersionError -> Bool
Eq, Int -> VersionError -> ShowS
[VersionError] -> ShowS
VersionError -> String
(Int -> VersionError -> ShowS)
-> (VersionError -> String)
-> ([VersionError] -> ShowS)
-> Show VersionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionError -> ShowS
showsPrec :: Int -> VersionError -> ShowS
$cshow :: VersionError -> String
show :: VersionError -> String
$cshowList :: [VersionError] -> ShowS
showList :: [VersionError] -> ShowS
Show)

{- | Whether a parsed version is a __stable__ (final, non-prerelease) release, under its own
ecosystem's notion of one.

>>> isStable <$> parseVersionKey Npm "1.0.0"
Right True
>>> isStable <$> parseVersionKey Npm "1.0.0-rc.1"
Right False
>>> isStable <$> parseVersionKey PyPI "1.0.post1"
Right True
>>> isStable <$> parseVersionKey PyPI "1.0a1.dev2"
Right False
>>> isStable <$> parseVersionKey RubyGems "1.0.0.pre"
Right False
-}
isStable :: VersionKey -> Bool
isStable :: VersionKey -> Bool
isStable = \case
    NpmKey SemverKey
k -> SemverKey -> Bool
isSemverStable SemverKey
k
    PyPIKey Pep440Key
k -> Pep440Key -> Bool
isPep440Stable Pep440Key
k
    RubyGemsKey GemKey
k -> GemKey -> Bool
isGemStable GemKey
k

{- | The one spelling a PEP 440 version canonicalises to, which a PyPI projection keys by so two
spellings of one release merge. The raw spelling survives per artifact through the filename.

>>> canonicalPep440 "1.0.0"
Just "1"
>>> canonicalPep440 "not-a-version"
Nothing
-}
canonicalPep440 :: Text -> Maybe Text
canonicalPep440 :: Text -> Maybe Text
canonicalPep440 = (Pep440Key -> Text) -> Maybe Pep440Key -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pep440Key -> Text
renderPep440 (Maybe Pep440Key -> Maybe Text)
-> (Text -> Maybe Pep440Key) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Pep440Key
parsePep440

{- | Resolve @dist-tags.latest@ over the survivors the caller left, keeping @chosen@ when it
survives so a prerelease never displaces a maintainer's stable tag. The result is a survivor.
-}
selectLatest :: Maybe Version -> [Version] -> Maybe Version
selectLatest :: Maybe Version -> [Version] -> Maybe Version
selectLatest Maybe Version
chosen [Version]
survivors = case [Version] -> Maybe (NonEmpty Version)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Version]
survivors of
    Maybe (NonEmpty Version)
Nothing -> Maybe Version
forall a. Maybe a
Nothing
    Just NonEmpty Version
survivors1
        | Just Version
v <- Maybe Version
chosen, Version -> Bool
survives Version
v -> Version -> Maybe Version
forall a. a -> Maybe a
Just Version
v
        | Bool
otherwise -> Version -> Maybe Version
forall a. a -> Maybe a
Just (NonEmpty Version -> Version
repointLatest NonEmpty Version
survivors1)
  where
    survives :: Version -> Bool
survives Version
v = (Version -> Bool) -> [Version] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Text
renderVersion Version
v) (Text -> Bool) -> (Version -> Text) -> Version -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
renderVersion) [Version]
survivors

-- The repoint arm: the greatest stable key, else the greatest key of any kind, else the
-- lexicographically smallest survivor, so an unparseable set still names a present version.
repointLatest :: NonEmpty Version -> Version
repointLatest :: NonEmpty Version -> Version
repointLatest NonEmpty Version
survivors =
    let keyed :: [(Version, VersionKey)]
keyed = [(Version
v, VersionKey
k) | Version
v <- NonEmpty Version -> [Version]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Version
survivors, Just VersionKey
k <- [Version -> Maybe VersionKey
versionKey Version
v]]
        stable :: [(Version, VersionKey)]
stable = [(Version, VersionKey)
vk | vk :: (Version, VersionKey)
vk@(Version
_, VersionKey
k) <- [(Version, VersionKey)]
keyed, VersionKey -> Bool
isStable VersionKey
k]
     in case [(Version, VersionKey)] -> Maybe (NonEmpty (Version, VersionKey))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [(Version, VersionKey)]
stable of
            Just NonEmpty (Version, VersionKey)
s -> (Version, VersionKey) -> Version
forall a b. (a, b) -> a
fst (NonEmpty (Version, VersionKey) -> (Version, VersionKey)
maxByKey NonEmpty (Version, VersionKey)
s)
            Maybe (NonEmpty (Version, VersionKey))
Nothing -> case [(Version, VersionKey)] -> Maybe (NonEmpty (Version, VersionKey))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [(Version, VersionKey)]
keyed of
                Just NonEmpty (Version, VersionKey)
ks -> (Version, VersionKey) -> Version
forall a b. (a, b) -> a
fst (NonEmpty (Version, VersionKey) -> (Version, VersionKey)
maxByKey NonEmpty (Version, VersionKey)
ks)
                Maybe (NonEmpty (Version, VersionKey))
Nothing -> NonEmpty Version -> Version
forall a. NonEmpty a -> a
NE.head ((Version -> Text) -> NonEmpty Version -> NonEmpty Version
forall o a. Ord o => (a -> o) -> NonEmpty a -> NonEmpty a
NE.sortWith Version -> Text
renderVersion NonEmpty Version
survivors)

-- Greatest by canonical key. Total, because every element carries a key.
maxByKey :: NonEmpty (Version, VersionKey) -> (Version, VersionKey)
maxByKey :: NonEmpty (Version, VersionKey) -> (Version, VersionKey)
maxByKey = ((Version, VersionKey) -> (Version, VersionKey) -> Ordering)
-> NonEmpty (Version, VersionKey) -> (Version, VersionKey)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((Version, VersionKey) -> VersionKey)
-> (Version, VersionKey) -> (Version, VersionKey) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Version, VersionKey) -> VersionKey
forall a b. (a, b) -> b
snd)