{-# 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)

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"

-- | 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)
