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
84instance Structured Version
85
86instance NFData Version where
87    rnf (PV0 _) = ()
88    rnf (PV1 _ ns) = rnf ns
89
90instance Pretty Version where
91  pretty ver
92    = Disp.hcat (Disp.punctuate (Disp.char '.')
93                                (map Disp.int $ versionNumbers ver))
94
95instance Parsec Version where
96    parsec = mkVersion <$> toList <$> P.sepByNonEmpty versionDigitParser (P.char '.') <* tags
97      where
98        tags = do
99            ts <- many $ P.char '-' *> some (P.satisfy isAlphaNum)
100            case ts of
101                []      -> pure ()
102                (_ : _) -> parsecWarning PWTVersionTag "version with tags"
103
104-- | An integral without leading zeroes.
105--
106-- @since 3.0
107versionDigitParser :: CabalParsing m => m Int
108versionDigitParser = (some d >>= toNumber) P.<?> "version digit (integral without leading zeroes)"
109  where
110    toNumber :: CabalParsing m => [Int] -> m Int
111    toNumber [0]   = return 0
112    toNumber (0:_) = P.unexpected "Version digit with leading zero"
113    toNumber xs
114        -- 10^9 = 1000000000
115        -- 2^30 = 1073741824
116        --
117        -- GHC Int is at least 32 bits, so 2^31-1 is the 'maxBound'.
118        | length xs > 9 = P.unexpected "At most 9 numbers are allowed per version number part"
119        | otherwise     = return $ foldl' (\a b -> a * 10 + b) 0 xs
120
121    d :: P.CharParsing m => m Int
122    d = f <$> P.satisfyRange '0' '9'
123    f c = ord c - ord '0'
124
125-- | Construct 'Version' from list of version number components.
126--
127-- For instance, @mkVersion [3,2,1]@ constructs a 'Version'
128-- representing the version @3.2.1@.
129--
130-- All version components must be non-negative. @mkVersion []@
131-- currently represents the special /null/ version; see also 'nullVersion'.
132--
133-- @since 2.0.0.2
134mkVersion :: [Int] -> Version
135-- TODO: add validity check; disallow 'mkVersion []' (we have
136-- 'nullVersion' for that)
137mkVersion []                    = nullVersion
138mkVersion (v1:[])
139  | inWord16VerRep1 v1          = PV0 (mkWord64VerRep1 v1)
140  | otherwise                   = PV1 v1 []
141  where
142    inWord16VerRep1 x1 = inWord16 (x1 .|. (x1+1))
143    mkWord64VerRep1 y1 = mkWord64VerRep (y1+1) 0 0 0
144
145mkVersion (v1:vs@(v2:[]))
146  | inWord16VerRep2 v1 v2       = PV0 (mkWord64VerRep2 v1 v2)
147  | otherwise                   = PV1 v1 vs
148  where
149    inWord16VerRep2 x1 x2 = inWord16 (x1 .|. (x1+1)
150                                  .|. x2 .|. (x2+1))
151    mkWord64VerRep2 y1 y2 = mkWord64VerRep (y1+1) (y2+1) 0 0
152
153mkVersion (v1:vs@(v2:v3:[]))
154  | inWord16VerRep3 v1 v2 v3    = PV0 (mkWord64VerRep3 v1 v2 v3)
155  | otherwise                   = PV1 v1 vs
156  where
157    inWord16VerRep3 x1 x2 x3 = inWord16 (x1 .|. (x1+1)
158                                     .|. x2 .|. (x2+1)
159                                     .|. x3 .|. (x3+1))
160    mkWord64VerRep3 y1 y2 y3 = mkWord64VerRep (y1+1) (y2+1) (y3+1) 0
161
162mkVersion (v1:vs@(v2:v3:v4:[]))
163  | inWord16VerRep4 v1 v2 v3 v4 = PV0 (mkWord64VerRep4 v1 v2 v3 v4)
164  | otherwise                   = PV1 v1 vs
165  where
166    inWord16VerRep4 x1 x2 x3 x4 = inWord16 (x1 .|. (x1+1)
167                                        .|. x2 .|. (x2+1)
168                                        .|. x3 .|. (x3+1)
169                                        .|. x4 .|. (x4+1))
170    mkWord64VerRep4 y1 y2 y3 y4 = mkWord64VerRep (y1+1) (y2+1) (y3+1) (y4+1)
171
172mkVersion (v1:vs)               = PV1 v1 vs
173
174-- | Version 0. A lower bound of 'Version'.
175--
176-- @since 2.2
177version0 :: Version
178version0 = mkVersion [0]
179
180{-# INLINE mkWord64VerRep #-}
181mkWord64VerRep :: Int -> Int -> Int -> Int -> Word64
182mkWord64VerRep v1 v2 v3 v4 =
183      (fromIntegral v1 `shiftL` 48)
184  .|. (fromIntegral v2 `shiftL` 32)
185  .|. (fromIntegral v3 `shiftL` 16)
186  .|.  fromIntegral v4
187
188{-# INLINE inWord16 #-}
189inWord16 :: Int -> Bool
190inWord16 x = (fromIntegral x :: Word) <= 0xffff
191
192-- | Variant of 'mkVersion' which converts a "Data.Version"
193-- 'Base.Version' into Cabal's 'Version' type.
194--
195-- @since 2.0.0.2
196mkVersion' :: Base.Version -> Version
197mkVersion' = mkVersion . Base.versionBranch
198
199-- | Unpack 'Version' into list of version number components.
200--
201-- This is the inverse to 'mkVersion', so the following holds:
202--
203-- > (versionNumbers . mkVersion) vs == vs
204--
205-- @since 2.0.0.2
206versionNumbers :: Version -> [Int]
207versionNumbers (PV1 n ns) = n:ns
208versionNumbers (PV0 w)
209  | v1 < 0    = []
210  | v2 < 0    = [v1]
211  | v3 < 0    = [v1,v2]
212  | v4 < 0    = [v1,v2,v3]
213  | otherwise = [v1,v2,v3,v4]
214  where
215    v1 = fromIntegral ((w `shiftR` 48) .&. 0xffff) - 1
216    v2 = fromIntegral ((w `shiftR` 32) .&. 0xffff) - 1
217    v3 = fromIntegral ((w `shiftR` 16) .&. 0xffff) - 1
218    v4 = fromIntegral (w .&. 0xffff) - 1
219
220
221-- | Constant representing the special /null/ 'Version'
222--
223-- The 'nullVersion' compares (via 'Ord') as less than every proper
224-- 'Version' value.
225--
226-- @since 2.0.0.2
227nullVersion :: Version
228-- TODO: at some point, 'mkVersion' may disallow creating /null/
229-- 'Version's
230nullVersion = PV0 0
231
232-- | Apply function to list of version number components
233--
234-- > alterVersion f == mkVersion . f . versionNumbers
235--
236-- @since 2.0.0.2
237alterVersion :: ([Int] -> [Int]) -> Version -> Version
238alterVersion f = mkVersion . f . versionNumbers
239
240-- internal helper
241validVersion :: Version -> Bool
242validVersion v = v /= nullVersion && all (>=0) (versionNumbers v)
243