{-# LANGUAGE CPP, MultiWayIf #-}

-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 2 of the License, or
-- (at your option) any later version.

-- String-ified version of vercmp from codec-rpm-0.2.2/Codec/RPM/Version.hs
-- Copyright 2016-2018 Red Hat
-- Copyright 2021 Jens Petersen

-- | Compare versions or releases using rpm's vercmp algorithm
module Data.RPM.VerCmp (rpmVerCompare)
where

import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
import Data.List (isPrefixOf)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif

-- | Compare two version numbers and return an 'Ordering'.
--
-- Native implementation of rpm's C vercmp
rpmVerCompare :: String -> String -> Ordering
rpmVerCompare :: String -> String -> Ordering
rpmVerCompare a :: String
a b :: String
b =
  if String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b then Ordering
EQ
    else let
    -- strip out all non-version characters
    -- keep in mind the strings may be empty after this
    a' :: String
a' = String -> String
dropSeparators String
a
    b' :: String
b' = String -> String
dropSeparators String
b

    -- rpm compares strings by digit and non-digit components, so grab the first
    -- component of one type
    fn :: Char -> Bool
fn = if Char -> Bool
isDigit (String -> Char
forall a. [a] -> a
head String
a') then Char -> Bool
isDigit else Char -> Bool
isAsciiAlpha
    (prefixA :: String
prefixA, suffixA :: String
suffixA) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
fn String
a'
    (prefixB :: String
prefixB, suffixB :: String
suffixB) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
fn String
b'
 in
    if | String
a' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b'                                       -> Ordering
EQ
       -- Nothing left means the versions are equal
       {- null a' && null b'                             -> EQ -}
       -- tilde is less than everything, including an empty string
       | ("~" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a') Bool -> Bool -> Bool
&& ("~" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
b') -> String -> String -> Ordering
rpmVerCompare (String -> String
forall a. [a] -> [a]
tail String
a') (String -> String
forall a. [a] -> [a]
tail String
b')
       | ("~" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a')                            -> Ordering
LT
       | ("~" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
b')                            -> Ordering
GT
       -- caret is more than everything, except .
       | ("^" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a') Bool -> Bool -> Bool
&& ("^" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
b') -> String -> String -> Ordering
rpmVerCompare (String -> String
forall a. [a] -> [a]
tail String
a') (String -> String
forall a. [a] -> [a]
tail String
b')
       | ("^" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a') Bool -> Bool -> Bool
&& String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
b'               -> Ordering
GT
       | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
a' Bool -> Bool -> Bool
&& ("^" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
b')               -> Ordering
LT
       | ("^" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a')                            -> Ordering
LT
       | ("^" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
b')                            -> Ordering
GT
       -- otherwise, if one of the strings is null, the other is greater
       | (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
a')                                        -> Ordering
LT
       | (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
b')                                        -> Ordering
GT
       -- Now we have two non-null strings, starting with a non-tilde version character
       -- If one prefix is a number and the other is a string, the one that is a number
       -- is greater.
       | Char -> Bool
isDigit (String -> Char
forall a. [a] -> a
head String
a') Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) (String -> Char
forall a. [a] -> a
head String
b') -> Ordering
GT
       | (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) (String -> Char
forall a. [a] -> a
head String
a') Bool -> Bool -> Bool
&& Char -> Bool
isDigit (String -> Char
forall a. [a] -> a
head String
b') -> Ordering
LT
       | Char -> Bool
isDigit (String -> Char
forall a. [a] -> a
head String
a')                                -> (String
prefixA String -> String -> Ordering
`compareAsInts` String
prefixB) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (String
suffixA String -> String -> Ordering
`rpmVerCompare` String
suffixB)
       | Bool
otherwise                                          -> (String
prefixA String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` String
prefixB) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (String
suffixA String -> String -> Ordering
`rpmVerCompare` String
suffixB)
 where
    compareAsInts :: String -> String -> Ordering
    -- the version numbers can overflow Int, so strip leading 0's and do a string compare,
    -- longest string wins
    compareAsInts :: String -> String -> Ordering
compareAsInts x :: String
x y :: String
y =
        let x' :: String
x' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '0') String
x
            y' :: String
y' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '0') String
y
        in
            if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
y' then Ordering
GT
            else String
x' String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` String
y'

    -- isAlpha returns any unicode alpha, but we just want ASCII characters
    isAsciiAlpha :: Char -> Bool
    isAsciiAlpha :: Char -> Bool
isAsciiAlpha x :: Char
x = Char -> Bool
isAsciiLower Char
x Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
x

    -- RPM only cares about ascii digits, ascii alpha, and ~ ^
    isVersionChar :: Char -> Bool
    isVersionChar :: Char -> Bool
isVersionChar x :: Char
x = Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char -> Bool
isAsciiAlpha Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '~' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '^'

    dropSeparators :: String -> String
    dropSeparators :: String -> String
dropSeparators = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isVersionChar)