{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
-- @since 3.0
module Distribution.Types.PkgconfigVersion (
    PkgconfigVersion (..),
    rpmvercmp,
    ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Parsec
import Distribution.Pretty
import Distribution.Utils.Generic (isAsciiAlphaNum)

import qualified Data.ByteString                 as BS
import qualified Data.ByteString.Char8           as BS8
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint                as PP

-- | @pkg-config@ versions.
--
-- In fact, this can be arbitrary 'BS.ByteString',
-- but 'Parsec' instance is a little pickier.
--
-- @since 3.0
newtype PkgconfigVersion = PkgconfigVersion BS.ByteString
  deriving (Generic, Read, Show, Typeable, Data)

instance Eq PkgconfigVersion where
    PkgconfigVersion a == PkgconfigVersion b = rpmvercmp a b == EQ

instance Ord PkgconfigVersion where
    PkgconfigVersion a `compare` PkgconfigVersion b = rpmvercmp a b

instance Binary PkgconfigVersion
instance NFData PkgconfigVersion where rnf = genericRnf

instance Pretty PkgconfigVersion where
    pretty (PkgconfigVersion bs) = PP.text (BS8.unpack bs)

instance Parsec PkgconfigVersion where
    parsec = PkgconfigVersion . BS8.pack <$> P.munch1 predicate where
        predicate c = isAsciiAlphaNum c || c == '.' || c == '-'

-------------------------------------------------------------------------------
-- rmpvercmp - pure Haskell implementation
-------------------------------------------------------------------------------

-- | Compare two version strings as @pkg-config@ would compare them.
--
-- @since 3.0
rpmvercmp :: BS.ByteString -> BS.ByteString -> Ordering
rpmvercmp a b = go0 (BS.unpack a) (BS.unpack b)
  where
    go0 :: [Word8] -> [Word8] -> Ordering
    go0 xs ys = go1 (dropNonAlnum8 xs) (dropNonAlnum8 ys)

    go1 :: [Word8] -> [Word8] -> Ordering
    go1 [] [] = EQ
    go1 [] _  = LT
    go1 _  [] = GT
    go1 xs@(x:_) ys
      | isDigit8 x =
          let (xs1, xs2) = span isDigit8 xs
              (ys1, ys2) = span isDigit8 ys
            -- numeric segments are always newer than alpha segments
          in if null ys1
             then GT
             else compareInt xs1 ys1 <> go0 xs2 ys2

      -- isAlpha
      | otherwise =
          let (xs1, xs2) = span isAlpha8 xs
              (ys1, ys2) = span isAlpha8 ys
          in if null ys1
             then LT
             else compareStr xs1 ys1 <> go0 xs2 ys2

-- compare as numbers
compareInt :: [Word8] -> [Word8] -> Ordering
compareInt xs ys =
    -- whichever number has more digits wins
    compare (length xs') (length ys') <>
    -- equal length: use per character compare, "strcmp"
    compare xs' ys'
  where
    -- drop  leading zeros
    xs' = dropWhile (== 0x30) xs
    ys' = dropWhile (== 0x30) ys

-- strcmp
compareStr :: [Word8] -> [Word8] -> Ordering
compareStr = compare

dropNonAlnum8 :: [Word8] -> [Word8]
dropNonAlnum8 = dropWhile (\w -> not (isDigit8 w || isAlpha8 w))

isDigit8 :: Word8 -> Bool
isDigit8 w = 0x30 <= w && w <= 0x39

isAlpha8 :: Word8 -> Bool
isAlpha8 w = (0x41 <= w && w <= 0x5A) || (0x61 <= w && w <= 0x7A)