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