{- | Version identity and ordering.

A 'Version' carries the raw text verbatim (version strings are embedded in
artifact URLs and re-served, so fidelity matters) alongside a parsed, canonical
'VersionKey' -- present only when the raw text parses for its ecosystem. Ordering
goes through 'compareVersions', which is defined __only__ on parsed keys, so
non-canonical text can never reach the comparator (/parse, don't validate/).

Parsing is per-ecosystem and selected by the 'Ecosystem' tag from
"Ecluse.Core.Ecosystem": semver for npm ("Ecluse.Core.Version.Semver"), PEP 440 for PyPI
("Ecluse.Core.Version.Pep440"), @Gem::Version@ for RubyGems ("Ecluse.Core.Version.Gem").
Each grammar and its ordering rules live in its own module; this module is the
agnostic abstraction that dispatches to them on the 'Ecosystem' tag. The grammar
modules are kept __private__ -- callers build with 'mkVersion' (total) or
'parseVersionKey' (reports the parse error) and compare with 'compareVersions'.

This vocabulary is consumed by "Ecluse.Core.Package" (@PackageDetails@ holds a
'Version') and the rules engine ("Ecluse.Core.Rules"). See
@docs\/architecture\/domain-model.md@ → "Version".
-}
module Ecluse.Core.Version (
    -- * Versions
    Version,
    versionKey,
    mkVersion,
    unVersion,
    renderVersion,
    compareVersions,

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

    -- * 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)
import Ecluse.Core.Version.Semver (SemverKey, isSemverStable, parseSemver)

{- | A package version.

The raw text is kept verbatim for faithful round-trip (version strings are
embedded in artifact URLs and re-served), while a parsed, canonical
'VersionKey' -- present only when the raw text parses for its ecosystem -- is what
ordering uses. Build with 'mkVersion' (total: an unparseable version is still
represented, just with no key, so a proxy never drops a version over a parser
gap) or 'parseVersionKey' when you want the parse error.

There is deliberately __no__ 'Ord' on 'Version': comparison goes through
'compareVersions', which is defined only on parsed keys, so non-canonical text
can never reach the comparator.
-}
data Version = Version
    { -- The version as published -- used for rendering and round-tripping only,
      -- never for ordering decisions.
      Version -> Text
versionRaw :: Text
    , Version -> Maybe VersionKey
versionKey :: Maybe VersionKey
    {- ^ The parsed, canonical ordering key; 'Nothing' if the raw text could not
    be parsed for its ecosystem (ordering rules then abstain).
    -}
    }
    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 the raw text into a canonical key when possible.
Total: a version that does not parse is still represented (with no key) rather
than rejected, so a proxy never drops a version over a parser gap.
-}
mkVersion :: Ecosystem -> Text -> Version
mkVersion :: Ecosystem -> Text -> Version
mkVersion Ecosystem
eco Text
raw = Text -> Maybe VersionKey -> Version
Version Text
raw (Either VersionError VersionKey -> Maybe VersionKey
forall l r. Either l r -> Maybe r
rightToMaybe (Ecosystem -> Text -> Either VersionError VersionKey
parseVersionKey Ecosystem
eco Text
raw))

-- | The raw version text.
unVersion :: Version -> Text
unVersion :: Version -> Text
unVersion = Version -> Text
versionRaw

-- | Render a version in wire form (the raw text).
renderVersion :: Version -> Text
renderVersion :: Version -> Text
renderVersion = Version -> Text
versionRaw

{- | Compare two versions by their canonical keys. 'Nothing' if either version
did not parse (its key is absent) -- an ordering-based rule should then abstain,
mirroring the other "unknown signal" cases (@CodeExecUnknown@, @TrustUnknown@).
-}
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

{- | Whether a parsed version is a __stable__ (final, non-prerelease) release.
The notion is ecosystem-specific, dispatched on the key's constructor:

* __semver (npm)__ -- stable iff there is no @-prerelease@ component (the
  prerelease is 'SemverFinal'). So @1.0.0@ is stable; @1.0.0-rc.1@ and
  @2.0.0-beta@ are not.
* __PEP 440 (PyPI)__ -- stable iff it is neither a pre-release (@a@\/@b@\/@rc@)
  nor a dev release. Post-releases /are/ stable. So @1.0@ and @1.0.post1@ are
  stable; @1.0a1@, @1.0rc1@, @1.0.dev1@ and @1.0a1.dev2@ are not.
* __RubyGems__ -- stable iff no segment contains a letter (the version is
  all-numeric). So @1.0.0@ is stable; @1.0.0.pre@ and @1.2.0.rc1@ are not.

Used by 'selectLatest' to prefer a stable release when @dist-tags.latest@ must
be repointed.

>>> 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

{- | Resolve @dist-tags.latest@ for a packument after denied\/undecidable
versions have been filtered out -- the __keep-unless-denied, stable-preferring__
rule from @docs\/architecture\/rules-engine.md@ ("Applying verdicts to a
packument"). @chosen@ is the source's currently-tagged @latest@ (if any);
@survivors@ is the surviving versions. The result, when present, is always one
of @survivors@, so the caller can use its 'unVersion' as the tag string.

The resolution, in order:

* If @survivors@ is empty, there is nothing to point at -- 'Nothing'.
* __Keep:__ if @chosen@ survives (by raw text), return it unchanged. This is the
  identity on a single-input packument and never /promotes/ a prerelease over a
  maintainer's chosen stable @latest@.
* __Repoint__ (only when the chosen @latest@ did not survive): among survivors
  with a parseable key, prefer the maximum __stable__ one; if none are stable,
  the maximum __prerelease__ one. (Within one ecosystem parseable keys are
  totally ordered, so 'compareVersions' is total over them.)
* __No parseable survivor:__ to keep the result naming a present version, fall
  back to the lexicographically-smallest survivor by 'unVersion'. An unparseable
  version never outranks a parseable one.
-}
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
unVersion Version
v) (Text -> Bool) -> (Version -> Text) -> Version -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
unVersion) [Version]
survivors

-- The repoint arm of 'selectLatest' (its Haddock documents the resolution
-- order): the maximum stable survivor, else the maximum parseable survivor,
-- else the lexicographically-smallest raw text.
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)
                -- No parseable survivor: deterministic, present fallback.
                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
unVersion NonEmpty Version
survivors)
  where
    -- 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)

-- | 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)

{- | The parsed, canonical, comparable form of a version. __Opaque__: the only
way to obtain one is 'parseVersionKey', so a 'VersionKey' always holds a
well-formed, normalised version -- the comparator structurally cannot see
non-canonical input (parse, don't validate). Its 'Ord' is meaningful only within
a single ecosystem, which is the only case that ever arises (one compares
versions of one package).
-}
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 could not be parsed. This is the parsing boundary: downstream code
holds a 'VersionKey' and relies on it being valid.
-}
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