{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
module Distribution.Types.Version (
    -- * Package versions
    Version,
    mkVersion,
    mkVersion',
    versionNumbers,
    nullVersion,
    alterVersion,
    version0,

    -- * Internal
    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

-- | A 'Version' represents the version of a software entity.
--
-- Instances of 'Eq' and 'Ord' are provided, which gives exact
-- equality and lexicographic ordering of the version number
-- components (i.e. 2.1 > 2.0, 1.2.3 > 1.2.2, etc.).
--
-- This type is opaque and distinct from the 'Base.Version' type in
-- "Data.Version" since @Cabal-2.0@. The difference extends to the
-- 'Binary' instance using a different (and more compact) encoding.
--
-- @since 2.0.0.2
data Version = PV0 {-# UNPACK #-} !Word64
             | PV1 !Int [Int]
             -- NOTE: If a version fits into the packed Word64
             -- representation (i.e. at most four version components
             -- which all fall into the [0..0xfffe] range), then PV0
             -- MUST be used. This is essential for the 'Eq' instance
             -- to work.
             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 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 <$> P.sepBy1 versionDigitParser (P.char '.') <* tags
      where
        tags = do
            ts <- many $ P.char '-' *> some (P.satisfy isAlphaNum)
            case ts of
                []      -> pure ()
                (_ : _) -> parsecWarning PWTVersionTag "version with tags"

-- | An integral without leading zeroes.
--
-- @since 3.0
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
        -- 10^9 = 1000000000
        -- 2^30 = 1073741824
        --
        -- GHC Int is at least 32 bits, so 2^31-1 is the 'maxBound'.
        | 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'

-- | Construct 'Version' from list of version number components.
--
-- For instance, @mkVersion [3,2,1]@ constructs a 'Version'
-- representing the version @3.2.1@.
--
-- All version components must be non-negative. @mkVersion []@
-- currently represents the special /null/ version; see also 'nullVersion'.
--
-- @since 2.0.0.2
mkVersion :: [Int] -> Version
-- TODO: add validity check; disallow 'mkVersion []' (we have
-- 'nullVersion' for that)
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

-- | Version 0. A lower bound of 'Version'.
--
-- @since 2.2
version0 :: Version
version0 = mkVersion [0]

{-# INLINE mkWord64VerRep #-}
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

{-# INLINE inWord16 #-}
inWord16 :: Int -> Bool
inWord16 x = (fromIntegral x :: Word) <= 0xffff

-- | Variant of 'mkVersion' which converts a "Data.Version"
-- 'Base.Version' into Cabal's 'Version' type.
--
-- @since 2.0.0.2
mkVersion' :: Base.Version -> Version
mkVersion' = mkVersion . Base.versionBranch

-- | Unpack 'Version' into list of version number components.
--
-- This is the inverse to 'mkVersion', so the following holds:
--
-- > (versionNumbers . mkVersion) vs == vs
--
-- @since 2.0.0.2
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


-- | Constant representing the special /null/ 'Version'
--
-- The 'nullVersion' compares (via 'Ord') as less than every proper
-- 'Version' value.
--
-- @since 2.0.0.2
nullVersion :: Version
-- TODO: at some point, 'mkVersion' may disallow creating /null/
-- 'Version's
nullVersion = PV0 0

-- | Apply function to list of version number components
--
-- > alterVersion f == mkVersion . f . versionNumbers
--
-- @since 2.0.0.2
alterVersion :: ([Int] -> [Int]) -> Version -> Version
alterVersion f = mkVersion . f . versionNumbers

-- internal helper
validVersion :: Version -> Bool
validVersion v = v /= nullVersion && all (>=0) (versionNumbers v)