module Distribution.Types.Version (
Version,
mkVersion,
mkVersion',
versionNumbers,
nullVersion,
alterVersion,
version0,
validVersion,
versionDigitParser,
) where
import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.Parsec
import Distribution.Pretty
import qualified Data.Version as Base
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp
import qualified Text.Read as Read
data Version = PV0 !Word64
| PV1 !Int [Int]
deriving (Data,Eq,Generic,Typeable)
instance Ord Version where
compare (PV0 x) (PV0 y) = compare x y
compare (PV1 x xs) (PV1 y ys) = case compare x y of
EQ -> compare xs ys
c -> c
compare (PV0 w) (PV1 y ys) = case compare x y of
EQ -> compare [x2,x3,x4] ys
c -> c
where
x = fromIntegral ((w `shiftR` 48) .&. 0xffff) 1
x2 = fromIntegral ((w `shiftR` 32) .&. 0xffff) 1
x3 = fromIntegral ((w `shiftR` 16) .&. 0xffff) 1
x4 = fromIntegral (w .&. 0xffff) 1
compare (PV1 x xs) (PV0 w) = case compare x y of
EQ -> compare xs [y2,y3,y4]
c -> c
where
y = fromIntegral ((w `shiftR` 48) .&. 0xffff) 1
y2 = fromIntegral ((w `shiftR` 32) .&. 0xffff) 1
y3 = fromIntegral ((w `shiftR` 16) .&. 0xffff) 1
y4 = fromIntegral (w .&. 0xffff) 1
instance Show Version where
showsPrec d v = showParen (d > 10)
$ showString "mkVersion "
. showsPrec 11 (versionNumbers v)
instance Read Version where
readPrec = Read.parens $ do
Read.Ident "mkVersion" <- Read.lexP
v <- Read.step Read.readPrec
return (mkVersion v)
instance Binary Version
instance Structured Version
instance NFData Version where
rnf (PV0 _) = ()
rnf (PV1 _ ns) = rnf ns
instance Pretty Version where
pretty ver
= Disp.hcat (Disp.punctuate (Disp.char '.')
(map Disp.int $ versionNumbers ver))
instance Parsec Version where
parsec = mkVersion <$> toList <$> P.sepByNonEmpty versionDigitParser (P.char '.') <* tags
where
tags = do
ts <- many $ P.char '-' *> some (P.satisfy isAlphaNum)
case ts of
[] -> pure ()
(_ : _) -> parsecWarning PWTVersionTag "version with tags"
versionDigitParser :: CabalParsing m => m Int
versionDigitParser = (some d >>= toNumber) P.<?> "version digit (integral without leading zeroes)"
where
toNumber :: CabalParsing m => [Int] -> m Int
toNumber [0] = return 0
toNumber (0:_) = P.unexpected "Version digit with leading zero"
toNumber xs
| length xs > 9 = P.unexpected "At most 9 numbers are allowed per version number part"
| otherwise = return $ foldl' (\a b -> a * 10 + b) 0 xs
d :: P.CharParsing m => m Int
d = f <$> P.satisfyRange '0' '9'
f c = ord c ord '0'
mkVersion :: [Int] -> Version
mkVersion [] = nullVersion
mkVersion (v1:[])
| inWord16VerRep1 v1 = PV0 (mkWord64VerRep1 v1)
| otherwise = PV1 v1 []
where
inWord16VerRep1 x1 = inWord16 (x1 .|. (x1+1))
mkWord64VerRep1 y1 = mkWord64VerRep (y1+1) 0 0 0
mkVersion (v1:vs@(v2:[]))
| inWord16VerRep2 v1 v2 = PV0 (mkWord64VerRep2 v1 v2)
| otherwise = PV1 v1 vs
where
inWord16VerRep2 x1 x2 = inWord16 (x1 .|. (x1+1)
.|. x2 .|. (x2+1))
mkWord64VerRep2 y1 y2 = mkWord64VerRep (y1+1) (y2+1) 0 0
mkVersion (v1:vs@(v2:v3:[]))
| inWord16VerRep3 v1 v2 v3 = PV0 (mkWord64VerRep3 v1 v2 v3)
| otherwise = PV1 v1 vs
where
inWord16VerRep3 x1 x2 x3 = inWord16 (x1 .|. (x1+1)
.|. x2 .|. (x2+1)
.|. x3 .|. (x3+1))
mkWord64VerRep3 y1 y2 y3 = mkWord64VerRep (y1+1) (y2+1) (y3+1) 0
mkVersion (v1:vs@(v2:v3:v4:[]))
| inWord16VerRep4 v1 v2 v3 v4 = PV0 (mkWord64VerRep4 v1 v2 v3 v4)
| otherwise = PV1 v1 vs
where
inWord16VerRep4 x1 x2 x3 x4 = inWord16 (x1 .|. (x1+1)
.|. x2 .|. (x2+1)
.|. x3 .|. (x3+1)
.|. x4 .|. (x4+1))
mkWord64VerRep4 y1 y2 y3 y4 = mkWord64VerRep (y1+1) (y2+1) (y3+1) (y4+1)
mkVersion (v1:vs) = PV1 v1 vs
version0 :: Version
version0 = mkVersion [0]
mkWord64VerRep :: Int -> Int -> Int -> Int -> Word64
mkWord64VerRep v1 v2 v3 v4 =
(fromIntegral v1 `shiftL` 48)
.|. (fromIntegral v2 `shiftL` 32)
.|. (fromIntegral v3 `shiftL` 16)
.|. fromIntegral v4
inWord16 :: Int -> Bool
inWord16 x = (fromIntegral x :: Word) <= 0xffff
mkVersion' :: Base.Version -> Version
mkVersion' = mkVersion . Base.versionBranch
versionNumbers :: Version -> [Int]
versionNumbers (PV1 n ns) = n:ns
versionNumbers (PV0 w)
| v1 < 0 = []
| v2 < 0 = [v1]
| v3 < 0 = [v1,v2]
| v4 < 0 = [v1,v2,v3]
| otherwise = [v1,v2,v3,v4]
where
v1 = fromIntegral ((w `shiftR` 48) .&. 0xffff) 1
v2 = fromIntegral ((w `shiftR` 32) .&. 0xffff) 1
v3 = fromIntegral ((w `shiftR` 16) .&. 0xffff) 1
v4 = fromIntegral (w .&. 0xffff) 1
nullVersion :: Version
nullVersion = PV0 0
alterVersion :: ([Int] -> [Int]) -> Version -> Version
alterVersion f = mkVersion . f . versionNumbers
validVersion :: Version -> Bool
validVersion v = v /= nullVersion && all (>=0) (versionNumbers v)