{-# 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 String
a String
b =
  if String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b then Ordering
EQ
  else
    -- strip out all non-version characters
    -- keep in mind the strings may be empty after this
    let 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
        (String
prefixA, String
suffixA) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
fn String
a'
        (String
prefixB, 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 -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a') Bool -> Bool -> Bool
&& (String
"~" 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 -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a')                            -> Ordering
LT
       | (String
"~" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
b')                            -> Ordering
GT
       -- caret is more than everything, except .
       | (String
"^" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a') Bool -> Bool -> Bool
&& (String
"^" 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 -> 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 -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
b')               -> Ordering
LT
       | (String
"^" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a')                            -> Ordering
LT
       | (String
"^" 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 String
x String
y =
      if | String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y -> Ordering
EQ
         | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x -> Ordering
LT
         | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
y -> Ordering
GT
         | Bool
otherwise ->
           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
== Char
'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
== Char
'0') String
y
           in
             case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x') (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
y') of
               Ordering
EQ ->
                 (String -> Int
forall a. Read a => String -> a
read String
x' :: Int) Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` String -> Int
forall a. Read a => String -> a
read String
y'
               Ordering
o -> Ordering
o

    -- isAlpha returns any unicode alpha, but we just want ASCII characters
    isAsciiAlpha :: Char -> Bool
    isAsciiAlpha :: Char -> Bool
isAsciiAlpha 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 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
== Char
'~' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'^'

    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)