{-# 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 (forall x. Rep PkgconfigVersion x -> PkgconfigVersion
forall x. PkgconfigVersion -> Rep PkgconfigVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PkgconfigVersion x -> PkgconfigVersion
$cfrom :: forall x. PkgconfigVersion -> Rep PkgconfigVersion x
Generic, ReadPrec [PkgconfigVersion]
ReadPrec PkgconfigVersion
Int -> ReadS PkgconfigVersion
ReadS [PkgconfigVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PkgconfigVersion]
$creadListPrec :: ReadPrec [PkgconfigVersion]
readPrec :: ReadPrec PkgconfigVersion
$creadPrec :: ReadPrec PkgconfigVersion
readList :: ReadS [PkgconfigVersion]
$creadList :: ReadS [PkgconfigVersion]
readsPrec :: Int -> ReadS PkgconfigVersion
$creadsPrec :: Int -> ReadS PkgconfigVersion
Read, Int -> PkgconfigVersion -> ShowS
[PkgconfigVersion] -> ShowS
PkgconfigVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PkgconfigVersion] -> ShowS
$cshowList :: [PkgconfigVersion] -> ShowS
show :: PkgconfigVersion -> String
$cshow :: PkgconfigVersion -> String
showsPrec :: Int -> PkgconfigVersion -> ShowS
$cshowsPrec :: Int -> PkgconfigVersion -> ShowS
Show, Typeable, Typeable PkgconfigVersion
PkgconfigVersion -> DataType
PkgconfigVersion -> Constr
(forall b. Data b => b -> b)
-> PkgconfigVersion -> PkgconfigVersion
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PkgconfigVersion -> u
forall u. (forall d. Data d => d -> u) -> PkgconfigVersion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PkgconfigVersion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PkgconfigVersion -> c PkgconfigVersion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PkgconfigVersion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PkgconfigVersion)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PkgconfigVersion -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PkgconfigVersion -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PkgconfigVersion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PkgconfigVersion -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r
gmapT :: (forall b. Data b => b -> b)
-> PkgconfigVersion -> PkgconfigVersion
$cgmapT :: (forall b. Data b => b -> b)
-> PkgconfigVersion -> PkgconfigVersion
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PkgconfigVersion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PkgconfigVersion)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PkgconfigVersion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PkgconfigVersion)
dataTypeOf :: PkgconfigVersion -> DataType
$cdataTypeOf :: PkgconfigVersion -> DataType
toConstr :: PkgconfigVersion -> Constr
$ctoConstr :: PkgconfigVersion -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PkgconfigVersion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PkgconfigVersion
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PkgconfigVersion -> c PkgconfigVersion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PkgconfigVersion -> c PkgconfigVersion
Data)

instance Eq PkgconfigVersion where
    PkgconfigVersion ByteString
a == :: PkgconfigVersion -> PkgconfigVersion -> Bool
== PkgconfigVersion ByteString
b = ByteString -> ByteString -> Ordering
rpmvercmp ByteString
a ByteString
b forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord PkgconfigVersion where
    PkgconfigVersion ByteString
a compare :: PkgconfigVersion -> PkgconfigVersion -> Ordering
`compare` PkgconfigVersion ByteString
b = ByteString -> ByteString -> Ordering
rpmvercmp ByteString
a ByteString
b

instance Binary PkgconfigVersion
instance Structured PkgconfigVersion
instance NFData PkgconfigVersion where rnf :: PkgconfigVersion -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

instance Pretty PkgconfigVersion where
    pretty :: PkgconfigVersion -> Doc
pretty (PkgconfigVersion ByteString
bs) = String -> Doc
PP.text (ByteString -> String
BS8.unpack ByteString
bs)

-- |
--
-- >>> simpleParsec "1.0.2n" :: Maybe PkgconfigVersion
-- Just (PkgconfigVersion "1.0.2n")
--
-- >>> simpleParsec "0.3.5+ds" :: Maybe PkgconfigVersion
-- Nothing
--
instance Parsec PkgconfigVersion where
    parsec :: forall (m :: * -> *). CabalParsing m => m PkgconfigVersion
parsec = ByteString -> PkgconfigVersion
PkgconfigVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
predicate where
        predicate :: Char -> Bool
predicate Char
c = Char -> Bool
isAsciiAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'

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

-- | Compare two version strings as @pkg-config@ would compare them.
--
-- @since 3.0
rpmvercmp :: BS.ByteString -> BS.ByteString -> Ordering
rpmvercmp :: ByteString -> ByteString -> Ordering
rpmvercmp ByteString
a ByteString
b = [Word8] -> [Word8] -> Ordering
go0 (ByteString -> [Word8]
BS.unpack ByteString
a) (ByteString -> [Word8]
BS.unpack ByteString
b)
  where
    go0 :: [Word8] -> [Word8] -> Ordering
    -- if there is _any_ trailing "garbage", it seems to affect result
    -- https://github.com/haskell/cabal/issues/6805
    go0 :: [Word8] -> [Word8] -> Ordering
go0 [] [] = Ordering
EQ
    go0 [] [Word8]
_  = Ordering
LT
    go0 [Word8]
_  [] = Ordering
GT
    go0 [Word8]
xs [Word8]
ys = [Word8] -> [Word8] -> Ordering
go1 ([Word8] -> [Word8]
dropNonAlnum8 [Word8]
xs) ([Word8] -> [Word8]
dropNonAlnum8 [Word8]
ys)

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

      -- isAlpha
      | Bool
otherwise =
          let ([Word8]
xs1, [Word8]
xs2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Word8 -> Bool
isAlpha8 [Word8]
xs
              ([Word8]
ys1, [Word8]
ys2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Word8 -> Bool
isAlpha8 [Word8]
ys
          in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word8]
ys1
             then Ordering
LT
             else [Word8] -> [Word8] -> Ordering
compareStr [Word8]
xs1 [Word8]
ys1 forall a. Semigroup a => a -> a -> a
<> [Word8] -> [Word8] -> Ordering
go0 [Word8]
xs2 [Word8]
ys2

-- compare as numbers
compareInt :: [Word8] -> [Word8] -> Ordering
compareInt :: [Word8] -> [Word8] -> Ordering
compareInt [Word8]
xs [Word8]
ys =
    -- whichever number has more digits wins
    forall a. Ord a => a -> a -> Ordering
compare (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
xs') (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
ys') forall a. Semigroup a => a -> a -> a
<>
    -- equal length: use per character compare, "strcmp"
    forall a. Ord a => a -> a -> Ordering
compare [Word8]
xs' [Word8]
ys'
  where
    -- drop  leading zeros
    xs' :: [Word8]
xs' = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Word8
0x30) [Word8]
xs
    ys' :: [Word8]
ys' = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Word8
0x30) [Word8]
ys

-- strcmp
compareStr :: [Word8] -> [Word8] -> Ordering
compareStr :: [Word8] -> [Word8] -> Ordering
compareStr = forall a. Ord a => a -> a -> Ordering
compare

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

isDigit8 :: Word8 -> Bool
isDigit8 :: Word8 -> Bool
isDigit8 Word8
w = Word8
0x30 forall a. Ord a => a -> a -> Bool
<= Word8
w Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
0x39

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