module Distribution.Types.PkgconfigVersion (
PkgconfigVersion (..),
rpmvercmp,
) where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Utils.Generic (isAsciiAlphaNum)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as PP
newtype PkgconfigVersion = PkgconfigVersion BS.ByteString
deriving (Generic, Read, Show, Typeable, Data)
instance Eq PkgconfigVersion where
PkgconfigVersion a == PkgconfigVersion b = rpmvercmp a b == EQ
instance Ord PkgconfigVersion where
PkgconfigVersion a `compare` PkgconfigVersion b = rpmvercmp a b
instance Binary PkgconfigVersion
instance Structured PkgconfigVersion
instance NFData PkgconfigVersion where rnf = genericRnf
instance Pretty PkgconfigVersion where
pretty (PkgconfigVersion bs) = PP.text (BS8.unpack bs)
instance Parsec PkgconfigVersion where
parsec = PkgconfigVersion . BS8.pack <$> P.munch1 predicate where
predicate c = isAsciiAlphaNum c || c == '.' || c == '-'
rpmvercmp :: BS.ByteString -> BS.ByteString -> Ordering
rpmvercmp a b = go0 (BS.unpack a) (BS.unpack b)
where
go0 :: [Word8] -> [Word8] -> Ordering
go0 xs ys = go1 (dropNonAlnum8 xs) (dropNonAlnum8 ys)
go1 :: [Word8] -> [Word8] -> Ordering
go1 [] [] = EQ
go1 [] _ = LT
go1 _ [] = GT
go1 xs@(x:_) ys
| isDigit8 x =
let (xs1, xs2) = span isDigit8 xs
(ys1, ys2) = span isDigit8 ys
in if null ys1
then GT
else compareInt xs1 ys1 <> go0 xs2 ys2
| otherwise =
let (xs1, xs2) = span isAlpha8 xs
(ys1, ys2) = span isAlpha8 ys
in if null ys1
then LT
else compareStr xs1 ys1 <> go0 xs2 ys2
compareInt :: [Word8] -> [Word8] -> Ordering
compareInt xs ys =
compare (length xs') (length ys') <>
compare xs' ys'
where
xs' = dropWhile (== 0x30) xs
ys' = dropWhile (== 0x30) ys
compareStr :: [Word8] -> [Word8] -> Ordering
compareStr = compare
dropNonAlnum8 :: [Word8] -> [Word8]
dropNonAlnum8 = dropWhile (\w -> not (isDigit8 w || isAlpha8 w))
isDigit8 :: Word8 -> Bool
isDigit8 w = 0x30 <= w && w <= 0x39
isAlpha8 :: Word8 -> Bool
isAlpha8 w = (0x41 <= w && w <= 0x5A) || (0x61 <= w && w <= 0x7A)