{- | The @Gem::Version@ grammar and ordering (RubyGems).

Parses a gem version into a 'GemKey': a flat list of 'VToken's obtained by
splitting on dots and then into maximal digit and letter runs, then
__canonicalised__ the way @Gem::Version#canonical_segments@ is -- trailing zeros are
dropped from the numeric release and from the prerelease tail independently, so
@2.0.a@ keys as @[2, "a"]@. Ordering compares the canonical token lists
position-by-position, zero-padding the shorter side, so @1.0 == 1.0.0@,
@2.0.a == 2.a@, @2.t > 2.0.a@, and a trailing letter (prerelease) segment sorts
below the bare release (a 'VStr' ranks below 'VNum 0'; see "Ecluse.Core.Version.Token").

A gem version is __stable__ iff every token is numeric -- no letter segment, i.e.
no prerelease marker such as @.pre@ or @.rc1@.
-}
module Ecluse.Core.Version.Gem (
    GemKey (..),
    parseGem,
    compareGemTokens,
    isGemStable,
) where

import Data.Char (isDigit)
import Data.List (dropWhileEnd)
import Data.Text qualified as T

import Ecluse.Core.Version.Token (VToken (..), isAsciiAlphaNum, maxVersionLength, numOr0)

{- | A parsed @Gem::Version@: a flat token list compared with zero-padding, with
numeric tokens outranking textual ones (see 'VToken').
-}
newtype GemKey = GemKey [VToken]
    deriving stock (GemKey -> GemKey -> Bool
(GemKey -> GemKey -> Bool)
-> (GemKey -> GemKey -> Bool) -> Eq GemKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GemKey -> GemKey -> Bool
== :: GemKey -> GemKey -> Bool
$c/= :: GemKey -> GemKey -> Bool
/= :: GemKey -> GemKey -> Bool
Eq, Int -> GemKey -> ShowS
[GemKey] -> ShowS
GemKey -> String
(Int -> GemKey -> ShowS)
-> (GemKey -> String) -> ([GemKey] -> ShowS) -> Show GemKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GemKey -> ShowS
showsPrec :: Int -> GemKey -> ShowS
$cshow :: GemKey -> String
show :: GemKey -> String
$cshowList :: [GemKey] -> ShowS
showList :: [GemKey] -> ShowS
Show)

instance Ord GemKey where
    compare :: GemKey -> GemKey -> Ordering
compare (GemKey [VToken]
a) (GemKey [VToken]
b) = [VToken] -> [VToken] -> Ordering
compareGemTokens [VToken]
a [VToken]
b

-- | Compare gem token lists, zero-padding the shorter side.
compareGemTokens :: [VToken] -> [VToken] -> Ordering
compareGemTokens :: [VToken] -> [VToken] -> Ordering
compareGemTokens [] [] = Ordering
EQ
compareGemTokens (VToken
x : [VToken]
xs) (VToken
y : [VToken]
ys) = VToken -> VToken -> Ordering
forall a. Ord a => a -> a -> Ordering
compare VToken
x VToken
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> [VToken] -> [VToken] -> Ordering
compareGemTokens [VToken]
xs [VToken]
ys
compareGemTokens (VToken
x : [VToken]
xs) [] = VToken -> VToken -> Ordering
forall a. Ord a => a -> a -> Ordering
compare VToken
x (Integer -> VToken
VNum Integer
0) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> [VToken] -> [VToken] -> Ordering
compareGemTokens [VToken]
xs []
compareGemTokens [] (VToken
y : [VToken]
ys) = VToken -> VToken -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer -> VToken
VNum Integer
0) VToken
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> [VToken] -> [VToken] -> Ordering
compareGemTokens [] [VToken]
ys

{- | Parse a @Gem::Version@: dot-separated alphanumeric segments, each split into
maximal digit and letter runs. Hyphens are first rewritten to a prerelease marker
(a global @gsub("-", ".pre.")@, the way @Gem::Version@ canonicalises), so
@1.0.0-1@ parses as @1.0.0.pre.1@ and orders below @1.0.0@. Fails on empty or
non-alphanumeric segments.
-}
parseGem :: Text -> Maybe GemKey
parseGem :: Text -> Maybe GemKey
parseGem Text
raw = do
    -- Bound the input length before any numeric parsing: a digit run is read into an
    -- 'Integer' with 'readMaybe', which is quadratic in the digit count, so an
    -- unbounded run in hostile metadata would be an algorithmic-complexity DoS.
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Int -> Ordering
T.compareLength Text
raw Int
maxVersionLength Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT)
    let stripped :: Text
stripped = Text -> Text
T.strip Text
raw
        -- Gem::Version canonicalises hyphens to a prerelease marker via a global
        -- gsub("-", ".pre.") before segmenting, so e.g. "1.0.0-1" parses as the
        -- prerelease "1.0.0.pre.1" and orders below "1.0.0". Non-hyphenated input
        -- is untouched, so existing orderings are unchanged.
        segs :: [Text]
segs = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"-" Text
".pre." Text
stripped)
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Text -> Bool
T.null Text
stripped))
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
validSeg [Text]
segs)
    let toks :: [VToken]
toks = (Text -> [VToken]) -> [Text] -> [VToken]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [VToken]
segTokens [Text]
segs
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not ([VToken] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VToken]
toks))
    GemKey -> Maybe GemKey
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([VToken] -> GemKey
GemKey ([VToken] -> [VToken]
canonicalSegments [VToken]
toks))
  where
    validSeg :: Text -> Bool
validSeg Text
s = Bool -> Bool
not (Text -> Bool
T.null Text
s) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAsciiAlphaNum Text
s
    segTokens :: Text -> [VToken]
segTokens = (Text -> VToken) -> [Text] -> [VToken]
forall a b. (a -> b) -> [a] -> [b]
map Text -> VToken
classify ([Text] -> [VToken]) -> (Text -> [Text]) -> Text -> [VToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy (\Char
c1 Char
c2 -> Char -> Bool
isDigit Char
c1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Bool
isDigit Char
c2)
    classify :: Text -> VToken
classify Text
g = if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
g then Integer -> VToken
VNum (Text -> Integer
numOr0 Text
g) else Text -> VToken
VStr Text
g

{- Canonicalise a gem token list the way @Gem::Version#canonical_segments@ does:
split it at the first textual (prerelease) token into a numeric release and a
prerelease tail, drop trailing zeros from /each/ part, then rejoin. So @2.0.a@ keys
as @[2, "a"]@ (the release's trailing zero is dropped before the prerelease) -- which
is why @2.t > 2.0.a@ and @2.0.a == 2.a@. Comparing the un-canonicalised flat lists
would instead reach a numeric-vs-textual position and order them the other way.
-}
canonicalSegments :: [VToken] -> [VToken]
canonicalSegments :: [VToken] -> [VToken]
canonicalSegments [VToken]
toks =
    let ([VToken]
release, [VToken]
prerelease) = (VToken -> Bool) -> [VToken] -> ([VToken], [VToken])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break VToken -> Bool
isText [VToken]
toks
     in [VToken] -> [VToken]
dropTrailingZeros [VToken]
release [VToken] -> [VToken] -> [VToken]
forall a. Semigroup a => a -> a -> a
<> [VToken] -> [VToken]
dropTrailingZeros [VToken]
prerelease
  where
    isText :: VToken -> Bool
isText = \case
        VStr Text
_ -> Bool
True
        VNum Integer
_ -> Bool
False
    dropTrailingZeros :: [VToken] -> [VToken]
dropTrailingZeros = (VToken -> Bool) -> [VToken] -> [VToken]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (VToken -> VToken -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> VToken
VNum Integer
0)

{- | Whether a gem version is stable: every token is numeric (no letter segment).
So @1.0.0@ is stable; @1.0.0.pre@ and @1.2.0.rc1@ are not.
-}
isGemStable :: GemKey -> Bool
isGemStable :: GemKey -> Bool
isGemStable (GemKey [VToken]
toks) = (VToken -> Bool) -> [VToken] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all VToken -> Bool
isNumToken [VToken]
toks
  where
    isNumToken :: VToken -> Bool
isNumToken = \case
        VNum Integer
_ -> Bool
True
        VStr Text
_ -> Bool
False