Cabal-syntax/src/Distribution/Types/PkgconfigVersion.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3
   4 -- @since 3.0
   5 module Distribution.Types.PkgconfigVersion
   6   ( PkgconfigVersion (..)
   7   , rpmvercmp
   8   ) where
   9
  10 import Distribution.Compat.Prelude
  11 import Prelude ()
  12
  13 import Distribution.Parsec
  14 import Distribution.Pretty
  15 import Distribution.Utils.Generic (isAsciiAlphaNum)
  16
  17 import qualified Data.ByteString as BS
  18 import qualified Data.ByteString.Char8 as BS8
  19 import qualified Distribution.Compat.CharParsing as P
  20 import qualified Text.PrettyPrint as PP
  21
  22 -- | @pkg-config@ versions.
  23 --
  24 -- In fact, this can be arbitrary 'BS.ByteString',
  25 -- but 'Parsec' instance is a little pickier.
  26 --
  27 -- @since 3.0
  28 newtype PkgconfigVersion = PkgconfigVersion BS.ByteString
  29   deriving (Generic, Read, Show, Typeable, Data)
  30
  31 instance Eq PkgconfigVersion where
  32   PkgconfigVersion a == PkgconfigVersion b = rpmvercmp a b == EQ
  33
  34 instance Ord PkgconfigVersion where
  35   PkgconfigVersion a `compare` PkgconfigVersion b = rpmvercmp a b
  36
  37 instance Binary PkgconfigVersion
  38 instance Structured PkgconfigVersion
  39 instance NFData PkgconfigVersion where rnf = genericRnf
  40
  41 instance Pretty PkgconfigVersion where
  42   pretty (PkgconfigVersion bs) = PP.text (BS8.unpack bs)
  43
  44 -- |
  45 --
  46 -- >>> simpleParsec "1.0.2n" :: Maybe PkgconfigVersion
  47 -- Just (PkgconfigVersion "1.0.2n")
  48 --
  49 -- >>> simpleParsec "0.3.5+ds" :: Maybe PkgconfigVersion
  50 -- Nothing
  51 instance Parsec PkgconfigVersion where
  52   parsec = PkgconfigVersion . BS8.pack <$> P.munch1 predicate
  53     where
  54       predicate c = isAsciiAlphaNum c || c == '.' || c == '-'
  55
  56 -------------------------------------------------------------------------------
  57 -- rpmvercmp - pure Haskell implementation
  58 -------------------------------------------------------------------------------
  59
  60 -- | Compare two version strings as @pkg-config@ would compare them.
  61 --
  62 -- @since 3.0
  63 rpmvercmp :: BS.ByteString -> BS.ByteString -> Ordering
  64 rpmvercmp a b = go0 (BS.unpack a) (BS.unpack b)
  65   where
  66     go0 :: [Word8] -> [Word8] -> Ordering
  67     -- if there is _any_ trailing "garbage", it seems to affect result
  68     -- https://github.com/haskell/cabal/issues/6805
  69     go0 [] [] = EQ
  70     go0 [] _ = LT
  71     go0 _ [] = GT
  72     go0 xs ys = go1 (dropNonAlnum8 xs) (dropNonAlnum8 ys)
  73
  74     go1 :: [Word8] -> [Word8] -> Ordering
  75     go1 [] [] = EQ
  76     go1 [] _ = LT
  77     go1 _ [] = GT
  78     go1 xs@(x : _) ys
  79       | isDigit8 x =
  80           let (xs1, xs2) = span isDigit8 xs
  81               (ys1, ys2) = span isDigit8 ys
  82            in -- numeric segments are always newer than alpha segments
  83               if null ys1
  84                 then GT
  85                 else compareInt xs1 ys1 <> go0 xs2 ys2
  86       -- isAlpha
  87       | otherwise =
  88           let (xs1, xs2) = span isAlpha8 xs
  89               (ys1, ys2) = span isAlpha8 ys
  90            in if null ys1
  91                 then LT
  92                 else compareStr xs1 ys1 <> go0 xs2 ys2
  93
  94 -- compare as numbers
  95 compareInt :: [Word8] -> [Word8] -> Ordering
  96 compareInt xs ys =
  97   -- whichever number has more digits wins
  98   compare (length xs') (length ys')
  99     <>
 100     -- equal length: use per character compare, "strcmp"
 101     compare xs' ys'
 102   where
 103     -- drop  leading zeros
 104     xs' = dropWhile (== 0x30) xs
 105     ys' = dropWhile (== 0x30) ys
 106
 107 -- strcmp
 108 compareStr :: [Word8] -> [Word8] -> Ordering
 109 compareStr = compare
 110
 111 dropNonAlnum8 :: [Word8] -> [Word8]
 112 dropNonAlnum8 = dropWhile (\w -> not (isDigit8 w || isAlpha8 w))
 113
 114 isDigit8 :: Word8 -> Bool
 115 isDigit8 w = 0x30 <= w && w <= 0x39
 116
 117 isAlpha8 :: Word8 -> Bool
 118 isAlpha8 w = (0x41 <= w && w <= 0x5A) || (0x61 <= w && w <= 0x7A)