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

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3
   4 module Distribution.Types.Version
   5   ( -- * Package versions
   6     Version
   7   , mkVersion
   8   , mkVersion'
   9   , versionNumbers
  10   , nullVersion
  11   , alterVersion
  12   , version0
  13
  14     -- * Internal
  15   , validVersion
  16   , versionDigitParser
  17   ) where
  18
  19 import Data.Bits (shiftL, shiftR, (.&.), (.|.))
  20 import Distribution.Compat.Prelude
  21 import Prelude ()
  22
  23 import Distribution.Parsec
  24 import Distribution.Pretty
  25
  26 import qualified Data.Version as Base
  27 import qualified Distribution.Compat.CharParsing as P
  28 import qualified Text.PrettyPrint as Disp
  29 import qualified Text.Read as Read
  30
  31 -- | A 'Version' represents the version of a software entity.
  32 --
  33 -- Instances of 'Eq' and 'Ord' are provided, which gives exact
  34 -- equality and lexicographic ordering of the version number
  35 -- components (i.e. 2.1 > 2.0, 1.2.3 > 1.2.2, etc.).
  36 --
  37 -- This type is opaque and distinct from the 'Base.Version' type in
  38 -- "Data.Version" since @Cabal-2.0@. The difference extends to the
  39 -- 'Binary' instance using a different (and more compact) encoding.
  40 --
  41 -- @since 2.0.0.2
  42 data Version
  43   = PV0 {-# UNPACK #-} !Word64
  44   | PV1 !Int [Int]
  45   -- NOTE: If a version fits into the packed Word64
  46   -- representation (i.e. at most four version components
  47   -- which all fall into the [0..0xfffe] range), then PV0
  48   -- MUST be used. This is essential for the 'Eq' instance
  49   -- to work.
  50   deriving (Data, Eq, Generic, Typeable)
  51
  52 instance Ord Version where
  53   compare (PV0 x) (PV0 y) = compare x y
  54   compare (PV1 x xs) (PV1 y ys) = case compare x y of
  55     EQ -> compare xs ys
  56     c -> c
  57   compare (PV0 w) (PV1 y ys) = case compare x y of
  58     EQ -> compare [x2, x3, x4] ys
  59     c -> c
  60     where
  61       x = fromIntegral ((w `shiftR` 48) .&. 0xffff) - 1
  62       x2 = fromIntegral ((w `shiftR` 32) .&. 0xffff) - 1
  63       x3 = fromIntegral ((w `shiftR` 16) .&. 0xffff) - 1
  64       x4 = fromIntegral (w .&. 0xffff) - 1
  65   compare (PV1 x xs) (PV0 w) = case compare x y of
  66     EQ -> compare xs [y2, y3, y4]
  67     c -> c
  68     where
  69       y = fromIntegral ((w `shiftR` 48) .&. 0xffff) - 1
  70       y2 = fromIntegral ((w `shiftR` 32) .&. 0xffff) - 1
  71       y3 = fromIntegral ((w `shiftR` 16) .&. 0xffff) - 1
  72       y4 = fromIntegral (w .&. 0xffff) - 1
  73
  74 instance Show Version where
  75   showsPrec d v =
  76     showParen (d > 10) $
  77       showString "mkVersion "
  78         . showsPrec 11 (versionNumbers v)
  79
  80 instance Read Version where
  81   readPrec = Read.parens $ do
  82     Read.Ident "mkVersion" <- Read.lexP
  83     v <- Read.step Read.readPrec
  84     return (mkVersion v)
  85
  86 instance Binary Version
  87 instance Structured Version
  88
  89 instance NFData Version where
  90   rnf (PV0 _) = ()
  91   rnf (PV1 _ ns) = rnf ns
  92
  93 instance Pretty Version where
  94   pretty ver =
  95     Disp.hcat
  96       ( Disp.punctuate
  97           (Disp.char '.')
  98           (map Disp.int $ versionNumbers ver)
  99       )
 100
 101 instance Parsec Version where
 102   parsec = mkVersion <$> toList <$> P.sepByNonEmpty versionDigitParser (P.char '.') <* tags
 103     where
 104       tags = do
 105         ts <- many $ P.char '-' *> some (P.satisfy isAlphaNum)
 106         case ts of
 107           [] -> pure ()
 108           (_ : _) -> parsecWarning PWTVersionTag "version with tags"
 109
 110 -- | An integral without leading zeroes.
 111 --
 112 -- @since 3.0
 113 versionDigitParser :: CabalParsing m => m Int
 114 versionDigitParser = (some d >>= toNumber) P.<?> "version digit (integral without leading zeroes)"
 115   where
 116     toNumber :: CabalParsing m => [Int] -> m Int
 117     toNumber [0] = return 0
 118     toNumber (0 : _) = P.unexpected "Version digit with leading zero"
 119     toNumber xs
 120       -- 10^9 = 1000000000
 121       -- 2^30 = 1073741824
 122       --
 123       -- GHC Int is at least 32 bits, so 2^31-1 is the 'maxBound'.
 124       | length xs > 9 = P.unexpected "At most 9 numbers are allowed per version number part"
 125       | otherwise = return $ foldl' (\a b -> a * 10 + b) 0 xs
 126
 127     d :: P.CharParsing m => m Int
 128     d = f <$> P.satisfyRange '0' '9'
 129     f c = ord c - ord '0'
 130
 131 -- | Construct 'Version' from list of version number components.
 132 --
 133 -- For instance, @mkVersion [3,2,1]@ constructs a 'Version'
 134 -- representing the version @3.2.1@.
 135 --
 136 -- All version components must be non-negative. @mkVersion []@
 137 -- currently represents the special /null/ version; see also 'nullVersion'.
 138 --
 139 -- @since 2.0.0.2
 140 mkVersion :: [Int] -> Version
 141 -- TODO: add validity check; disallow 'mkVersion []' (we have
 142 -- 'nullVersion' for that)
 143 mkVersion [] = nullVersion
 144 mkVersion (v1 : [])
 145   | inWord16VerRep1 v1 = PV0 (mkWord64VerRep1 v1)
 146   | otherwise = PV1 v1 []
 147   where
 148     inWord16VerRep1 x1 = inWord16 (x1 .|. (x1 + 1))
 149     mkWord64VerRep1 y1 = mkWord64VerRep (y1 + 1) 0 0 0
 150 mkVersion (v1 : vs@(v2 : []))
 151   | inWord16VerRep2 v1 v2 = PV0 (mkWord64VerRep2 v1 v2)
 152   | otherwise = PV1 v1 vs
 153   where
 154     inWord16VerRep2 x1 x2 =
 155       inWord16
 156         ( x1
 157             .|. (x1 + 1)
 158             .|. x2
 159             .|. (x2 + 1)
 160         )
 161     mkWord64VerRep2 y1 y2 = mkWord64VerRep (y1 + 1) (y2 + 1) 0 0
 162 mkVersion (v1 : vs@(v2 : v3 : []))
 163   | inWord16VerRep3 v1 v2 v3 = PV0 (mkWord64VerRep3 v1 v2 v3)
 164   | otherwise = PV1 v1 vs
 165   where
 166     inWord16VerRep3 x1 x2 x3 =
 167       inWord16
 168         ( x1
 169             .|. (x1 + 1)
 170             .|. x2
 171             .|. (x2 + 1)
 172             .|. x3
 173             .|. (x3 + 1)
 174         )
 175     mkWord64VerRep3 y1 y2 y3 = mkWord64VerRep (y1 + 1) (y2 + 1) (y3 + 1) 0
 176 mkVersion (v1 : vs@(v2 : v3 : v4 : []))
 177   | inWord16VerRep4 v1 v2 v3 v4 = PV0 (mkWord64VerRep4 v1 v2 v3 v4)
 178   | otherwise = PV1 v1 vs
 179   where
 180     inWord16VerRep4 x1 x2 x3 x4 =
 181       inWord16
 182         ( x1
 183             .|. (x1 + 1)
 184             .|. x2
 185             .|. (x2 + 1)
 186             .|. x3
 187             .|. (x3 + 1)
 188             .|. x4
 189             .|. (x4 + 1)
 190         )
 191     mkWord64VerRep4 y1 y2 y3 y4 = mkWord64VerRep (y1 + 1) (y2 + 1) (y3 + 1) (y4 + 1)
 192 mkVersion (v1 : vs) = PV1 v1 vs
 193
 194 -- | Version 0. A lower bound of 'Version'.
 195 --
 196 -- @since 2.2
 197 version0 :: Version
 198 version0 = mkVersion [0]
 199
 200 {-# INLINE mkWord64VerRep #-}
 201 mkWord64VerRep :: Int -> Int -> Int -> Int -> Word64
 202 mkWord64VerRep v1 v2 v3 v4 =
 203   (fromIntegral v1 `shiftL` 48)
 204     .|. (fromIntegral v2 `shiftL` 32)
 205     .|. (fromIntegral v3 `shiftL` 16)
 206     .|. fromIntegral v4
 207
 208 {-# INLINE inWord16 #-}
 209 inWord16 :: Int -> Bool
 210 inWord16 x = (fromIntegral x :: Word) <= 0xffff
 211
 212 -- | Variant of 'mkVersion' which converts a "Data.Version"
 213 -- 'Base.Version' into Cabal's 'Version' type.
 214 --
 215 -- @since 2.0.0.2
 216 mkVersion' :: Base.Version -> Version
 217 mkVersion' = mkVersion . Base.versionBranch
 218
 219 -- | Unpack 'Version' into list of version number components.
 220 --
 221 -- This is the inverse to 'mkVersion', so the following holds:
 222 --
 223 -- > (versionNumbers . mkVersion) vs == vs
 224 --
 225 -- @since 2.0.0.2
 226 versionNumbers :: Version -> [Int]
 227 versionNumbers (PV1 n ns) = n : ns
 228 versionNumbers (PV0 w)
 229   | v1 < 0 = []
 230   | v2 < 0 = [v1]
 231   | v3 < 0 = [v1, v2]
 232   | v4 < 0 = [v1, v2, v3]
 233   | otherwise = [v1, v2, v3, v4]
 234   where
 235     v1 = fromIntegral ((w `shiftR` 48) .&. 0xffff) - 1
 236     v2 = fromIntegral ((w `shiftR` 32) .&. 0xffff) - 1
 237     v3 = fromIntegral ((w `shiftR` 16) .&. 0xffff) - 1
 238     v4 = fromIntegral (w .&. 0xffff) - 1
 239
 240 -- | Constant representing the special /null/ 'Version'
 241 --
 242 -- The 'nullVersion' compares (via 'Ord') as less than every proper
 243 -- 'Version' value.
 244 --
 245 -- @since 2.0.0.2
 246 nullVersion :: Version
 247 -- TODO: at some point, 'mkVersion' may disallow creating /null/
 248 -- 'Version's
 249 nullVersion = PV0 0
 250
 251 -- | Apply function to list of version number components
 252 --
 253 -- > alterVersion f == mkVersion . f . versionNumbers
 254 --
 255 -- @since 2.0.0.2
 256 alterVersion :: ([Int] -> [Int]) -> Version -> Version
 257 alterVersion f = mkVersion . f . versionNumbers
 258
 259 -- internal helper
 260 validVersion :: Version -> Bool
 261 validVersion v = v /= nullVersion && all (>= 0) (versionNumbers v)